Test::STDmaker::Check - checks a software test description short hand

Test-STDmaker documentation Contained in the Test-STDmaker distribution.

Index

Code Index:

NAME

Top

Test::STDmaker::Check - checks a software test description short hand

DESCRIPTION

Top

The Test::STDmaker::Check package is an internal driver package to the Test::STDmaker package that supports the Test::STDmaker::tmake() method. Any changes to the internal drive interface and this package will not even consider backward compatibility. Thus, this POD serves as a Software Design Folder documentation the current internal design of the Test::STDmaker and its driver packages.

The Test::STDmaker::Check package performs the following:

1

checks the STD database

2

creates a test description of ordered name,value pairs database array @{$self->{$module}->{test_db}}

3

generates a check script that numbers the ok the same as if generated by a test script The name for the check script is the STD database Temp field and usually is temp.pl.

4

Runs the check script to obtan a ok translation table.

5

Change the ok fields in the STD database according to the ok tranlation table from the check script.

The Test::STDmaker::Check package inherits the methods of the Test::STDmaker package. The Test::STDmaker build generate and <print> methods directs the Test::STDmaker::Check package to perform its work by calling its methods.

During the course of the processing the Test::STDmaker::Check package maintains the following in the $self object data hash:

$demo_only

Flags if the test is demo only and will be ignore as far as the generating the check test script

$demo_only_expected

Once only flag set by the A subroutine and reset by the next E subroutine. There should be no E subroutine after a A demo only subroutine.

$ok

Sequential count of the ok fields. This is the initial count enter in the test description data base and used by the clean script to record the true ok count from running the clean script.

$success

Use by the finish subroutine for a diagnostic dump if the process does not go right.

@todo

A list of todo tests.

The Test::STDmaker::Check package has the following options that are passed as part of the $self hash from Test::STDmaker methods:

fspec_out

The File_Spec field determines he file specification for the STD database. The finish routine will set the File_Spec to the fspec_out optin if it is present.

The post_generate subroutine will not unlink the check script (usually temp.pl) if there is a nounlink option.

TEST DESCRIPTION METHODS

Top

The test description methods clean up the STD database and contribute to the check script. Data from processing fields that are test descriptions are added to the @{$self->{std_db}} array in the same order as the test description fields. The $file_data return from the test description methods are appended to the check test script.

The test description methods are as follows.

A

 $file_data = A($command, $actual-expression );

The A subroutine appends $command, $actual-expression to @{$self->{std_db}} unchanged and returns '' for $file_data.

If demo_only exists, the A subroutine resets the demo_only flag and sets the demo_only_expected flag; otherwise it resets the demo_only_expected flag.

C

 $file_data = C($command, $code);

The C subroutine appends $command, $code to @{$self->{std_db}} unchanged and returns $code for $file_data.

DO

 $file_data = DO($command, $comment);

The DO subroutine appends $command, $comment to @{$self->{std_db}} unchanged and returns '' for $file_data.

The subroutine sets the $demo_only flag.

DM

 $file_data = DM($command, $msg);

The DM subroutine appends $command, $msg to @{$self->{std_db}} unchanged returns '' for $file_data.

E

 $file_data = E($command, $expected-expression);

The E subroutine appends $command, $expected-expression, 'ok', $ok++ to @{$self->{std_db}} and returns code for incrementing the test count and adding the test count to the ok database in $file_data.

N

 $file_data = N($command, $name_data);

The N subroutine appends $command, $name_data to @{$self->{std_db}} unchanged and returns '' for $file_data.

ok

 $file_data = ok($command, $test_number);

The ok subroutine does nothing.

QC

 $file_data = QC($command, $code);

The QC subroutine appends $command, $code to @{$self->{std_db}} unchanged and returns $code for $file_data.

R

 $file_data = R($command, $requirement_data);

The R subroutine appends $command, $requrement_data to @{$self->{std_db}} unchanged and returns '' for $file_data.

S

 $file_data = S($command, $expression);

The S subroutine appends $command, $expression to @{$self->{std_db}} unchanged and returns '' for $file_data.

SE

 $file_data = SE($command, $expected-expression);

The SE subroutine appends $command, $expected-expression, 'ok', $ok++ to @{$self->{std_db}} and returns code for incrementing the test count and adding the test count to the ok database in $file_data.

SF

 $file_data = SF($command, "$value,$msg");

The SF subroutine appends $command, "$value,$msg" to @{$self-{std_db}} unchanged and returns '' for $file_data.

T

 $file_data = T($command,  $tests );

The start subroutine initilizes @{$self->{std_db}} to (T,'') as the first name,value pair. There is only one T field per test description database. Thus, the T subroutine does nothing.

TS

 $file_data = TS(command, \&subroutine);

The TS subroutine appends $command, \&subroutine to @{$self-{std_db}} unchanged and returns '' for $file_data.

U

 $file_data = U($command, $comment);

The U subroutine appends $command, $comment to @{$self-{std_db}} unchanged and returns '' for $file_data.

VO

 $file_data = VO($command, $comment);

The VO subroutine appends $command, \&subroutine to @{$self-{std_db}} unchanged and returns '' for $file_data.

ADMINSTRATIVE METHODS

Top

AUTOLOAD

The AUTOLOAD subroutine is a catch for any STD database field that is not a test description fields. Without this catch, Test::STDmaker methods calls with these field names causes a false error.

start

 $file_data = start();

The start subroutine initilizes the object data. The start routine returns in $file_data the BEGIN and <END> block for the demo script. The BEGIN block loads the Test::Tech program module, changes the working directory to the directory of the demo script, and adds some extra directories to the front of @INC. The <END> block restores everything to the state before the execution of the BEGIN block.

finish

 $file_data = $success = finish();

The finish subroutine performs numerous checks and updates on the $self STD database fields. Some of the checks and updates are as follows:

The start subroutine returns in $file_data the code to dump the ok translation table.

post_print

 post_print()

The post_print subroutine picks up the ok translation table by running the check test script. The post_print subroutine runs through all the @{self-{std_db}}> database fields, replacing all ok fields with the value from the ok translation table. The post_print method updates the @{self-{std_db}}> database T field with the number of tests.

NOTES

Top

Author

The holder of the copyright and maintainer is

 E<lt>support@SoftwareDiamonds.comE<gt>

Copyrighted (c) 2002 Software Diamonds

All Rights Reserved

Binding Requirements

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, STD490A 3.2.3.6 (3.2.3.6 in Docs::US_DOD::STD490A). 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 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

Top

Test::Tech
Test
Test::Harness
Test::STDmaker
Test::STDmaker::STD
Test::STDmaker::Verify
Test::STDmaker::Demo
Software Test Description (Docs::US_DOD::STD)
Specification Practices (Docs::US_DOD::STD490A)
Software Development (Docs::US_DOD::STD2167A)
Test-STDmaker documentation Contained in the Test-STDmaker distribution. 
 #!perl
#
# Documentation, copyright and license is at the end of this file.
#
###########################

package  Test::STDmaker::Check;

use 5.001;
use strict;
use warnings;
use warnings::register;

use File::Spec;
use vars qw($VERSION $DATE);
use Cwd;
use File::AnySpec;

$VERSION = '1.15';
$DATE = '2004/05/23';

########
# Inherit classes
#
use Test::STDmaker;
use vars qw(@ISA);
@ISA = qw(Test::STDmaker);

use vars qw(@required_data_base);

#######
# The order of the required fields is the order printed out in the STD.
# Do not change them.
#
@required_data_base = qw(
   Name File_Spec UUT Revision Version End_User Author 
   STD2167_Template Detail_Template Classification Temp  
   Copyright HTML See_Also );

#############################################################################
#  
#                           TEST DESCRIPTION METHODS
#
#

sub  A 
{ 
    my ($self, $command, $data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);
    if($self->{$module}->{demo_only}) {
        $self->{$module}->{demo_only} = '';
        $self->{$module}->{demo_only_expected} = 1;
        return '';
    }
    if($self->{$module}->{demo_only_expected}) {
        $self->{$module}->{demo_only_expected} = '';
        return "\n";
    }
    '' 
}


sub C
{ 
    my ($self, $command, $data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);

    ($data) = $data =~ /^\s*(.*)\s*$/s; # drop leading trailing white space

    while (chomp $data) { };
    my $end_char = substr( $data,-1,1);
    unless( $self->{options}->{nosemi} ) {
        my $last_char = substr( $data, length($data)-1,1);
        $data .= ';' if $last_char ne ';' && $last_char ne '{'  && $last_char ne '}';
    }

    << "EOF";
   # Perl code from ${command}:
$data

EOF
 
}



sub DM { R(@_) }

#######
# These are test sections. Add to the test array,
#
sub DO
{ 
    my ($self, $command,$data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);
    $self->{$module}->{demo_only} = "    $data";
    ''
}



sub E
{
    my ($self, $command, $data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);

    if($self->{$module}->{demo_only_expected}) {
        $self->{$module}->{demo_only_expected} = '';
        return '';
    }

    push @{$self->{$module}->{test_db}}, ('ok', $self->{$module}->{ok});
    
    $data = << "EOF";

    ######
    # ok $self->{$module}->{ok}
    #
    \$__test__++; 
    \$__tests__{ $self->{$module}->{ok} } .= "\$__test__,";    

EOF

    $self->{$module}->{ok}++;

    $data
}

sub  N { R(@_) }

sub ok { T(@_) }

sub QC { C(@_) }


sub  R
{ 
    my ($self, $command, $data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);
    '' 
};



sub  S { R(@_) }

########
# Count the tests and provide results as a ok command, data pair
#
sub SE { E(@_) }

sub SF { R(@_) }
sub T { '' }
sub TS { R(@_) }


sub U 
{ 
    my ($self, $command, $data) = @_;
    my $module = ref($self);
    push @{$self->{$module}->{test_db}}, ($command, $data);
    push @{$self->{$module}->{todo}},$self->{$module}->{ok};
    ''
}


sub VO { R(@_) }


##################################################################################
#
#                            ADMINSTRATIVE METHODS
#
#

sub AUTOLOAD
{
    our $AUTOLOAD;
    return '' if $AUTOLOAD =~ /DESTROY/;
    my ($self, $command, $data) = @_;
    return '' unless $command && $data;
    $self->{$command} = $data;
    '';
}

sub file_out { 'temp.pl' }

sub finish
{

   my ($self) = @_;

   my $module = ref($self);

   ########
   #  Fill in the number of test at the first instruction
   #
   $self->{$module}->{test_db}->[1] = $self->{$module}->{ok} - 1;
   if (@{$self->{$module}->{todo}}) {
       my $todo = join ',', @{$self->{$module}->{todo}};
       $self->{$module}->{test_db}->[1] .= " - $todo" ;
   }

   ######
   # Replace the std_db with the checked and cleaned test_db
   #
   $self->{std_db} = $self->{$module}->{test_db};
   $self->{$module}->{test_db} = undef;


   #######
   # Change the UUT and Temp file specs with so
   # directed by the fspec_out option and define
   # all required fields
   #
   $self->{File_Spec} = 'Unix' unless $self->{File_Spec};

   my @required_data = @required_data_base;
   $self->{required_data} = \@required_data;
   foreach my $required (@required_data) {
       $self->{$required} = '' unless defined $self->{$required};
   }


   ######
   # Provide an default output file for all output generators
   #
   my ($package,$method,$error);
   foreach my $generator (@{$self->{generators}}) {
       $package = "Test::STDmaker::" . $generator;
       if ($package->can( 'file_out' )) {
           $method = "${package}::file_out";
           $self->{$package}->{file_out} = $self->$method();
           next;
       }

       if( !$self->{$generator} ) {
           $self->{$generator} = $self->{file};
           $self->{$generator} =~ s/\..*?$//; # drop extension
           $self->{$generator} .= $package->extension( );
       }

       #######
       # Change generator spec to current operating system spec
       #
       else {
           $self->{$generator} = File::AnySpec->fspec2os( 
                   $self->{File_Spec}, $self->{$generator} );
       }
       $self->{$package}->{file_out} = $self->{$generator};
   }


   #####
   # If not successful in the check, provide a diagnostic dump
   #
   unless( $self->{$module}->{success} ) {

       #######
       # Diagnostic dump
       #
       my $data_out;
       my $clean = new STD::GenType::Clean( $self );
       $clean->generate( );
       $clean->print( );

   }


   ######
   # Update the file specification
   #
   $self->{File_Spec} = $self->{options}->{fspec_out} if $self->{options}->{fspec_out};
   $self->{File_Spec} = 'Unix' unless $self->{File_Spec};
   
   << 'EOF';

   print "tests\n$__test__\n";

   foreach $__test__ (keys %__tests__) {
      print "$__test__\n$__tests__{$__test__}\n";
   }


EOF
}   



#####
#
# post print processing
#
sub post_print
{

    my ($self) = @_;
    my $module = ref($self);

    my $cwd = cwd();

    my $command = $self->perl_command() . ' ' . $self->{$module}->{file_out};
    my @tests = `$command`;
    return undef unless @tests;
    unlink $self->{$module}->{file_out} unless $self->{options}->{nounlink};
    pop @tests if @tests % 2; # try best if code messes up
    foreach my $test (@tests) {
         chomp $test;
    }
    my %tests = @tests;

    #######
    # Now that have the test number(s) according to the
    # execution of the code, replace the original ok
    # ident with the one obtained from the code.
    #
    my $db_p = $self->{std_db};
    for( my $i=0; $i < @$db_p; $i += 2) {
        if( $db_p->[$i] eq 'ok' ) {
            $db_p->[$i+1] = $tests{$db_p->[$i+1]};  # test according to code
            if( $db_p->[$i+1] ) {
               $db_p->[$i+1] = substr($db_p->[$i+1],0,length($db_p->[$i+1])-1); # drop last ', '
            }

            #######
            # ok never executed
            # 
            else {
               $db_p->[$i+1] = '';
            }
        }
        elsif( $db_p->[$i] eq 'T' ) {
            my $todo = '';
            foreach my $t (  @{$self->{$module}->{todo}}  ) {
                $todo .= "$tests{$t}";
            }
            $db_p->[$i+1] = "$tests{tests}";
            if ($todo) {
                $todo = substr($todo,0,length($todo)-1); # drop last ', '
                $db_p->[$i+1] .= " - $todo" ;
            }
        }
    }

    1

}

sub start
{

    my ($self) = @_;

    #########
    # Always lead off with a N and a T
    #
    my @test_db = ('T', '');
    my $module = ref($self);
    $self->{$module}->{test_db} =  \@test_db;
    $self->{$module}->{ok} = 1;
    $self->{$module}->{success} = 1;
    $self->{$module}->{todo} = [];
    $self->{$module}->{name} = '';

    ###########
    # use in variables without have to backslash escape the dollar sign
    # every which way in the below << here statement
    #   
    my ($__test__, $__restore_dir__) = ('$__test__', '$__restore_dir__');
    my ($vol, $dirs, $T) = ('$vol', '$dirs', '$T');

    << "EOF";
#!perl
#
#

BEGIN { 

    use Cwd;
    use FindBin;
    use File::Spec;
    use vars qw(%__tests__ $__test__ $__restore_dir__);
    
    $__test__ = 0;
    %__tests__ = ();

    ########
    # The working directory for this script file is the directory where
    # the test script resides. Thus, any relative files written or read
    # by this test script are located relative to this test script.
    #
    $__restore_dir__ = cwd();
    my ($vol, $dirs) = File::Spec->splitpath(\$FindBin::Bin,'nofile');
    chdir $vol if $vol;
    chdir $dirs if $dirs;

    #######
    # Pick up any testing program modules off this test script.
    #
    # When testing on a target site before installation, place any test
    # program modules that should not be installed in the same directory
    # as this test script. Likewise, when testing on a host with a \@INC
    # restricted to just raw Perl distribution, place any test program
    # modules in the same directory as this test script.
    #
    use lib \$FindBin::Bin;

    ########
    # Using Test::Tech, a very light layer over the module "Test" to
    # conduct the tests.  The big feature of the "Test::Tech: module
    # is that it takes expected and actual references and stringify
    # them by using "Data::Secs2" before passing them to the "&Test::ok"
    # Thus, almost any time of Perl data structures may be
    # compared by passing a reference to them to Test::Tech::ok
    #
    # Create the test plan by supplying the number of tests
    # and the todo tests
    #
    require Test::Tech;
    Test::Tech->import( qw(finish is_skip ok ok_sub plan skip 
                          skip_sub skip_tests tech_config) );

}

END {

   finish( );

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

}

EOF


}


1

__END__



### end of file ###