5 s2p.t - test suite for s2p/psed
11 (a) run psed with a sed script and input data to obtain some output
12 (b) run s2p with a sed script creating a Perl program and then run the
13 Perl program with the input data, again producing output
15 Both final outputs should be identical to the expected output.
17 A $testcase{<name>} contains entries (after the comment ### <name> ###):
19 - script: the sed script
20 - input: the key of the input data, stored in $input{<input>}
21 - expect: the expected output
22 - datfil: an additional file [ <path>, <data> ] (if required)
24 Temporary files are created in the working directory (embedding $$
25 in the name), and removed after the test.
27 Except for bin2dec (which indeed converts binary to decimal) none of the
28 sed scripts is doing something useful.
30 Author: Wolfgang Laun.
44 $ENV{PSEDEXTBRE} = '<>wW';
67 # This script should be run on itself
73 /^#\(..\)\(..\)\2\1*$/p
74 /^#[abc]\{1,\}[def]\{1,\}$/p
93 script => <<'[TheEnd]',
95 s/^[ ]*\([01]\{1,\}\)[ ]*/\1/
98 is not a binary number
101 # expand binary to Xs
106 s/^\(X\{1,\}\)0/\1\1/
107 s/^\(X\{1,\}\)1/\1\1X/
110 # count Xs in decimal
127 expect => <<'[TheEnd]',
138 script => <<'[TheEnd]',
143 expect => <<'[TheEnd]',
159 script => <<'[TheEnd]',
173 expect => <<'[TheEnd]',
199 script => <<'[TheEnd]',
207 expect => <<'[TheEnd]',
223 script => <<'[TheEnd]',
235 expect => <<'[TheEnd]',
249 script => <<'[TheEnd]',
258 expect => <<'[TheEnd]',
266 script => <<'[TheEnd]',
278 expect => <<'[TheEnd]',
296 script => <<'[TheEnd]',
304 expect => <<'[TheEnd]',
316 script => "#no autoprint\n1,3{\n=\np\n}",
318 expect => <<'[TheEnd]',
330 script => <<'[TheEnd]',
347 expect => <<'[TheEnd]',
361 script => <<'[TheEnd]',
375 expect => <<'[TheEnd]',
386 script => <<'[TheEnd]',
388 replace all except line 3
392 expect => <<'[TheEnd]',
393 replace all except line 3
394 replace all except line 3
396 replace all except line 3
397 replace all except line 3
398 replace all except line 3
399 replace all except line 3
400 replace all except line 3
406 script => <<'[TheEnd]',
408 replace all except 1-4
411 replace all except 5-8
414 expect => <<'[TheEnd]',
415 replace all except 5-8
416 replace all except 5-8
417 replace all except 5-8
418 replace all except 5-8
419 replace all except 1-4
420 replace all except 1-4
421 replace all except 1-4
422 replace all except 1-4
428 script => <<'[TheEnd]',
429 # d delete pattern space, start next cycle
434 expect => <<'[TheEnd]',
444 script => <<'[TheEnd]',
452 expect => <<'[TheEnd]',
463 script => <<'[TheEnd]',
474 expect => <<'[TheEnd]',
492 script => <<'[TheEnd]',
504 expect => <<'[TheEnd]',
520 script => <<'[TheEnd]',
526 expect => <<'[TheEnd]',
540 script => <<'[TheEnd]',
544 append to line 3 - should not appear in output
548 expect => <<'[TheEnd]',
558 datfil => [ 'r.txt', "r.txt line 1\nr.txt line 2\nr.txt line 3\n" ],
559 script => <<'[TheEnd]',
564 expect => <<'[TheEnd]',
584 script => <<'[TheEnd]',
585 # enclose any `(a)'.. `(c)' in `-'
591 expect => <<'[TheEnd]',
605 script => <<'[TheEnd]',
611 # this is literal { }
618 expect => <<'[TheEnd]',
632 script => join( "\n",
633 '#no autoprint', 's/./X/p', 's/foo/bar/p', 't bye', '=', 'p', ':bye' ),
635 expect => <<'[TheEnd]',
649 datfil => [ 'w.txt', '' ],
650 script => <<'[TheEnd]',
654 expect => <<'[TheEnd]',
668 script => <<'[TheEnd]',
675 expect => <<'[TheEnd]',
695 script => <<'[TheEnd]',
696 y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
701 expect => <<'[TheEnd]',
715 script => <<'[TheEnd]',
718 # delete line, append NL to hold space
723 # last line only: get hold
743 expect => <<'[TheEnd]',
750 script => <<'[TheEnd]',
752 # This script should be run on itself
758 /^#\(..\)\(..\)\2\1*$/p
759 /^#[abc]\{1,\}[def]\{1,\}$/p
772 expect => <<'[TheEnd]',
780 my $ntc = 2 * keys %testcase;
783 # temporary file names
784 my $script = "s2pt$$.sed";
785 my $stdin = "s2pt$$.in";
786 my $plsed = "s2pt$$.pl";
788 # various command lines for
789 my $s2p = File::Spec->catfile( File::Spec->updir(), 'x2p', 's2p' );
790 my $psed = File::Spec->catfile( File::Spec->curdir(), 'psed' );
792 # default in the .com extenson if it's not already there
793 $s2p = VMS::Filespec::vmsify($s2p);
794 $psed = VMS::Filespec::vmsify($psed);
795 # Converting file specs from Unix format to VMS with the extended
796 # character set active can result in a trailing '.' added for null
797 # extensions. This must be removed if the intent is to default the
801 $s2p = VMS::Filespec::rmsexpand($s2p, '.com');
802 $psed = VMS::Filespec::rmsexpand($psed, '.com');
804 my $sedcmd = [ $psed, '-f', $script, $stdin ];
805 my $s2pcmd = [ $s2p, '-f', $script ];
806 my $plcmd = [ $plsed, $stdin ];
808 # psed: we create a local copy as linking may not work on some systems.
812 # process all testcases
815 for my $tc ( sort keys %testcase ){
816 my( $psedres, $s2pres );
820 open( SED, ">$script" ) || goto FAIL_BOTH;
821 my $script = $testcase{$tc}{script};
823 # additional files for r, w: patch script, inserting temporary names
824 if( exists( $testcase{$tc}{datfil} ) ){
825 my( $datnam, $datdat ) = @{$testcase{$tc}{datfil}};
826 my $datfil = "s2pt$$" . $datnam;
827 push( @aux, $datfil );
828 open( DAT, ">$datfil" ) || goto FAIL_BOTH;
831 $script =~ s/\%$datnam\%/$datfil/eg;
834 close( SED ) || goto FAIL_BOTH;
838 if( $indat ne $testcase{$tc}{input} ){
839 $indat = $testcase{$tc}{input};
840 open( IN, ">$stdin" ) || goto FAIL_BOTH;
841 print IN $input{$indat};
842 close( IN ) || goto FAIL_BOTH;
845 # on VMS, runperl eats blank lines to work around
846 # spurious newlines in pipes
847 $testcase{$tc}{expect} =~ s/\n\n/\n/ if $^O eq 'VMS';
851 $psedres = runperl( args => $sedcmd );
852 is( $psedres, $testcase{$tc}{expect}, "psed $tc" );
855 # translate the sed script to a Perl program
857 my $perlprog = runperl( args => $s2pcmd );
858 open( PP, ">$plsed" ) || goto FAIL_S2P;
860 close( PP ) || goto FAIL_S2P;
862 # execute generated Perl program, compare
863 $s2pres = runperl( args => $plcmd );
864 is( $s2pres, $testcase{$tc}{expect}, "s2p $tc" );
874 for my $f ( $script, $stdin, $plsed, @aux ){
875 1 while unlink( $f ); # hats off to VMS...