diff --git a/configure/CONFIG_BASE b/configure/CONFIG_BASE index 8934a8e5d..d965f28de 100644 --- a/configure/CONFIG_BASE +++ b/configure/CONFIG_BASE @@ -68,6 +68,7 @@ DBTOMENUH = $(PERL) $(TOOLS)/dbdToMenuH.pl REGISTERRECORDDEVICEDRIVER = $(PERL) $(TOOLS)/registerRecordDeviceDriver.pl CONVERTRELEASE = $(PERL) $(call FIND_TOOL,convertRelease.pl) FULLPATHNAME = $(PERL) $(TOOLS)/fullPathName.pl +TAPTOJUNIT = $(PERL) $(TOOLS)/tap-to-junit-xml.pl #------------------------------------------------------- # tools for installing libraries and products diff --git a/configure/CONFIG_SITE b/configure/CONFIG_SITE index 1597c6f7f..b657f5b65 100644 --- a/configure/CONFIG_SITE +++ b/configure/CONFIG_SITE @@ -117,11 +117,10 @@ CROSS_COMPILER_TARGET_ARCHS= # configure/os/CONFIG_SITE..Common files instead. CROSS_COMPILER_HOST_ARCHS= -# The 'make runtests' and 'make tapfiles' build targets normally only run +# The 'runtests', 'tapfiles' and 'junitfiles' make targets normally only run # self-tests for the EPICS_HOST_ARCH architecture. If the host can execute # the self-test programs for any other cross-built architectures such as -# a -debug architecture, those architectures can be named here. -# +# a -debug architecture, those architectures must be named in this variable: CROSS_COMPILER_RUNTEST_ARCHS= # Build shared libraries (DLLs on Windows). diff --git a/configure/RULES.Db b/configure/RULES.Db index b45e37049..c050f9411 100644 --- a/configure/RULES.Db +++ b/configure/RULES.Db @@ -151,7 +151,7 @@ ACTIONS = inc ACTIONS += build ACTIONS += install ACTIONS += buildInstall -ACTIONS += runtests tapfiles +ACTIONS += runtests tapfiles junitfiles actionArchTargets = $(foreach x, $(ACTIONS),\ $(foreach arch,$(BUILD_ARCHS), $(x)$(DIVIDER)$(arch))) diff --git a/configure/RULES_ARCHS b/configure/RULES_ARCHS index 6d1808266..6a77a6e9e 100644 --- a/configure/RULES_ARCHS +++ b/configure/RULES_ARCHS @@ -14,7 +14,7 @@ ACTIONS = inc ACTIONS += build ACTIONS += install ACTIONS += buildInstall -ACTIONS += runtests tapfiles +ACTIONS += runtests tapfiles junitfiles actionArchTargets = $(foreach action, $(ACTIONS), \ $(addprefix $(action)$(DIVIDER), $(BUILD_ARCHS))) diff --git a/configure/RULES_BUILD b/configure/RULES_BUILD index abc14cae2..176b2743a 100644 --- a/configure/RULES_BUILD +++ b/configure/RULES_BUILD @@ -115,6 +115,7 @@ endif ifneq (,$(findstring $(T_A),$(EPICS_HOST_ARCH) $(CROSS_COMPILER_RUNTEST_ARCHS))) RUNTESTS_ENABLED = YES TAPFILES += $(TESTSCRIPTS:.t=.tap) +JUNITFILES += $(TAPFILES:.tap=.xml) endif #--------------------------------------------------------------- @@ -165,7 +166,7 @@ build_clean: $(INC) $(TARGETS) $(TDS) $(CLEANS) \ *.out MakefileInclude *.manifest *.exp \ $(COMMON_INC) $(HDEPENDS_FILES) $(PRODTARGETS) \ - $(TESTSCRIPTS) $(TAPFILES) + $(TESTSCRIPTS) $(TAPFILES) $(JUNITFILES) ifdef RES @$(RM) *$(RES) endif @@ -345,6 +346,7 @@ testspec: $(TESTSCRIPTS) $(if $(TESTSPEC_$(OS_CLASS)), @echo "Harness: $(TESTSPEC_$(OS_CLASS))" >> $@) tapfiles: $(TESTSCRIPTS) $(TAPFILES) +junitfiles: $(JUNITFILES) # A .tap file is the output from running the associated test script %.tap: %.t @@ -352,6 +354,9 @@ ifdef RUNTESTS_ENABLED -$(PERL) $< -tap > $@ endif +%.xml: %.tap + $(TAPTOJUNIT) --puretap --output $@ --input $< $* + # If there's a perl test script (.plt) available, use it %.t: ../%.plt @$(RM) $@ @@ -496,7 +501,8 @@ $(INSTALL_TEMPLATES_SUBDIR)/%: % .PRECIOUS: $(COMMON_INC) .PHONY: all host inc build install clean rebuild buildInstall build_clean -.PHONY: runtests tapfiles checkRelease warnRelease noCheckRelease +.PHONY: runtests tapfiles junitfiles +.PHONY: checkRelease warnRelease noCheckRelease endif # BASE_RULES_BUILD # EOF RULES_BUILD diff --git a/configure/RULES_DIRS b/configure/RULES_DIRS index 755c0cccf..87c0e7318 100644 --- a/configure/RULES_DIRS +++ b/configure/RULES_DIRS @@ -9,7 +9,7 @@ ARCHS += $(BUILD_ARCHS) ACTIONS += inc build install buildInstall clean realclean archclean -ACTIONS += runtests tapfiles +ACTIONS += runtests tapfiles junitfiles dirActionArchTargets = $(foreach dir, $(DIRS), \ $(foreach action, $(ACTIONS), \ diff --git a/configure/RULES_TOP b/configure/RULES_TOP index 2aa2e1f33..3d60b5af8 100644 --- a/configure/RULES_TOP +++ b/configure/RULES_TOP @@ -57,6 +57,7 @@ help: @echo " Cannot be used within an O. dir" @echo " rebuild - Same as clean install" @echo " archclean - Removes O. dirs but not O.Common dir" + @echo " runtests - Run self-tests, summarize results" @echo "\"Partial\" build targets supported by Makefiles:" @echo " host - Builds and installs $(EPICS_HOST_ARCH) only." @echo " inc$(DIVIDER) - Installs only header files." diff --git a/documentation/RELEASE_NOTES.html b/documentation/RELEASE_NOTES.html index ddb224895..0522b4b10 100644 --- a/documentation/RELEASE_NOTES.html +++ b/documentation/RELEASE_NOTES.html @@ -29,6 +29,14 @@ tells git to ignore all configure/*.local files.

+

Self-test JUnit XML Output

+ +

This release adds a new make target junitfiles which if necessary +runs the self-tests and then converts the TAP (Perl Test-Anything-Protocol) +output files (as generated by the tapfiles target) into the more +commonly-recognized JUnit XML format. The program that performs this conversion +needs the Perl module XML::Generator to have been installed.

+

Fix DNS related crash on exit

The attempt to fix DNS related delays for short lived CLI programs (eg. caget) diff --git a/src/ca/legacy/pcas/generic/casStrmClient.cc b/src/ca/legacy/pcas/generic/casStrmClient.cc index ff12e889e..5eebfeb0a 100644 --- a/src/ca/legacy/pcas/generic/casStrmClient.cc +++ b/src/ca/legacy/pcas/generic/casStrmClient.cc @@ -530,8 +530,20 @@ caStatus casStrmClient::readResponse ( epicsGuard < casClientMutex > & guard, pChan->getCID(), status, ECA_GETFAIL ); } + aitUint32 elementCount = 0; + if (desc.isContainer()) { + aitUint32 index; + int gdds = gddApplicationTypeTable::app_table.mapAppToIndex + ( desc.applicationType(), gddAppType_value, index ); + if ( gdds ) { + return S_cas_badType; + } + elementCount = desc.getDD(index)->getDataSizeElements(); + } else { + elementCount = desc.getDataSizeElements(); + } ca_uint32_t count = (msg.m_count == 0) ? - (ca_uint32_t)desc.getDataSizeElements() : + (ca_uint32_t)elementCount : msg.m_count; void * pPayload; @@ -659,8 +671,20 @@ caStatus casStrmClient::readNotifyResponse ( epicsGuard < casClientMutex > & gua return ecaStatus; } + aitUint32 elementCount = 0; + if (desc.isContainer()) { + aitUint32 index; + int gdds = gddApplicationTypeTable::app_table.mapAppToIndex + ( desc.applicationType(), gddAppType_value, index ); + if ( gdds ) { + return S_cas_badType; + } + elementCount = desc.getDD(index)->getDataSizeElements(); + } else { + elementCount = desc.getDataSizeElements(); + } ca_uint32_t count = (msg.m_count == 0) ? - (ca_uint32_t)desc.getDataSizeElements() : + (ca_uint32_t)elementCount : msg.m_count; void *pPayload; diff --git a/src/tools/Makefile b/src/tools/Makefile index e15e93507..53d043e73 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -45,6 +45,7 @@ PERL_SCRIPTS += makeTestfile.pl PERL_SCRIPTS += mkmf.pl PERL_SCRIPTS += munch.pl PERL_SCRIPTS += replaceVAR.pl +PERL_SCRIPTS += tap-to-junit-xml.pl PERL_SCRIPTS += useManifestTool.pl PERL_SCRIPTS += dbdToMenuH.pl diff --git a/src/tools/tap-to-junit-xml.pl b/src/tools/tap-to-junit-xml.pl new file mode 100644 index 000000000..fe8aa86fb --- /dev/null +++ b/src/tools/tap-to-junit-xml.pl @@ -0,0 +1,546 @@ +#!/usr/local/bin/perl +=head1 NAME + +tap-to-junit-xml - convert perl-style TAP test output to JUnit-style XML + +=head1 SYNOPSIS + +tap-to-junit-xml [--help|--man] + [--[no]hidesummary] + [--input ] + [--output ] + [--puretap] + [] [outputprefix] + +=head1 DESCRIPTION + +Parse test suite output in TAP (Test Anything Protocol, +C) format, and produce XML output in a similar format +to that produced by the ant task. This is useful for consumption by +continuous-integration systems like Hudson (C). + +C<"test suite name"> is a descriptive string used as the B attribute on the +top-level node of the output XML. Defaults to "make test". + +If C is specified, multi-file output will be generated, with +multiple XML files created using C as the start of their +filenames. The files are separated by testplan. This option is ignored +if --puretap is specified (TAP only allows one testplan per input file). +This prefix may contain slashes, in which case the files will be +placed into a directory hierarchy accordingly (although care should be taken to +ensure these directories exist in advance). + +If --input I is not specified, STDIN will be read. +If C or --output is not specified, a single XML file will be +generated on STDOUT. + +--output I is used to write a single XML file to I. + +--puretap parses a single TAP source and handles parse errors and directives +(todo, skip, bailout). --puretap ignores unknown (non-TAP) input. Without +--puretap, the script will parse some additional non-TAP test input, such as +Perl tests that can include a "Test Summary Report", but it won't generate +correct XML unless the TAP testplan comes before the test cases. +--hidesummary report (the default) will hide the summary report, --no-hidesummary +will display it (neither has an effect when --puretap is specified). + +=head1 EXAMPLE + + prove -v 2>&1 | tee tests.log + tap-to-junit-xml "make test" testxml/tests < tests.log + +(JUnit-formatted XML is now in "testxml/tests*.xml".) + +=head1 DEPENDENCIES + + Getopt::Long + Pod::Usage + TAP::Parser + Time::HiRes + XML::Generator + +=head1 BUGS + + - Output is optimized for Hudson, and may not look quite as good in + other UIs. + - Doesn't do anything with the STDERR from tests. + - Doesn't fill in the 'errors' attribute in the element. + (--puretap handles parse errors) + - Doesn't handle "todo" or "skip" (--puretap does) + - Doesn't get the elapsed time for each 'test' (i.e. assertion.) + (TAP output has no elapsed time convention). + +=head1 SOURCE + +http://github.com/jmason/tap-to-junit-xml/tree/master + +=head1 AUTHOR + +original, junit_xml.pl, by Matisse Enzer ; see +C. + +pretty much entirely rewritten by Justin Mason , Feb 2008. + +Miscellaneous fixes and mods (--puretap) by Jascha Lee , Mar 2009. + +=head1 VERSION + + Mar 27 2008 jm + Mar 17 2009 jl + +=head1 COPYRIGHT & LICENSE + +Copyright (c) 2007 Matisse Enzer. All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. +=cut + +use strict; +use warnings; + +use Getopt::Long qw(:config no_ignore_case); +use Pod::Usage; +use TAP::Parser; +use Time::HiRes qw(gettimeofday tv_interval); +use XML::Generator qw(:noimport); + +my %opts; +pod2usage() unless GetOptions( \%opts, 'help|h', + 'hidesummary!', + 'input=s', + 'man', + 'output=s', + 'puretap' + ); + +pod2usage(-verbose => 1) if defined $opts{'help'}; +pod2usage(-verbose => 2) if defined $opts{'man'}; + +my $opt_suitename = shift @ARGV; +my $opt_multifile = 0; +my $opt_mfprefix; + +if (defined $ARGV[0]) { + $opt_multifile = 1; + $opt_mfprefix = $ARGV[0]; +} + +# should the 'Test Summary Report' at the end of a test suite be displayed +# as if it was a testcase? in my opinion, no +my $HIDE_TEST_SUMMARY_REPORT = defined $opts{'hidesummary'} ? $opts{'hidesummary'} : 1; + +my $suite_name = $opt_suitename || 'make test'; +my $safe_suite_name = $suite_name; $safe_suite_name =~ s/[^-:_A-Za-z0-9]+/_/gs; + +# TODO: it'd be nice to respect 'Universal desirable behavior #1' from +# http://testanything.org/wiki/index.php/TAP_Consumers -- 'Should work on the +# TAP as a stream (ie. as each line is received) rather than wait until all the +# TAP is received'. But it seems TAP::Parser itself doesn't support it! +# maybe when TAP::Parser does that, we'll do it too. +my $tapfh; +if ( defined $opts{'input'} ) { + open $tapfh, '<', $opts{'input'} or die "Can't open TAP file '$opts{'input'}': $!\n"; +} +else { + $tapfh = \*STDIN; +} + +my $outfh; +if ( defined $opts{'output'} ) { + open $outfh, '>', $opts{'output'} or die "Can't open output file '$opts{'output'}' for writing: $!\n"; +} +else { + $outfh = \*STDOUT; +} + +my $tap = TAP::Parser->new( { source => $tapfh } ); +my $xmlgen = XML::Generator->new( ':pretty'); +my $xmlgenunescaped = XML::Generator->new( escape => 'unescaped', + conformance => 'strict', + pretty => 2 + ); +my @properties = _get_properties($xmlgen); +if ( defined $opts{'puretap'} ) { + # + # Instead of trying to parse everything in one pass, which fails if the + # testplan is last, parse through the results for the test cases and + # then construct the information from the TAP and wrap it + # around the test cases. Ignore 'unknown' information. [JL] + # + my @testcases = _parse_testcases( $tap, $xmlgen ); + errorOut( $tap, $xmlgen ) if $tap->parse_errors; + print $outfh $xmlgen->testsuites( + $xmlgen->testsuite( { name => $safe_suite_name, + tests => $tap->tests_planned, + failures => scalar $tap->failed, + errors => 0, + time => 0, + id => 1 }, + @testcases )); + +} +else { + my $test_results = _parse_tests( $tap, $xmlgen ); + if ($opt_multifile) { + _gen_junit_multifile_xml( $xmlgen, \@properties, $test_results ); + } else { + print $outfh _get_junit_xml( $xmlgen, \@properties, $test_results ); + } +} +exit; + +#------------------------------------------------------------------------------- + +sub _get_junit_xml { + my ( $xmlgen, $properties, $test_results ) = @_; + my $xml = "\n" . + $xmlgen->testsuites({ + name => $suite_name, + }, @$test_results); + return $xml; +} + +sub _gen_junit_multifile_xml { + my ( $xmlgen, $properties, $test_results ) = @_; + my $count = 1; + foreach my $testsuite (@$test_results) { + open OUT, ">${opt_mfprefix}.${count}.xml" + or die "cannot write ${opt_mfprefix}.${count}.xml"; + print OUT "\n"; + print OUT $testsuite; + close OUT; + $count++; + } +} + +# +# Wrap up parse errors and output them as test cases. +# +sub errorOut { + my $parser = shift; + my $xmlgen = shift; + die "errorOut() needs some args" unless $parser and $xmlgen; + my ($xml, @errors, $name); + my $count = 1; + foreach my $error ( $parser->parse_errors ) { + $name = sprintf "%s%02d", 'Error_', $count++; + $xml = $xmlgen->testcase( { name => $name, + classname => 'TestsNotRun.ParseError', + time => 0 }, + + $xmlgen->error( { type => 'TAPParseError', + message => $error } )); + push @errors, $xml; + } + print $outfh $xmlgen->testsuites( + $xmlgen->testsuite( { name => 'TestsNotRun.ParseError', + tests => $tap->tests_planned, + failures => 0, + errors => scalar $tap->parse_errors, + time => 0, + id => 1 }, + @errors )); + exit 86; +} + +# +# Construct an array of XML'd test cases +# +sub _parse_testcases { + my $parser = shift; + my $xmlgen = shift; + return () unless $parser and $xmlgen; + my ($name, $directive, $xml, @testcases); + + while ( my $result = $parser->next ) { + if ( $result->is_bailout ) { + $xml = $xmlgen->testcase( { name => 'BailOut', + classname => "$safe_suite_name.Tests", + time => 0 }, + + $xmlgen->error( { type => 'BailOut', + message => $result->explanation } )); + + push @testcases, $xml; + last; + } + next unless $result->is_test; + $directive = $result->directive; + $name = sprintf "%s%02d", 'Test_', $result->number; + $name .= "_$directive" if $directive; + if ( $result->is_ok ) { + $xml = $xmlgen->testcase( { name => $name, + classname => "$safe_suite_name.Tests", + time => 0 } ); + push @testcases, $xml; + } + else { + $xml = $xmlgen->testcase( { name => $name, + classname => "$safe_suite_name.Tests", + time => 0 }, + $xmlgen->failure( { type => 'TAPTestFailed', + message => $result->as_string } )); + push @testcases, $xml; + } + } + + return @testcases; +} + +sub _parse_tests { + my ( $parser, $xmlgen ) = @_; + + my $ctx = { + testsuites => [ ], + test_name => 'notest', + plan_ntests => 0, + case_id => 0, + }; + + _new_ctx($ctx); + + my $lastunk = ''; + + # unknown t/basic_lint......... + # plan 1..1 + # comment # Running under perl version 5.008008 for linux + # comment # Current time local: Thu Jan 24 17:44:30 2008 + # comment # Current time GMT: Thu Jan 24 17:44:30 2008 + # comment # Using Test.pm version 1.25 + # unknown /usr/bin/perl -T -w ../spamassassin.raw -C log/test_rules_copy --siteconfigpath log/localrules.tmp -p log/test_default.cf -L --lint + # unknown Checking anything + # test ok 1 + # test ok 2 + # unknown t/basic_meta......... + # plan 1..2 + # comment # Running under perl version 5.008008 for linux + # comment # Current time local: Thu Jan 24 17:44:31 2008 + # comment # Current time GMT: Thu Jan 24 17:44:31 2008 + # comment # Using Test.pm version 1.25 + # test not ok 1 + # comment # Failed test 1 in t/basic_meta.t at line 91 + # test ok 2 + # unknown Failed 1/2 subtests + # unknown t/basic_obj_api...... + # plan 1..4 + # comment # Running under perl version 5.008008 for linux + # comment # Current time local: Thu Jan 24 17:44:33 2008 + # comment # Current time GMT: Thu Jan 24 17:44:33 2008 + # comment # Using Test.pm version 1.25 + # test ok 1 + # test ok 2 + # test ok 3 + # test ok 4 + # test ok 9 + # unknown + # unknown Test Summary Report + # unknown ------------------- + # unknown t/basic_meta.t (Wstat: 0 Tests: 2 Failed: 1) + # unknown Failed test: 1 + # unknown Files=3, Tests=7, 6 wallclock secs ( 0.01 usr 0.00 sys + 4.39 cusr 0.23 csys = 4.63 CPU) + # unknown Result: FAIL + # unknown Failed 1/3 test programs. 1/7 subtests failed. + # unknown make: *** [test_dynamic] Error 255 + + while ( my $r = $parser->next ) { + my $t = $r->type; + my $s = $r->as_string; $s =~ s/\s+$//; + + # warn "JMD $t $s"; + + if ($t eq 'unknown') { + $lastunk = $s; + + # PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib/lib', 'blib/arch')" t/basic_* + # if ($s =~ /test_harness\(.*?\)" (.+)$/) { + # $suite_name = $1; + # } + if ($s =~ /^Test Summary Report$/) { + # create a block for the summary + $ctx->{plan_ntests} = 0; + $ctx->{test_name} = "Test Summary Report"; + $ctx->{case_tests} = 1; + _finish_test_block($ctx); + } + elsif ($s =~ /^Result: FAIL$/) { + $ctx->{case_tests}++; + $ctx->{case_failures}++; + my $test_case = { + classname => test_name_to_classname($ctx->{test_name}), + name => 'result', + 'time' => 0, + }; + my $failure = $xmlgen->failure({ + type => "OverallTestsFailed", + message => $s + }, "__FAILUREMESSAGETODO__"); + + if (!$HIDE_TEST_SUMMARY_REPORT) { + push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure); + } + } + elsif ($s =~ /^(\S+?)\.\.\.+1\.\.(\d+?)\s*$/) { + # perl 5.6.x "Test" format plan line + # unknown t/basic_lint....................1..1 + + my ($name, $nt) = ($1,$2); + if ($ctx->{plan_ntests}) { # only if there have been tests planned + _finish_test_block($ctx); + } + + $ctx->{plan_ntests} = $nt+0; + $ctx->{test_name} = "$name.t"; + } + } + elsif ($t eq 'plan') { + if ($ctx->{plan_ntests}) { # only if there have been tests planned + _finish_test_block($ctx); + } + + $ctx->{plan_ntests} = 0; + $s =~ /(\d+)$/ and $ctx->{plan_ntests} = $1+0; + + $ctx->{test_name} = $lastunk; + $ctx->{test_name} =~ s/\.*\s*$//gs; + $ctx->{test_name} .= ".t"; + } + elsif ($t eq 'test') { + my $ntest = 0; + if ($s =~ /(?:not |)\S+ (\d+)/) { $ntest = $1+0; } + + if ($ntest > $ctx->{plan_ntests}) { + # jump in test numbers, more than planned; this is probably TAP::Parser's wierdness. + # (when it sees the "ok" line at the end of a test case with no number, + # it outputs the current total number of tests so far.) + next; + } + + # clean this up in a Hudson-compatible way; ":" and "/" are out, "." also causes + # trouble by creating an extra "directory" in the results + + my $test_case = { + classname => test_name_to_classname($ctx->{test_name}), + name => sprintf("test %6d", $ntest), # space-padding ensures ordering + 'time' => 0, + }; + + $ctx->{case_tests}++; + my $failure = undef; + if ($s =~ /^not /i) { + $ctx->{case_failures}++; + $failure = $xmlgen->failure({ + type => "TAPTestFailed", + message => $s + }, "__FAILUREMESSAGETODO__"); + push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure); + } + else { + push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case); + } + } + + $ctx->{sysout} .= $s."\n"; + } + + if (scalar(@{$ctx->{test_cases}}) == 0 && + scalar(@{$ctx->{testsuites}}) == 0) + { + # no tests found! create a block containing *something* at least + $ctx->{case_tests}++; + my $test_case = { + classname => test_name_to_classname($ctx->{test_name}), + name => 'result', + 'time' => 0, + }; + push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case); + } + + _finish_test_block($ctx); + return $ctx->{testsuites}; +} + +sub _new_ctx { + my $ctx = shift; + $ctx->{start_time} = [gettimeofday]; + $ctx->{test_cases} = []; + $ctx->{case_tests} = 0; + $ctx->{case_failures} = 0; + $ctx->{case_time} = 0; + $ctx->{case_id}++; + $ctx->{sysout} = ''; + return $ctx; +} + +sub _finish_test_block { + my $ctx = shift; + $ctx->{sysout} =~ s/\n\S+\.*\s*\n$/\n/s; # remove next test's "t/foo....." line + + my $elapsed_time = 0; # TODO + #my $elapsed_time = tv_interval( $ctx->{start_time}, [gettimeofday] ); + + # clean it up to valid Java packagename format (or at least something Hudson will + # consume) + my $name = $ctx->{test_name}; + $name =~ s/[^-:_A-Za-z0-9]+/_/gs; + $name = "$safe_suite_name.$name"; # a "directory" for the suite name + + my $testsuite = { + 'time' => $elapsed_time, + 'name' => $name, + tests => $ctx->{case_tests}, + failures => $ctx->{case_failures}, + 'id' => $ctx->{case_id}, + errors => 0, + }; + + my @fixedcases = (); + foreach my $tc (@{$ctx->{test_cases}}) { + if ($tc =~ s/__FAILUREMESSAGETODO__/ cdata($ctx->{sysout}) /ges) { + push @fixedcases, \$tc; # inhibits escaping! + } else { + push @fixedcases, $tc; + } + } + + # use "unescaped"; we have already fixed escaping on these strings. + # note that a reference means 'this is unescaped', bizarrely. + push @{$ctx->{testsuites}}, $xmlgenunescaped->testsuite($testsuite, + @fixedcases, + \("\n".cdata($ctx->{sysout})."\n"), + \("")); + + _new_ctx($ctx); +}; + +sub cdata { + my $s = shift; + $s =~ s/\]\]>/\](warning: defanged by tap-to-junit-xml)\]>/gs; + return ''; +} + +sub _get_properties { + my $xmlgen = shift; + my @props; + foreach my $key ( sort keys %ENV ) { + push @props, $xmlgen->property( { name => "$key", value => $ENV{$key} } ); + } + return @props; +} + +sub test_name_to_classname { + my $safe = shift; + $safe =~ s/[^-:_A-Za-z0-9]+/_/gs; + $safe = "$safe_suite_name.$safe"; # a "directory" for the suite name + $safe; +} + +__END__ + +# JUnit references: +# http://www.nabble.com/JUnit-4-XML-schematized--td13946472.html +# http://jra1mw.cvs.cern.ch:8180/cgi-bin/jra1mw.cgi/org.glite.testing.unit/config/JUnitXSchema.xsd?view=markup +# skipped tests: +# https://hudson.dev.java.net/issues/show_bug.cgi?id=1251 +# Hudson source: +# http://fisheye5.cenqua.com/browse/hudson/hudson/main/core/src/main/java/hudson/tasks/junit/CaseResult.java