sub
generate_uid {
my
(
$size
) =
@_
;
$size
||= 7;
open
(
my
$fh
,
'<'
,
'/dev/urandom'
);
my
(
$uid
,
$char
,
$count
) = (
''
,
''
,0);
while
(
$count
<
$size
) {
read
(
$fh
,
$char
,1);
if
(
$char
=~ /[a-zA-Z0-9]/) {
$uid
.=
$char
;
$count
++;
}
}
return
$uid
;
}
like( exception {
$tl
->new();},
qr/.*must be called statically.*/
,
"Calling constructor on instance dies"
);
my
@methods
= Class::Inspector->methods(
'TestLink::API'
);
my
@excludeModules
=
qw{Scalar::Util Carp Clone Data::Validate::URI}
;
my
@tmp
= ();
my
@excludedMethods
= ();
foreach
my
$module
(
@excludeModules
) {
@tmp
= Class::Inspector->methods(
$module
);
push
(
@excludedMethods
,@{
$tmp
[0]});
}
foreach
my
$method
(@{
$methods
[0]}) {
next
if
$method
eq
'new'
;
next
if
grep
{
$_
eq
$method
}
@excludedMethods
;
like( exception {TestLink::API->
$method
},
qr/.*called by an instance.*/
,
"Calling $method requires an instance"
);
}
note(
"WARNING! Do not run the following tests against production testlink databases unless you have direct DB access!"
);
note(
"TestLink's API cannot delete any test data, so you will have to do this yourself!"
);
note(
"You will now be asked for credentials to point this test at some TestLink Installation."
);
note(
"If you provide no values within 45 seconds, the tests will be skipped."
);
my
$apiurl
=
$ENV
{
'TESTLINK_SERVER_ADDR'
};
note
"Please type your TestLink API URL - you have 15 seconds:"
unless
$apiurl
;
$apiurl
= prompt(
""
,
undef
,15)
unless
$apiurl
;
print
"\n"
unless
$apiurl
;
my
$apikey
=
$ENV
{
'TESTLINK_API_KEY'
};
note
"Please type your TestLink API Key - you have 15 seconds:"
unless
$apikey
;
prompt(
""
,
undef
,15)
unless
$apikey
;
print
"\n"
unless
$apikey
;
note
"Please type your TestLink username - you have 15 seconds:"
;
my
$author_name
= prompt(
""
,
undef
,15);
print
"\n"
;
SKIP: {
skip(
"User did not provide API endpoint & user to test."
,34)
if
(!
$apiurl
|| !
$apikey
|| !
$author_name
);
$tl
= TestLink::API->new(
$apiurl
,
$apikey
);
my
$test_project_name
= generate_uid();
my
$test_project_id
=
$tl
->createTestProject(
$test_project_name
,
$test_project_name
);
isnt(
$test_project_id
, 0,
"Create test project returns project ID (gave $test_project_id)"
);
ok(
scalar
(@{
$tl
->getProjects()}),
"Can get project listing"
);
cmp_ok(
$tl
->getProjectByName(
$test_project_name
)->{
'name'
},
'eq'
,
$test_project_name
,
"Can get project by name"
);
my
$test_suite_name
= generate_uid();
my
$test_suite_id
=
$tl
->createTestSuite(
$test_project_id
,
$test_suite_name
);
isnt(
$test_suite_id
, 0,
"Create test suite in test project $test_project_id ($test_project_name) returns test suite ID (gave $test_suite_id)"
);
my
$child_test_suite_name
= generate_uid();
my
$child_test_suite_id
=
$tl
->createTestSuite(
$test_project_id
,
$child_test_suite_name
,
'child test'
,
$test_suite_id
);
isnt(
$child_test_suite_id
, 0,
"Create test suite in test project $test_project_id ($test_project_name) as child of test suite $test_suite_name ($test_suite_id) returns test suite ID (gave $test_suite_id)"
);
ok(
scalar
(@{
$tl
->getTLDTestSuitesForProject(
$test_project_id
)}),
"Can get TLD testsuite listing for project $test_project_name ($test_project_id)."
);
ok(
scalar
(@{
$tl
->getTestSuitesForTestSuite(
$test_suite_id
)}),
"Can get testsuite listing for testsuite $test_suite_name ($test_suite_id)."
);
TODO: {
local
$TODO
=
"Can't get child testsuites sometimes for reasons that escape explanation"
;
ok(
scalar
(@{
$tl
->getTestSuitesForTestSuite(
$child_test_suite_id
)}),
"Can get testsuite listing for child testsuite $child_test_suite_name ($child_test_suite_id)."
);
}
is(
$tl
->getTestSuiteByID(
$test_suite_id
)->{
'id'
},
$test_suite_id
,
"Can get testsuite by ID"
);
cmp_ok(
$tl
->getTestSuitesByName(
$test_project_id
,
$test_suite_name
)->[0]->{
'name'
},
'eq'
,
$test_suite_name
,
"Can get testsuite by name"
);
my
$test_name
= generate_uid();
my
$test_info
=
$tl
->createTestCase(
$test_name
,
$test_suite_id
,
$test_project_id
,
$author_name
,
'robo-signed test'
,
"1. Potzrebie\n2.???\n3.Profit"
);
my
$test_id
=
$test_info
->{
'id'
};
my
$test_ext_id
=
$test_info
->{
'additionalInfo'
}->{
'external_id'
};
isnt(
$test_id
, 0,
"Create test in test suite $test_suite_id ($test_suite_name) returns test ID (gave $test_id)"
);
cmp_ok(
$tl
->getTestCaseById(
$test_id
)->{
'testcase_id'
},
'=='
,
$test_id
,
"Can get test $test_name ($test_id) by internal ID."
);
cmp_ok(
$tl
->getTestCaseByExternalId(
"$test_project_name-$test_ext_id"
)->{
'tc_external_id'
},
'=='
,
$test_ext_id
,
"Can get test $test_name ($test_project_name-$test_ext_id) by external ID."
);
ok(!
$tl
->getTestCaseById(-1),
"Looking for Nonexistant test ID returns false result."
);
ok(!
$tl
->getTestCaseByExternalId(
"hokum-666"
),
"Looking for Nonexistant test Name returns false result."
);
is(
int
$tl
->getTestCaseByName(
$test_name
,
$test_suite_name
,
$test_project_name
)->{
'id'
},
int
$test_id
,
"Can get Test By Name"
);
ok(
scalar
(@{
$tl
->getTestCasesForTestSuite(
$test_suite_id
,1,1)}),
"List of testcases for test suite $test_suite_name ($test_suite_id) can be retrieved."
);
my
$test_plan_name
= generate_uid();
my
$test_plan_id
=
$tl
->createTestPlan(
$test_plan_name
,
$test_project_name
,
'robo-signed soviet 5 year plan'
);
isnt(
$test_plan_id
, 0,
"Create Test Plan in test project $test_project_id ($test_project_name) returns test plan ID (gave $test_plan_id)"
);
cmp_ok(
$tl
->getTestPlanByName(
$test_plan_name
,
$test_project_name
)->{
'id'
},
'=='
,
$test_plan_id
,
"Verify that we can get the created plan $test_plan_name ($test_plan_id)."
);
ok(
$tl
->addTestCaseToTestPlan(
$test_plan_id
,
"$test_project_name-$test_ext_id"
,
$test_project_id
, 1),
"Added test $test_id to test plan $test_plan_id ($test_plan_name)."
);
ok(
scalar
(
keys
(%{
$tl
->getTestCasesForTestPlan(
$test_plan_id
)})),
"List of testcases and testsuites for test plan $test_plan_name ($test_plan_id) can be retrieved."
);
ok(
scalar
(@{
$tl
->getTestPlansForProject(
$test_project_id
)}),
"Can get listing of test plans for project $test_project_name ($test_project_id)"
);
my
$test_build_name
= generate_uid();
my
$test_build_id
=
$tl
->createBuild(
$test_plan_id
,
$test_build_name
);
isnt(
$test_build_id
, 0,
"Create Test Build (run) using test plan $test_plan_id ($test_plan_name) returns test build ID (gave $test_build_id)"
);
ok(
scalar
(@{
$tl
->getBuildsForTestPlan(
$test_plan_id
)}),
"Verify we can get a listing of the builds for $test_plan_name ($test_plan_id)"
);
cmp_ok(
$tl
->getBuildByName(
$test_build_name
,
$test_project_id
)->{
'id'
},
'=='
,
$test_build_id
,
"Verify we can get build $test_build_name ($test_build_id) by name"
);
cmp_ok(
$tl
->getLatestBuildForTestPlan(
$test_plan_id
)->{
'id'
},
'=='
,
$test_build_id
,
"Verify that we can get the latest build $test_build_name ($test_build_id) for test plan $test_plan_name ($test_plan_id)"
);
my
$res
=
$tl
->reportTCResult(
$test_id
,
$test_plan_id
,
$test_build_id
,
'p'
);
ok(
$res
->{
'status'
},
"Can set results of created test $test_id ($test_name) in test build $test_build_id ($test_build_name)."
);
my
$execution_id
=
$res
->{
'id'
};
ok(
$tl
->uploadExecutionAttachment(
$execution_id
,
'test.txt'
,
'text/plain'
,encode_base64(
'MOO MOO MOOOOOO'
),
'bovine emissions'
,
'whee'
),
"Can upload attachment to execution"
);
TODO: {
local
$TODO
=
"The underlying XMLRPC methods for these appear not to work as documented, so this fails"
;
ok(
$tl
->uploadTestCaseAttachment(
$test_id
,
"MOO.TXT"
,
'text/plain'
,encode_base64(
'MOO MOO MOOOOOO'
),
'bovine emissions'
,
'whee'
),
"Can upload attachment to test case"
);
ok(
$tl
->getTestCaseAttachments(
"$test_project_name-$test_ext_id"
),
"Can get attachments for test case"
);
}
cmp_ok(
$tl
->getTotalsForTestPlan(
$test_plan_id
)->{
'with_tester'
}->[0]->{
'p'
}->{
'exec_qty'
},
'=='
,1,
"Can get execution total for test plan (for what that's worth, you really want it for build"
);
my
$projdump
=
$tl
->
dump
(
$test_project_name
);
ok(
$projdump
->{
'testsuites'
}->[0]->{
'name'
} eq
$test_suite_name
,
"Dump gets TS correctly"
);
ok(
$projdump
->{
'testsuites'
}->[0]->{
'tests'
}->[0]->{
'name'
} eq
$test_name
,
"Dump gets tests correctly"
);
ok(
$projdump
->{
'testsuites'
}->[0]->{
'testsuites'
}->[0]->{
'name'
} eq
$child_test_suite_name
,
"Dump gets child TS correctly"
);
}
1;