# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### sub writeTestScript(@) { my ($line) = @_; # write the test script to ./_TST_ unlink '_TST_'; open FH, '> _TST_'; print FH $line . "\n"; close \*FH; } sub readSTDOUTfile() { return undef if( ! -f '/tmp/_tst_STDOUT' ); open FH, '/tmp/_tst_STDOUT' || return undef; my @SO = ; return \@SO; } sub readSTDERRfile() { return undef if( ! -f '/tmp/_tst_STDERR' ); open FH, '/tmp/_tst_STDERR' || return undef; my @SE = ; return \@SE; } sub readLOGfile() { return undef if( ! -f '/tmp/_TST_.log' ); open FH, '/tmp/_TST_.log' || return undef; my @SE = ; return \@SE; } sub getResults($) { my ($opt) = @_; my $stdout = readSTDOUTfile(); my $stderr = readSTDERRfile(); my $logfile= readLOGfile(); return $stdout, $stderr, $logfile; } sub mkTST(@) { my ($line, $opt) = @_; writeTestScript($line); # clean up system( "rm -f /tmp/_TST_*.log /tmp/_tst_*.log" ); # run test $opt = defined $opt ? $opt : ''; my $rc = system( "perl _TST_ $opt >/tmp/_tst_STDOUT 2>/tmp/_tst_STDERR" ); return $rc/256, getResults($opt); } ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More; BEGIN { plan tests => 18 }; use Script::Toolbox qw(:all); ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. #1-4 # PRINT TO STDERR (default channel) # STDOUT: empty # STDERR: "_TST_: Thu Aug 26 11:25:27 2004: logtest" # LOGFILE: undefined ($rc, $sout, $serr, $logf) = mkTST( q(use Script::Toolbox qw(:all); Script::Toolbox->new(); Log("logtest");) ); is( $rc, 0, 'Log' ); ok( $#{$sout} == -1, 'Log' ); ok( !defined $logf, 'Log'); like( $serr->[0], qr/^_TST_: [A-z]{3} [A-z]{3} +\d{1,2} \d{2}:\d{2}:\d{2} \d{4}: logtest/, 'Log' ); #5-8 # PRINT TO STDOUT # STDOUT: "_TST_: Thu Aug 26 11:25:27 2004: logtest" # STDERR: empty # LOGFILE: undefined ($rc, $sout, $serr, $logf) = mkTST( q(use Script::Toolbox qw(:all); Script::Toolbox->new(); Log("logtest", 'STDOUT');) ); is( $rc, 0, 'Log' ); ok( $#{$serr} == -1, 'Log' ); ok( !defined $logf, 'Log'); like( $sout->[0], qr/^_TST_: [A-z]{3} [A-z]{3} +\d{1,2} \d{2}:\d{2}:\d{2} \d{4}: logtest/, 'Log' ); #9-14 # PRINT TO file # STDOUT: empty # STDERR: empty # LOGFILE: undefined # /tmp/logfile: "_TST_: Thu Aug 26 11:25:27 2004: logtest" ($rc, $sout, $serr, $logf) = mkTST( q(use Script::Toolbox qw(:all); Script::Toolbox->new(); Log("logtest", '/tmp/logfile');) ); is( $rc, 0, 'Log' ); ok( $#{$serr} == -1, 'Log' ); ok( $#{$sout} == -1, 'Log' ); ok( !defined $logf, 'Log'); ok( -r '/tmp/logfile', 'Log'); open( FH ,'/tmp/logfile' );@x = ; like( $x[0], qr/^_TST_: [A-z]{3} [A-z]{3} +\d{1,2} \d{2}:\d{2}:\d{2} \d{4}: logtest/, 'Log' ); unlink ( '/tmp/logfile'); #15-18 # PRINT TO default logfile # STDOUT: empty # STDERR: empty # LOGFILE: "_TST_: Thu Aug 26 11:25:27 2004: logtest" # /tmp/logfile: "_TST_: Thu Aug 26 11:25:27 2004: logtest" ($rc, $sout, $serr, $logf) = mkTST(q(use Script::Toolbox qw(:all); Script::Toolbox->new({'logdir'=>{'mod'=>'=s','desc'=>'Base directory for logging.','mand'=>0,}}); Log("logtest"); ), '-logdir /tmp' ); is( $rc, 0, 'Log' ); ok( $#{$serr} == -1, 'Log' ); ok( $#{$sout} == -1, 'Log' ); like( $logf->[0], qr/^_TST_: [A-z]{3} [A-z]{3} +\d{1,2} \d{2}:\d{2}:\d{2} \d{4}: logtest/, 'Log' ); unlink "/tmp/_tst_STDOUT"; unlink "/tmp/_tst_STDERR";