Samson Monaco Tutankhamen > Test-Tech-0.26 > Test::Tech

Download:
Test-Tech-0.26.tar.gz

Dependencies

Annotate this POD

View/Report Bugs
Module Version: 1.26   Source  

NAME ^

Test::Tech - adds skip_tests and test data structures capabilities to the "Test" module

SYNOPSIS ^

 #######
 # Procedural (subroutine) Interface
 #
 # (use for &Test::plan, &Test::ok, &Test::skip drop in)
 #  
 use Test::Tech qw(demo finish is_skip ok ok_sub plan skip skip_sub
      skip_tests stringify tech_config);

 demo($quoted_expression, @expression);

 (@stats) = finish( );
 $num_passed = finish( );

 $skip_on = is_skip( );
 ($skip_on, $skip_diag) = is_skip( );

 $test_ok = ok($actual_results, $expected_results, [@options]);
 $test_ok = ok($actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = ok($actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, [@options]);
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $success = plan(@args);

 $test_ok = skip($skip_test, $actual_results,  $expected_results, [@options]);
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, [@options]);
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, $test_name, [@options]);

 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, [@options]);
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $skip_on = skip_tests( $on_off, $skip_diagnostic);
 $skip_on = skip_tests( $on_off );
 $skip_on = skip_tests( );

 $string = stringify($var, @options); # imported from Data::Secs2

 $new_value  = tech_config( $key, $old_value);

 #####
 # Object Interface
 # 
 $tech = new Test::Tech;

 $tech->demo($quoted_expression, @expression)

 (@stats) = $tech->finish( );
 $num_passed = $tech->finish( );

 $skip_on = $tech->is_skip( );
 ($skip_on, $skip_diag) = $tech->is_skip( );

 $test_ok = $tech->ok($actual_results, $expected_results, [@options]);
 $test_ok = $tech->ok($actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = $tech->ok($actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $test_ok = $tech->ok_sub(\&subroutine, $actual_results, $expected_results, [@options]);
 $test_ok = $tech->ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = $tech->ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $success = $tech->plan(@args);

 $test_ok = $tech->skip($skip_test, $actual_results,  $expected_results, [@options]);
 $test_ok = $tech->skip($skip_test, $actual_results,  $expected_results, $diagnostic, [@options]);
 $test_ok = $tech->skip($skip_test, $actual_results,  $expected_results, $diagnostic, $test_name, [@options]);

 $test_ok = $tech->skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, [@options]);
 $test_ok = $tech->skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = $tech->skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);

 $state  = $tech->skip_tests( );
 $state  = $tech->skip_tests( $on_off );

 $state = skip_tests( $on_off, $skip_diagnostic );

 $string = $tech->stringify($var, @options); # imported from Data::Secs2

 $new_value = $tech->tech_config($key, $old_value);

Generally, if a subroutine will process a list of options, @options, that subroutine will also process an array reference, \@options, [@options], or hash reference, \%options, {@options}. If a subroutine will process an array reference, \@options, [@options], that subroutine will also process a hash reference, \%options, {@options}. See the description for a subroutine for details and exceptions.

DESCRIPTION ^

The "Test::Tech" module extends the capabilities of the "Test" module.

The design is simple. The "Test::Tech" module loads the "Test" module without exporting any "Test" subroutines into the "Test::Tech" namespace. There is a "Test::Tech" cover subroutine with the same name for each "Test" module subroutine. Each "Test::Tech" cover subroutine will call the &Test::$subroutine before or after it adds any additional capabilities. The "Test::Tech" module procedural (subroutine) interface is a drop-in for the "Test" module.

The "Test::Tech" has a hybrid interface. The subroutine/methods that use object data are the 'new', 'ok', 'skip', 'skip_tests', 'tech_config' and 'finish' subroutines/methods.

When the module is loaded it creates a default object. If any of the above subroutines/methods are used procedurally, without a class or object, the subroutine/method will use the default method.

The "Test::Tech" module extends the capabilities of the "Test" module as follows:

demo

 demo($quoted_expression, @expression)

The demo subroutine/method provides a session like out. The '$quoted_express' is printed out as typed in from the keyboard. The '@expression' is executed and printed out as the results of '$quoted_expression'.

finish

 (@stats) = $tech->finish( );
 $num_passed = $tech->finish( );

The finish() subroutine/method restores changes made to the Test module module made by the tech_config subroutine/method or directly.

When the new subroutine/method creates a Test::Tech object. Perl will automatically run the finish() method when that object is destoried.

Running the 'finish' method without a class or object, restores the 'Test' module to the values when the 'Test::Tech' module was loaded.

When used in an array context the finish() subroutine/method returns the @stats array. The @stats array consists of the following:

The finish() subroutine resets the last_test and to zero and will returns undef without performing any of the above. The finish() subroutine will not be active again until a new test run is start with &Test::Tech::plan and the first test performed by &Test::Tech::ok or &Test::Tech::skip.

In a scalar contents, the finish() subroutine/method outputs a 1 for sucess and 0 for failure. In an array context, the finish() subroutine/method outputs @stats array that consists of the following:

0

number of tests

This is calculated as the maximum of the tests planned and the highest test number. From the maximum, substract the skipped tests. In other words, the sum of the missed, passed and failed test steps.

1

reference to the unplanned test steps

2

reference to the missed test steps

3

reference to the skipped test steps

4

reference to the passed test steps

5

reference to the failed test steps

is_skip

 $skip_on = is_skip( );
 ($skip_on, $skip_diag) = is_skip( );

Returns the object data set by the set_tests subroutine.

ok

 $test_ok = ok($actual_results, $expected_results, [@options]);
 $test_ok = ok($actual_results, $expected_results, {@options});
 $test_ok = ok($actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = ok($actual_results, $expected_results, $diagnostic, {@options});
 $test_ok = ok($actual_results, $expected_results, $diagnostic, $test_name, [@options]);
 $test_ok = ok($actual_results, $expected_results, $diagnostic, $test_name, {@options});

The $diagnostic, $test_name, [@options], and {@options} inputs are optional. The $actual_results and $expected_results inputs may be references to any type of data structures. The @options is a hash input that will process the 'diagnostic' key the same as the $diagnostic input and the 'name' key the same as the $test_name input.

The ok method is a cover function for the &Test::ok subroutine that extends the &Test::ok routine as follows:

ok_sub

 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, [@options]);
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, {@options});
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, {@options});
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);
 $test_ok = ok_sub(\&subroutine, $actual_results, $expected_results, $diagnostic, $test_name, {@options});

The ok_sub subroutine will execute the below:

 $sub_ok = &subroutine( $actual_results, $expected_results)

The ok_sub subroutine will add additional information to $diagnostic and pass the $sub_ok and other inputs along to ok subroutine as follows:

 $test_ok = ok($sub_ok, 1, $diagnostic, $test_name, [@options]); 

plan

 $success = plan(@args);

The plan subroutine is a cover method for &Test::plan. The @args are passed unchanged to &Test::plan. All arguments are options. Valid options are as follows:

tests

The number of tests. For example

 tests => 14,
todo

An array of test that will fail. For example

 todo => [3,4]
onfail

A subroutine that the Test module will execute on a failure. For example,

 onfail => sub { warn "CALL 911!" } 

skip

 $test_ok = skip($skip_test, $actual_results,  $expected_results, [@options]);
 $test_ok = skip($skip_test, $actual_results,  $expected_results, {@options});
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, [@options]);
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, {@options});
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, $test_name, [@options]);
 $test_ok = skip($skip_test, $actual_results,  $expected_results, $diagnostic, $test_name, {@options});

The $diagnostic, $test_name, [@options], and {@options} inputs are optional. The $actual_results and $expected_results inputs may be references to any type of data structures. The @options is a hash input that will process the 'diagnostic' key the same as the $diagnostic input and the 'name' key the same as the $test_name input.

The skip subroutine is a cover function for the &Test::skip subroutine that extends the &Test::skip the same as the ok subroutine subroutine extends the &Test::ok subroutine.

ok_skip

 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, [@options]);
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, {@options});
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, [@options]);
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, {@options});
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, $test_name, [@options]);
 $test_ok = skip_sub(\&subroutine, $skip_test, $actual_results, $expected_results, $diagnostic, $test_name, {@options});

The skip_sub subroutine will execute the below:

 $sub_ok = &subroutine( $actual_results, $expected_results)

The skip_sub subroutine will add additional information to $diagnostic and pass the $sub_ok and other inputs along to skip subroutine as follows:

 $test_ok = skip($skip_test, $sub_ok, 1, $diagnostic, $test_name, [@options]); 

skip_tests

 $skip_on = skip_tests( $on_off );
 $skip_on = skip_tests( );

The skip_tests subroutine sets a flag that causes the ok and the skip methods to skip testing.

stringify subroutine

 $string = stringify( $var );
 $string = stringify($var, @options); 
 $string = stringify($var, [@options]);
 $string = stringify($var, {@options});

The stringify subroutine will stringify $var using the "Data::Secs2::stringify subroutine" module only if $var is a reference; otherwise, it leaves it unchanged.

tech_config

 $old_value = tech_config( $dot_index, $new_value );

The tech_config subroutine reads and writes the below configuration variables

 dot index              contents           mode
 --------------------   --------------     --------
 Test.ntest             $Test::ntest       read only 
 Test.TESTOUT           $Test::TESTOUT     read write
 Test.TestLevel         $Test::TestLevel   read write
 Test.ONFAIL            $Test::ONFAIL      read write
 Test.TESTERR           $Test::TESTERR     read write
 Skip_Tests             # boolean          read write

The tech_config subroutine always returns the $old_value of $dot_index and only writes the contents if $new_value is defined.

The 'SCALAR' and 'ARRAY' references are transparent. The tech_config subroutine, when it senses that the $dot_index is for a 'SCALAR' and 'ARRAY' reference, will read or write the contents instead of the reference.

The The tech_config subroutine will read 'HASH" references but will never change them.

The variables for the top level 'Dumper' $dot_index are established by "Data::Dumper" module; for the top level 'Test', the "Test" module.

REQUIREMENTS ^

Coming soon.

DEMONSTRATION ^

 #########
 # perl Tech.d
 ###

~~~~~~ Demonstration overview ~~~~~

The results from executing the Perl Code follow on the next lines as comments. For example,

 2 + 2
 # 4

~~~~~~ The demonstration follows ~~~~~

     use File::Spec;

     use File::Package;
     my $fp = 'File::Package';

     use Text::Scrub;
     my $s = 'Text::Scrub';

     use File::SmartNL;
     my $snl = 'File::SmartNL';

     my $uut = 'Test::Tech';
 $snl->fin('techA0.t')

 # '#!perl
 ##
 ##
 #use 5.001;
 #use strict;
 #use warnings;
 #use warnings::register;
 #use vars qw($VERSION $DATE);
 #$VERSION = '0.13';
 #$DATE = '2004/04/15';

 #BEGIN {
 #   use FindBin;
 #   use File::Spec;
 #   use Cwd;
 #   use vars qw( $__restore_dir__ );
 #   $__restore_dir__ = cwd();
 #   my ($vol, $dirs) = File::Spec->splitpath($FindBin::Bin,'nofile');
 #   chdir $vol if $vol;
 #   chdir $dirs if $dirs;
 #   use lib $FindBin::Bin;

 #   # Add the directory with "Test.pm" version 1.15 to the front of @INC
 #   # Thus, 'use Test;' in  Test::Tech, will find Test.pm 1.15 first
 #   unshift @INC, File::Spec->catdir ( cwd(), 'V001015'); 

 #   # Create the test plan by supplying the number of tests
 #   # and the todo tests
 #   require Test::Tech;
 #   Test::Tech->import( qw(plan ok skip skip_tests tech_config finish) );
 #   plan(tests => 8, todo => [4, 8]);
 #}

 #END {
 #   # Restore working directory and @INC back to when enter script
 #   @INC = @lib::ORIG_INC;
 #   chdir $__restore_dir__;
 #}

 #my $x = 2;
 #my $y = 3;

 ##  ok:  1 - Using Test 1.15
 #ok( $Test::VERSION, '1.15', '', 'Test version');

 #skip_tests( 1 ) unless ok( #  ok:  2 - Do not skip rest
 #    $x + $y, # actual results
 #    5, # expected results
 #    '', 'Pass test'); 

 ##  ok:  3
 ##
 #skip( 1, # condition to skip test   
 #      ($x*$y*2), # actual results
 #      6, # expected results
 #      '','Skipped tests');

 ##  zyw feature Under development, i.e todo
 #ok( #  ok:  4
 #    $x*$y*2, # actual results
 #    6, # expected results
 #    '','Todo Test that Fails');

 #skip_tests(1) unless ok( #  ok:  5
 #    $x + $y, # actual results
 #    6, # expected results
 #    '','Failed test that skips the rest'); 

 #ok( #  ok:  6
 #    $x + $y + $x, # actual results
 #    9, # expected results
 #    '', 'A test to skip');

 #ok( #  ok:  7
 #    $x + $y + $x + $y, # actual results
 #    10, # expected results
 #    '', 'A not skip to skip');

 #skip_tests(0);
 #ok( #  ok:  8
 #    $x*$y*2, # actual results
 #         12, # expected results
 #         '', 'Stop skipping tests. Todo Test that Passes');

 #ok( #  ok:  9
 #    $x * $y, # actual results
 #    6, # expected results
 #    {name => 'Unplanned pass test'}); 

 #finish(); # pick up stats

 #__END__

 #=head1 COPYRIGHT

 #This test script is public domain.

 #=cut

 ### end of test script file ##

 #'
 #

 ##################
 # Run test script techA0.t using Test 1.15
 # 

     my $actual_results = `perl techA0.t`;
     $snl->fout('tech1.txt', $actual_results);

 ##################
 # Run test script techA0.t using Test 1.15
 # 

 $s->scrub_probe($s->scrub_file_line($actual_results))

 # '1..8 todo 4 8;
 #ok 1 - Test version 
 #ok 2 - Pass test 
 #ok 3 - Skipped tests  # skip
 #not ok 4 - Todo Test that Fails 
 ## Test 4 got: '12' (xxxx.t at line 000 *TODO*)
 ##   Expected: '6'
 #not ok 5 - Failed test that skips the rest 
 ## Test 5 got: '5' (xxxx.t at line 000)
 ##   Expected: '6'
 #ok 6 - A test to skip  # skip - Test not performed because of previous failure.
 #ok 7 - A not skip to skip  # skip - Test not performed because of previous failure.
 #ok 8 - Stop skipping tests. Todo Test that Passes  # (xxxx.t at line 000 TODO?!)
 #ok 9 - Unplanned pass test 
 ## Extra  : 9
 ## Skipped: 3 6 7
 ## Failed : 4 5
 ## Passed : 4/6 66%
 #'
 #
 $snl->fin('techC0.t')

 # '#!perl
 ##
 ##
 #use 5.001;
 #use strict;
 #use warnings;
 #use warnings::register;

 #use vars qw($VERSION $DATE);
 #$VERSION = '0.13';
 #$DATE = '2004/04/13';

 #BEGIN {
 #   use FindBin;
 #   use File::Spec;
 #   use Cwd;
 #   use vars qw( $__restore_dir__ );
 #   $__restore_dir__ = cwd();
 #   my ($vol, $dirs) = File::Spec->splitpath($FindBin::Bin,'nofile');
 #   chdir $vol if $vol;
 #   chdir $dirs if $dirs;
 #   use lib $FindBin::Bin;

 #   # Add the directory with "Test.pm" version 1.24 to the front of @INC
 #   # Thus, load Test::Tech, will find Test.pm 1.24 first
 #   unshift @INC, File::Spec->catdir ( cwd(), 'V001024'); 

 #   # Create the test plan by supplying the number of tests
 #   # and the todo tests
 #   require Test::Tech;
 #   Test::Tech->import( qw(plan ok skip skip_tests tech_config finish) );
 #   plan(tests => 2, todo => [1]);

 #}

 #END {
 #   # Restore working directory and @INC back to when enter script
 #   @INC = @lib::ORIG_INC;
 #   chdir $__restore_dir__;
 #}

 ## 1.24 error goes to the STDERR
 ## while 1.15 goes to STDOUT
 ## redirect STDERR to the STDOUT
 #tech_config('Test.TESTERR', \*STDOUT);

 #my $x = 2;
 #my $y = 3;

 ##  xy feature Under development, i.e todo
 #ok( #  ok:  1
 #    [$x+$y,$y-$x], # actual results
 #    [5,1], # expected results
 #    '', 'Todo test that passes');

 #ok( #  ok:  2
 #    [$x+$y,$x*$y], # actual results
 #    [6,5], # expected results
 #    '', 'Test that fails');

 #finish() # pick up stats

 #__END__

 #=head1 COPYRIGHT

 #This test script is public domain.

 #=cut

 ### end of test script file ##

 #'
 #

 ##################
 # Run test script techC0.t using Test 1.24
 # 

     $actual_results = `perl techC0.t`;
     $snl->fout('tech1.txt', $actual_results);
 $s->scrub_probe($s->scrub_file_line($actual_results))

 # '1..2 todo 1;
 #ok 1 - Todo test that passes  # (xxxx.t at line 000 TODO?!)
 #not ok 2 - Test that fails 
 ## Test 2 got: 'U1[1] 80
 #N[2] 5 6
 #' (xxxx.t at line 000)
 ##   Expected: 'U1[1] 80
 #N[2] 6 5
 #'
 ## Failed : 2
 ## Passed : 1/2 50%
 #'
 #
 $snl->fin('techE0.t')

 # '#!perl
 ##
 ##
 #use 5.001;
 #use strict;
 #use warnings;
 #use warnings::register;

 #use vars qw($VERSION $DATE);
 #$VERSION = '0.08';
 #$DATE = '2004/04/13';

 #BEGIN {
 #   use FindBin;
 #   use File::Spec;
 #   use Cwd;
 #   use vars qw( $__restore_dir__ );
 #   $__restore_dir__ = cwd();
 #   my ($vol, $dirs) = File::Spec->splitpath($FindBin::Bin,'nofile');
 #   chdir $vol if $vol;
 #   chdir $dirs if $dirs;
 #   use lib $FindBin::Bin;

 #   # Add the directory with "Test.pm" version 1.24 to the front of @INC
 #   # Thus, load Test::Tech, will find Test.pm 1.24 first
 #   unshift @INC, File::Spec->catdir ( cwd(), 'V001024'); 

 #   require Test::Tech;
 #   Test::Tech->import( qw(finish is_skip plan ok skip skip_tests tech_config ) );
 #   plan(tests => 10, todo => [4, 8]);
 #}

 #END {
 #   # Restore working directory and @INC back to when enter script
 #   @INC = @lib::ORIG_INC;
 #   chdir $__restore_dir__;
 #}

 ## 1.24 error goes to the STDERR
 ## while 1.15 goes to STDOUT
 ## redirect STDERR to the STDOUT
 #tech_config('Test.TESTERR', \*STDOUT);

 #my $x = 2;
 #my $y = 3;

 ##  ok:  1 - Using Test 1.24
 #ok( $Test::VERSION, '1.24', '', 'Test version');

 #skip_tests( 1 ) unless ok(   #  ok:  2 - Do not skip rest
 #    $x + $y, # actual results
 #    5, # expected results
 #    {name => 'Pass test'} ); 

 #skip( #  ok:  3
 #      1, # condition to skip test   
 #      ($x*$y*2), # actual results
 #      6, # expected results
 #      {name => 'Skipped tests'});

 ##  zyw feature Under development, i.e todo
 #ok( #  ok:  4
 #    $x*$y*2, # actual results
 #    6, # expected results
 #    [name => 'Todo Test that Fails',
 #    diagnostic => 'Should Fail']);

 #skip_tests(1,'Skip test on') unless ok(  #  ok:  5
 #    $x + $y, # actual results
 #    6, # expected results
 #    [diagnostic => 'Should Turn on Skip Test', 
 #     name => 'Failed test that skips the rest']); 

 #my ($skip_on, $skip_diag) = is_skip();

 #ok( #  ok:  6 
 #    $x + $y + $x, # actual results
 #    9, # expected results
 #    '', 'A test to skip');

 #ok( #  ok:  7 
 #    skip_tests(0), # actual results
 #    1, # expected results
 #    '', 'Turn off skip');

 #ok( #  ok:  8 
 #    [$skip_on, $skip_diag], # actual results
 #    [1,'Skip test on'], # expected results
 #    '', 'Skip flag');

 #finish() # pick up stats

 #__END__

 #=head1 COPYRIGHT

 #This test script is public domain.

 #=cut

 ### end of test script file ##

 #'
 #

 ##################
 # Run test script techE0.t using Test 1.24
 # 

     $actual_results = `perl techE0.t`;
     $snl->fout('tech1.txt', $actual_results);
 $s->scrub_probe($s->scrub_file_line($actual_results))

 # '1..10 todo 4 8;
 #ok 1 - Test version 
 #ok 2 - Pass test 
 #ok 3 - Skipped tests  # skip
 #not ok 4 - Todo Test that Fails 
 ## Test 4 got: '12' (xxxx.t at line 000 *TODO*)
 ##   Expected: '6' (Should Fail)
 #not ok 5 - Failed test that skips the rest 
 ## Test 5 got: '5' (xxxx.t at line 000)
 ##   Expected: '6' (Should Turn on Skip Test)
 #ok 6 - A test to skip  # skip - Skip test on
 #ok 7 - Turn off skip 
 #ok 8 - Skip flag  # (xxxx.t at line 000 TODO?!)
 #not ok 9 Not Performed # missing 
 ## Test 9 got: (Missing)
 ## Expected: (Missing)
 #not ok 10 Not Performed # missing 
 ## Test 10 got: (Missing)
 ## Expected: (Missing)
 ## Missing: 9 10
 ## Skipped: 3 6
 ## Failed : 4 5 9 10
 ## Passed : 4/8 50%
 #'
 #
 $snl->fin('techF0.t')

 # '#!perl
 ##
 ##
 #use 5.001;
 #use strict;
 #use warnings;
 #use warnings::register;

 #use vars qw($VERSION $DATE);
 #$VERSION = '0.08';
 #$DATE = '2004/04/13';

 #BEGIN {
 #   use FindBin;
 #   use File::Spec;
 #   use Cwd;
 #   use vars qw( $__restore_dir__ );
 #   $__restore_dir__ = cwd();
 #   my ($vol, $dirs) = File::Spec->splitpath($FindBin::Bin,'nofile');
 #   chdir $vol if $vol;
 #   chdir $dirs if $dirs;
 #   use lib $FindBin::Bin;

 #   # Add the directory with "Test.pm" version 1.24 to the front of @INC
 #   # Thus, load Test::Tech, will find Test.pm 1.24 first
 #   unshift @INC, File::Spec->catdir ( cwd(), 'V001024'); 

 #   require Test::Tech;
 #   Test::Tech->import( qw(finish is_skip plan ok ok_sub
 #                          skip skip_sub skip_tests tech_config) );
 #   plan(tests => 7);
 #}

 #END {
 #   # Restore working directory and @INC back to when enter script
 #   @INC = @lib::ORIG_INC;
 #   chdir $__restore_dir__;
 #}

 ## 1.24 error goes to the STDERR
 ## while 1.15 goes to STDOUT
 ## redirect STDERR to the STDOUT
 #tech_config('Test.TESTERR', \*STDOUT);
 ##  ok:  1 - Using Test 1.24
 #ok( $Test::VERSION, '1.24', '', 'Test version');

 #ok_sub( #  ok:  2 
 #    \&tolerance, # critera subroutine
 #    99, # actual results
 #    [100,10], # expected results
 #    'tolerance(x)', 
 #    'ok tolerance subroutine');

 #ok_sub( #  ok:  3
 #    \&tolerance, # critera subroutine
 #    80, # actual results
 #    [100,10], # expected results
 #    'tolerance(x)', 
 #    'not ok tolerance subroutine');

 #skip_sub( #  ok:  3 
 #    \&tolerance, # critera subroutine
 #    0, # do no skip
 #    99, # actual results
 #    [100,10], # expected results
 #    'tolerance(x)', 
 #    'no skip - ok tolerance subroutine');

 #skip_sub( #  ok:  4
 #    \&tolerance, # critera subroutine
 #    0,  # do no skip
 #    80, # actual results
 #    [100,10], # expected results
 #    'tolerance(x)', 
 #    'no skip - not ok tolerance subroutine');

 #skip_sub( #  ok:  5
 #    \&tolerance, # critera subroutine
 #    1,  # skip
 #    80, # actual results
 #    [100,10], # expected results
 #    'tolerance(x)', 
 #    'skip tolerance subroutine');

 #finish(); # pick up stats

 #sub tolerance
 #{   my ($actual,$expected) = @_;
 #    my ($average, $tolerance) = @$expected;
 #    use integer;
 #    $actual = (($average - $actual) * 100) / $average;
 #    no integer;
 #    (-$tolerance < $actual) && ($actual < $tolerance) ? 1 : 0;
 #}

 #__END__

 #=head1 COPYRIGHT

 #This test script is public domain.

 #=cut

 ### end of test script file ##

 #'
 #

 ##################
 # Run test script techF0.t using Test 1.24
 # 

     $actual_results = `perl techF0.t`;
     $snl->fout('tech1.txt', $actual_results);
 $s->scrub_probe($s->scrub_file_line($actual_results))

 # '1..7
 #ok 1 - Test version 
 #ok 2 - ok tolerance subroutine 
 #not ok 3 - not ok tolerance subroutine 
 ## Test 3 got: '0' (xxxx.t at line 000)
 ##   Expected: '1' (tolerance(x)
 ## got: 80
 ## expected: U1[1] 80
 ## N[2] 100 10
 ## 
 ##)
 #ok 4 - no skip - ok tolerance subroutine 
 #not ok 5 - no skip - not ok tolerance subroutine 
 ## Test 5 got: '0' (xxxx.t at line 000)
 ##   Expected: '1' (tolerance(x)
 ## got: 80
 ## expected: U1[1] 80
 ## N[2] 100 10
 ## 
 ##)
 #ok 6 - skip tolerance subroutine  # skip
 #not ok 7 Not Performed # missing 
 ## Test 7 got: (Missing)
 ## Expected: (Missing)
 ## Missing: 7
 ## Skipped: 6
 ## Failed : 3 5 7
 ## Passed : 3/6 50%
 #'
 #

 ##################
 # config Test.ONFAIL, read undef
 # 

 my $tech = new Test::Tech
 $tech->tech_config('Test.ONFAIL')

 # undef
 #

 ##################
 # config Test.ONFAIL, read undef, write 0
 # 

 $tech->tech_config('Test.ONFAIL',0)

 # undef
 #

 ##################
 # config Test.ONFAIL, read 0
 # 

 $tech->tech_config('Test.ONFAIL')

 # 0
 #

 ##################
 # 0, read 0
 # 

 $Test::ONFAIL

 # 0
 #

 ##################
 # restore Test.ONFAIL on finish
 # 

      $tech->finish( );
      $Test::planned = 1;  # keep going

 ##################
 # Test.ONFAIL restored by finish()
 # 

 $tech->tech_config('Test.ONFAIL')

 # 0
 #
 unlink 'tech1.txt'
 unlink 'tech1.txt'

QUALITY ASSURANCE ^

Running the test script Tech.t verifies the requirements for this module. The tmake.pl cover script for Test::STDmaker automatically generated the Tech.t test script, Tech.d demo script, and t::File::Drawing STD program module POD, from the t::File::Tech::Tech program module contents. The tmake.pl cover script automatically ran the Tech.d demo script and inserted the results into the 'DEMONSTRATION' section above. The t::Test::Tech::Tech program module is in the distribution file File-Drawing-$VERSION.tar.gz.

NOTES ^

Author

The holder of the copyright and maintainer is

<support@SoftwareDiamonds.com>

Copyright Notice

Copyrighted (c) 2002 Software Diamonds

All Rights Reserved

Binding Requirement Notice

Binding requirements are indexed with the pharse 'shall[dd]' where dd is an unique number for each header section. This conforms to standard federal government practices, US DOD 490A 3.2.3.6. In accordance with the License, Software Diamonds is not liable for any requirement, binding or otherwise.

License

Software Diamonds permits the redistribution and use in source and binary forms, with or without modification, provided that the following conditions are met:

  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
  3. Commercial installation of the binary or source must visually present to the installer the above copyright notice, this list of conditions intact, that the original source is available at http://softwarediamonds.com and provide means for the installer to actively accept the list of conditions; otherwise, a license fee must be paid to Softwareware Diamonds.

SOFTWARE DIAMONDS, http://www.softwarediamonds.com, PROVIDES THIS SOFTWARE 'AS IS' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SOFTWARE DIAMONDS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING USE OF THIS SOFTWARE, EVEN IF ADVISED OF NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE POSSIBILITY OF SUCH DAMAGE.

SEE ALSO ^

Test
Test::Harness
Data::Secs2
Data::SecsPack
syntax highlighting: