Subversion Repositories DevTools

Rev

Rev 4996 | Rev 5387 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4996 Rev 5035
Line 33... Line 33...
33 
use Exporter;
 33 
use Exporter;
34 
use JatsError qw(:name=jats_runutf);
 34 
use JatsError qw(:name=jats_runutf);
35 
use Pod::Usage;                             # required for help support
 35 
use Pod::Usage;                             # required for help support
36 
use Getopt::Long;
 36 
use Getopt::Long;
37 
use File::Spec;
 37 
use File::Spec;
- 
 
 38 
use XML::Simple;
38 
 
 39 
 
39 
$VERSION = 1.00;
 40 
$VERSION = 1.00;
40 
@ISA = qw(Exporter);
 41 
@ISA = qw(Exporter);
41 
 
 42 
 
42 
# Symbols to autoexport (:DEFAULT tag)
 43 
# Symbols to autoexport (:DEFAULT tag)
Line 62... Line 63...
62 
#       ROOT            - Abs Path to Root of the build
 63 
#       ROOT            - Abs Path to Root of the build
63 
#       TARGET          - Current make target
 64 
#       TARGET          - Current make target
64 
#       TYPE            - Built type P or D
 65 
#       TYPE            - Built type P or D
65 
#       UFTUID          - Unique Test Identifier
 66 
#       UFTUID          - Unique Test Identifier
66 
#       UTFNAME         - Test Name
 67 
#       UTFNAME         - Test Name
- 
 
 68 
#       UTFRC           - Result Code from Unit Test run
67 
#
 69 
#
68 
our %filterData;
 70 
our %filterData;
69 
 
 71 
 
70 
#-------------------------------------------------------------------------------
 72 
#-------------------------------------------------------------------------------
71 
# Function        : help
 73 
# Function        : help
Line 245... Line 247...
245 
    #       Only if required
 247 
    #       Only if required
246 
    #       Ensure that the specified directory exists
 248 
    #       Ensure that the specified directory exists
247 
    #
 249 
    #
248 
    if (defined $filterData{DIR})
 250 
    if (defined $filterData{DIR})
249 
    {
 251 
    {
250 
        Verbose("Change directory");
 252 
        Verbose("Change directory:", $filterData{DIR});
251 
        Error("Internal: Test directory does not exist: $filterData{DIR}")
 253 
        Error("Internal: Test directory does not exist: $filterData{DIR}")
252 
            unless (-d $filterData{DIR});
 254 
            unless (-d $filterData{DIR});
253 
        chdir $filterData{DIR} || Error("Internal: Could not chdir to: $filterData{DIR}");
 255 
        chdir $filterData{DIR} || Error("Internal: Could not chdir to: $filterData{DIR}");
254 
    }
 256 
    }
255 
 
 257 
 
256 
    #
 258 
    #
- 
 
 259 
    #   Recover the result code of the unit test run
- 
 
 260 
    #
- 
 
 261 
    my $rcFile = join ('.', 'utf', $filterData{UFTUID}, 'rc');
- 
 
 262 
    Verbose("Result Code File:", $rcFile);
- 
 
 263 
    if (-f $rcFile)
- 
 
 264 
    {
- 
 
 265 
        open( my $rcFile, '<', $rcFile) || Error ("Cannot open file : $!");
- 
 
 266 
        $filterData{UTFRC} = <$rcFile>;
- 
 
 267 
        $filterData{UTFRC} =~ s~\s+$~~;
- 
 
 268 
        $filterData{UTFRC} =~ s~^\s+~~;
- 
 
 269 
        Verbose("Recover Result Code: ", $filterData{UTFRC});
- 
 
 270 
        close $rcFile;
- 
 
 271 
    }
- 
 
 272 
    #
257 
    #   Diagnostics
 273 
    #   Diagnostics
258 
    #
 274 
    #
259 
    if (IsVerbose(1))
 275 
    if (IsVerbose(1))
260 
    {
 276 
    {
261 
        DebugDumpData("Filter Parameters", \%filterData);
 277 
        DebugDumpData("Filter Parameters", \%filterData);
Line 270... Line 286...
270 
    my $rv = $module_name->processUtf(\%filterData);
 286 
    my $rv = $module_name->processUtf(\%filterData);
271 
    Error ("Unit Test Failure: Errors detected in the result set")
 287 
    Error ("Unit Test Failure: Errors detected in the result set")
272 
        if ( defined($rv) && ! $rv );
 288 
        if ( defined($rv) && ! $rv );
273 
}
 289 
}
274 
 
 290 
 
- 
 
 291 
#-------------------------------------------------------------------------------
- 
 
 292 
# Function        : Write XML
- 
 
 293 
#
- 
 
 294 
# Description     : Write user XML results to file
- 
 
 295 
#                   Will insert standard data
- 
 
 296 
#
- 
 
 297 
# Inputs          : $options    - Ref to a hash of options
- 
 
 298 
#                   $results    - Ref to an array of results
- 
 
 299 
#                                 Expect a ref to an array of Hash Values
- 
 
 300 
#
- 
 
 301 
# Returns         : Nothing
- 
 
 302 
#
- 
 
 303 
sub writeXmlResults
- 
 
 304 
{
- 
 
 305 
    my ($options, $results) = @_;
- 
 
 306 
    #
- 
 
 307 
    #   Create a data structure to contain the dummy test result
- 
 
 308 
    #   Insert TARGET and TYPE attributes
- 
 
 309 
    #
- 
 
 310 
    my %xml;
- 
 
 311 
    $xml{TestResults}{TARGET} = $options->{TARGET};
- 
 
 312 
    $xml{TestResults}{TYPE} = $options->{TYPE};
- 
 
 313
- 
 
 314 
    @{$xml{TestResults}{TestResult}} = @$results;
- 
 
 315 
 
- 
 
 316 
    #   The 'MESSAGE' key for failed tests forms the content of the
- 
 
 317 
    #   <TestResult> element. Other keys are converted to attributes.
- 
 
 318 
    #   Assign <TestResults> as the root XML node.
- 
 
 319 
    my $xmlData = XMLout(\%xml, ContentKey => 'MESSAGE', RootName => 'TestResults', KeepRoot => 1);
- 
 
 320 
 
- 
 
 321 
    #   Write the data to the XML file.
- 
 
 322 
    my $filename = $options->{OUTFILE};
- 
 
 323 
    open ( my $outFile, ">", $filename)
- 
 
 324 
        || Error(" Cannot open results file:$filename for writing: $!\n");
- 
 
 325 
    print $outFile $xmlData;
- 
 
 326 
    close $outFile;
- 
 
 327 
}
- 
 
 328 
 
- 
 
 329 
 
275 
=pod 1
 330 
=pod 1
276 
 
 331 
 
277 
=for htmltoc    SYSUTIL::
 332 
=for htmltoc    SYSUTIL::
278 
 
 333 
 
279 
=head1 NAME
 334 
=head1 NAME
Line 548... Line 603...
548 
 
 603 
 
549 
Allow the reuse of output file names.
 604 
Allow the reuse of output file names.
550 
 
 605 
 
551 
=back
 606 
=back
552 
 
 607 
 
- 
 
 608 
=item       UTFRC
- 
 
 609 
 
- 
 
 610 
The result code from the unit test run.
- 
 
 611 
 
- 
 
 612 
This will only be defined for JATS run unit tests.
- 
 
 613 
 
553 
=back
 614 
=back
554 
 
 615 
 
555 
The return value from the function 'processUtf' is ignored. If the function encounters
616 
The return value from the function 'processUtf' is ignored. If the function encounters
556 
any error it should use the Jats 'Error' function to report the error.
 617 
any error it should use the Jats 'Error' function to report the error.
557 
 
 618