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