S_del_body is sufficiently small that inlining it is a space win.
[p5sagit/p5-mst-13.2.git] / t / x2p / s2p.t
1 #!./perl
2
3 =head1 NAME
4
5 s2p.t - test suite for s2p/psed
6
7 =head1 NOTES
8
9 The general idea is to
10
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
14
15 Both final outputs should be identical to the expected output.
16
17 A $testcase{<name>} contains entries (after the comment ### <name> ###):
18
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)
23
24 Temporary files are created in the working directory (embedding $$
25 in the name), and removed after the test.
26
27 Except for bin2dec (which indeed converts binary to decimal) none of the
28 sed scripts is doing something useful.
29
30 Author: Wolfgang Laun.
31
32 =cut
33
34 BEGIN {
35     chdir 't' if -d 't';
36     @INC = ( '../lib' );
37 }
38
39 ### use Test::More;
40 use File::Copy;
41 use File::Spec;
42 require './test.pl';
43
44 # BRE extensions
45 $ENV{PSEDEXTBRE} = '<>wW';
46
47 our %input = (
48    bins => <<'[TheEnd]',
49 0
50 111
51 1000
52 10001
53 [TheEnd]
54
55    text => <<'[TheEnd]',
56 line 1
57 line 2
58 line 3
59 line 4
60 line 5
61 line 6
62 line 7
63 line 8
64 [TheEnd]
65
66    adr1 => <<'[TheEnd]',
67 #no autoprint
68 # This script should be run on itself
69 /^#__DATA__$/,${
70    /^#A$/p
71    s/^# *[0-9]* *//
72    /^#\*$/p
73    /^#\.$/p
74    /^#\(..\)\(..\)\2\1*$/p
75    /^#[abc]\{1,\}[def]\{1,\}$/p
76 }
77 #__DATA__
78 #A
79 #*
80 #.
81 #abxyxy
82 #abxyxyab
83 #abxyxyabab
84 #ad
85 #abcdef
86 [TheEnd]
87 );
88
89
90 our %testcase = (
91
92 ### bin2dec ###
93 'bin2dec' => {
94   script => <<'[TheEnd]',
95 # binary -> decimal
96 s/^[    ]*\([01]\{1,\}\)[       ]*/\1/
97 t go
98 i\
99 is not a binary number
100 d
101
102 # expand binary to Xs
103 : go
104 s/^0*//
105 s/^1/X/
106 : expand
107 s/^\(X\{1,\}\)0/\1\1/
108 s/^\(X\{1,\}\)1/\1\1X/
109 t expand
110
111 # count Xs in decimal
112 : count
113 s/^X/1/
114 s/0X/1/
115 s/1X/2/
116 s/2X/3/
117 s/3X/4/
118 s/4X/5/
119 s/5X/6/
120 s/6X/7/
121 s/7X/8/
122 s/8X/9/
123 s/9X/X0/
124 t count
125 s/^$/0/
126 [TheEnd]
127   input  => 'bins',
128   expect => <<'[TheEnd]',
129 0
130 7
131 8
132 17
133 [TheEnd]
134 },
135
136
137 ### = ###
138 '=' => {
139   script => <<'[TheEnd]',
140 1=
141 $=
142 [TheEnd]
143   input  => 'text',
144   expect => <<'[TheEnd]',
145 1
146 line 1
147 line 2
148 line 3
149 line 4
150 line 5
151 line 6
152 line 7
153 8
154 line 8
155 [TheEnd]
156 },
157
158 ### D ###
159 'D' => {
160   script => <<'[TheEnd]',
161 #no autoprint
162 /1/{
163 N
164 N
165 N
166 D
167 }
168 p
169 /2/D
170 =
171 p
172 [TheEnd]
173   input  => 'text',
174   expect => <<'[TheEnd]',
175 line 2
176 line 3
177 line 4
178 line 3
179 line 4
180 4
181 line 3
182 line 4
183 line 5
184 5
185 line 5
186 line 6
187 6
188 line 6
189 line 7
190 7
191 line 7
192 line 8
193 8
194 line 8
195 [TheEnd]
196 },
197
198 ### H ###
199 'H' => {
200   script => <<'[TheEnd]',
201 #no autoprint
202 1,$H
203 $g
204 $=
205 $p
206 [TheEnd]
207   input  => 'text',
208   expect => <<'[TheEnd]',
209 8
210
211 line 1
212 line 2
213 line 3
214 line 4
215 line 5
216 line 6
217 line 7
218 line 8
219 [TheEnd]
220 },
221
222 ### N ###
223 'N' => {
224   script => <<'[TheEnd]',
225 3a\
226 added line
227 4a\
228 added line
229 5a\
230 added line
231 3,5N
232 =
233 d
234 [TheEnd]
235   input  => 'text',
236   expect => <<'[TheEnd]',
237 1
238 2
239 added line
240 4
241 added line
242 6
243 7
244 8
245 [TheEnd]
246 },
247
248 ### P ###
249 'P' => {
250   script => <<'[TheEnd]',
251 1N
252 2N
253 3N
254 4=
255 4P
256 4,$d
257 [TheEnd]
258   input  => 'text',
259   expect => <<'[TheEnd]',
260 4
261 line 1
262 [TheEnd]
263 },
264
265 ### a ###
266 'a' => {
267   script => <<'[TheEnd]',
268 1a\
269 added line 1.1\
270 added line 1.2
271
272 3a\
273 added line 3.1
274 3a\
275 added line 3.2
276
277 [TheEnd]
278   input  => 'text',
279   expect => <<'[TheEnd]',
280 line 1
281 added line 1.1
282 added line 1.2
283 line 2
284 line 3
285 added line 3.1
286 added line 3.2
287 line 4
288 line 5
289 line 6
290 line 7
291 line 8
292 [TheEnd]
293 },
294
295 ### b ###
296 'b' => {
297   script => <<'[TheEnd]',
298 #no autoprint
299 2 b eos
300 4 b eos
301 p
302 : eos
303 [TheEnd]
304   input  => 'text',
305   expect => <<'[TheEnd]',
306 line 1
307 line 3
308 line 5
309 line 6
310 line 7
311 line 8
312 [TheEnd]
313 },
314
315 ### block ###
316 'block' => {
317   script => "#no autoprint\n1,3{\n=\np\n}",
318   input  => 'text',
319   expect => <<'[TheEnd]',
320 1
321 line 1
322 2
323 line 2
324 3
325 line 3
326 [TheEnd]
327 },
328
329 ### c ###
330 'c' => {
331   script => <<'[TheEnd]',
332 2=
333
334 2,4c\
335 change 2,4 line 1\
336 change 2,4 line 2
337
338 2=
339
340 3,5c\
341 change 3,5 line 1\
342 change 3,5 line 2
343
344 3=
345
346 [TheEnd]
347   input  => 'text',
348   expect => <<'[TheEnd]',
349 line 1
350 2
351 change 2,4 line 1
352 change 2,4 line 2
353 line 5
354 line 6
355 line 7
356 line 8
357 [TheEnd]
358 },
359
360 ### c1 ###
361 'c1' => {
362   script => <<'[TheEnd]',
363 1c\
364 replaces line 1
365
366 2,3c\
367 replaces lines 2-3
368
369 /5/,/6/c\
370 replaces lines 3-4
371
372 8,10c\
373 replaces lines 6-10
374 [TheEnd]
375   input  => 'text',
376   expect => <<'[TheEnd]',
377 replaces line 1
378 replaces lines 2-3
379 line 4
380 replaces lines 3-4
381 line 7
382 [TheEnd]
383 },
384
385 ### c2 ###
386 'c2' => {
387   script => <<'[TheEnd]',
388 3!c\
389 replace all except line 3
390
391 [TheEnd]
392   input  => 'text',
393   expect => <<'[TheEnd]',
394 replace all except line 3
395 replace all except line 3
396 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
401 replace all except line 3
402 [TheEnd]
403 },
404
405 ### c3 ###
406 'c3' => {
407   script => <<'[TheEnd]',
408 1,4!c\
409 replace all except 1-4
410
411 /5/,/8/!c\
412 replace all except 5-8
413 [TheEnd]
414   input  => 'text',
415   expect => <<'[TheEnd]',
416 replace all except 5-8
417 replace all except 5-8
418 replace all except 5-8
419 replace all except 5-8
420 replace all except 1-4
421 replace all except 1-4
422 replace all except 1-4
423 replace all except 1-4
424 [TheEnd]
425 },
426
427 ### d ###
428 'd' => {
429   script => <<'[TheEnd]',
430 # d delete pattern space, start next cycle
431 2,4 d
432 5 d
433 [TheEnd]
434   input  => 'text',
435   expect => <<'[TheEnd]',
436 line 1
437 line 6
438 line 7
439 line 8
440 [TheEnd]
441 },
442
443 ### gh ###
444 'gh' => {
445   script => <<'[TheEnd]',
446 1h
447 2g
448 3h
449 4g
450 5q
451 [TheEnd]
452   input  => 'text',
453   expect => <<'[TheEnd]',
454 line 1
455 line 1
456 line 3
457 line 3
458 line 5
459 [TheEnd]
460 },
461
462 ### i ###
463 'i' => {
464   script => <<'[TheEnd]',
465 1i\
466 inserted line 1.1\
467 inserted line 1.2
468
469 3i\
470 inserted line 3.1
471 3i\
472 inserted line 3.2
473 [TheEnd]
474   input  => 'text',
475   expect => <<'[TheEnd]',
476 inserted line 1.1
477 inserted line 1.2
478 line 1
479 line 2
480 inserted line 3.1
481 inserted line 3.2
482 line 3
483 line 4
484 line 5
485 line 6
486 line 7
487 line 8
488 [TheEnd]
489 },
490
491 ### n ###
492 'n' => {
493   script => <<'[TheEnd]',
494 3a\
495 added line
496 4a\
497 added line
498 5a\
499 added line
500 3,5n
501 =
502 d
503 [TheEnd]
504   input  => 'text',
505   expect => <<'[TheEnd]',
506 1
507 2
508 line 3
509 added line
510 4
511 line 5
512 added line
513 6
514 7
515 8
516 [TheEnd]
517 },
518
519 ### o ###
520 'o' => {
521   script => <<'[TheEnd]',
522 /abc/,/def/ s//XXX/
523 // i\
524 cheers
525 [TheEnd]
526   input  => 'text',
527   expect => <<'[TheEnd]',
528 line 1
529 line 2
530 line 3
531 line 4
532 line 5
533 line 6
534 line 7
535 line 8
536 [TheEnd]
537 },
538
539 ### q ###
540 'q' => {
541   script => <<'[TheEnd]',
542 2a\
543 append to line 2
544 3a\
545 append to line 3 - should not appear in output
546 3q
547 [TheEnd]
548   input  => 'text',
549   expect => <<'[TheEnd]',
550 line 1
551 line 2
552 append to line 2
553 line 3
554 [TheEnd]
555 },
556
557 ### r ###
558 'r' => {
559   datfil => [ 'r.txt', "r.txt line 1\nr.txt line 2\nr.txt line 3\n" ],
560   script => <<'[TheEnd]',
561 2r%r.txt%
562 4r %r.txt%
563 [TheEnd]
564   input  => 'text',
565   expect => <<'[TheEnd]',
566 line 1
567 line 2
568 r.txt line 1
569 r.txt line 2
570 r.txt line 3
571 line 3
572 line 4
573 r.txt line 1
574 r.txt line 2
575 r.txt line 3
576 line 5
577 line 6
578 line 7
579 line 8
580 [TheEnd]
581 },
582
583 ### s ###
584 's' => {
585   script => <<'[TheEnd]',
586 # enclose any `(a)'.. `(c)' in `-'
587 s/([a-z])/-\1-/g
588
589 s/\([abc]\)/-\1-/g
590 [TheEnd]
591   input  => 'text',
592   expect => <<'[TheEnd]',
593 line 1
594 line 2
595 line 3
596 line 4
597 line 5
598 line 6
599 line 7
600 line 8
601 [TheEnd]
602 },
603
604 ### s1 ###
605 's1' => {
606   script => <<'[TheEnd]',
607 s/\w/@1/
608 s/\y/@2/
609
610 s/\n/@3/
611
612 # this is literal { }
613 s/a{3}/@4/
614
615 # proper repetition
616 s/a\{3\}/a rep 3/
617 [TheEnd]
618   input  => 'text',
619   expect => <<'[TheEnd]',
620 @1ine 1
621 @1ine 2
622 @1ine 3
623 @1ine 4
624 @1ine 5
625 @1ine 6
626 @1ine 7
627 @1ine 8
628 [TheEnd]
629 },
630
631 ### t ###
632 't' => {
633   script => join( "\n",
634    '#no autoprint', 's/./X/p', 's/foo/bar/p', 't bye', '=', 'p', ':bye' ),
635   input  => 'text',
636   expect => <<'[TheEnd]',
637 Xine 1
638 Xine 2
639 Xine 3
640 Xine 4
641 Xine 5
642 Xine 6
643 Xine 7
644 Xine 8
645 [TheEnd]
646 },
647
648 ### w ###
649 'w' => {
650   datfil => [ 'w.txt', '' ],
651   script => <<'[TheEnd]',
652 w %w.txt%
653 [TheEnd]
654   input  => 'text',
655   expect => <<'[TheEnd]',
656 line 1
657 line 2
658 line 3
659 line 4
660 line 5
661 line 6
662 line 7
663 line 8
664 [TheEnd]
665 },
666
667 ### x ###
668 'x' => {
669   script => <<'[TheEnd]',
670 1h
671 1d
672 2x
673 2,$G
674 [TheEnd]
675   input  => 'text',
676   expect => <<'[TheEnd]',
677 line 1
678 line 2
679 line 3
680 line 2
681 line 4
682 line 2
683 line 5
684 line 2
685 line 6
686 line 2
687 line 7
688 line 2
689 line 8
690 line 2
691 [TheEnd]
692 },
693
694 ### y ###
695 'y' => {
696   script => <<'[TheEnd]',
697 y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
698 y/|/\
699
700 [TheEnd]
701   input  => 'text',
702   expect => <<'[TheEnd]',
703 LINE 1
704 LINE 2
705 LINE 3
706 LINE 4
707 LINE 5
708 LINE 6
709 LINE 7
710 LINE 8
711 [TheEnd]
712 },
713
714 ### cnt ###
715 'cnt' => {
716   script => <<'[TheEnd]',
717 #no autoprint
718
719 # delete line, append NL to hold space
720 s/.*//
721 H
722 $!b
723
724 # last line only: get hold
725 g
726 s/./X/g
727 t count
728 : count
729 s/^X/1/
730 s/0X/1/
731 s/1X/2/
732 s/2X/3/
733 s/3X/4/
734 s/4X/5/
735 s/5X/6/
736 s/6X/7/
737 s/7X/8/
738 s/8X/9/
739 s/9X/X0/
740 t count
741 p
742 [TheEnd]
743   input  => 'text',
744   expect => <<'[TheEnd]',
745 8
746 [TheEnd]
747 },
748
749 ### adr1 ###
750 'adr1' => {
751   script => <<'[TheEnd]',
752 #no autoprint
753 # This script should be run on itself
754 /^#__DATA__$/,${
755    /^#A$/p
756    s/^# *[0-9]* *//
757    /^#\*$/p
758    /^#\.$/p
759    /^#\(..\)\(..\)\2\1*$/p
760    /^#[abc]\{1,\}[def]\{1,\}$/p
761 }
762 #__DATA__
763 #A
764 #*
765 #.
766 #abxyxy
767 #abxyxyab
768 #abxyxyabab
769 #ad
770 #abcdef
771 [TheEnd]
772   input  => 'adr1',
773   expect => <<'[TheEnd]',
774 #A
775 [TheEnd]
776 },
777
778 );
779
780 my @aux = ();
781 my $ntc = 2 * keys %testcase;
782 plan( $ntc );
783
784 # temporary file names
785 my $script = "s2pt$$.sed";
786 my $stdin  = "s2pt$$.in";
787 my $plsed  = "s2pt$$.pl";
788
789 # various command lines for 
790 my $s2p  = File::Spec->catfile( File::Spec->updir(), 'x2p', 's2p' );
791 my $psed = File::Spec->catfile( File::Spec->curdir(), 'psed' );
792 if ($^O eq 'VMS') {
793   # default in the .com extenson if it's not already there
794   $s2p = VMS::Filespec::rmsexpand($s2p, '.com');
795   $psed = VMS::Filespec::rmsexpand($psed, '.com');
796 }
797 my $sedcmd = [ $psed, '-f', $script, $stdin ];
798 my $s2pcmd = [ $s2p,  '-f', $script ];
799 my $plcmd  = [ $plsed, $stdin ];
800
801 my $switches = '';
802 $switches = ['-x'] if $^O eq 'MacOS';
803
804 # psed: we create a local copy as linking may not work on some systems.
805 copy( $s2p, $psed );
806 push( @aux, $psed );
807
808 # process all testcases
809 #
810 my $indat = '';
811 for my $tc ( sort keys %testcase ){
812     my( $psedres, $s2pres );
813
814     # 1st test: run psed
815     # prepare the script 
816     open( SED, ">$script" ) || goto FAIL_BOTH;
817     my $script = $testcase{$tc}{script};
818
819     # additional files for r, w: patch script, inserting temporary names
820     if( exists( $testcase{$tc}{datfil} ) ){
821         my( $datnam, $datdat ) = @{$testcase{$tc}{datfil}};
822         my $datfil = "s2pt$$" . $datnam;
823         push( @aux, $datfil );
824         open( DAT, ">$datfil" ) || goto FAIL_BOTH;
825         print DAT $datdat;
826         close( DAT );
827         $script =~ s/\%$datnam\%/$datfil/eg;
828     }
829     print SED $script;
830     close( SED ) || goto FAIL_BOTH;
831
832     # prepare input
833     #
834     if( $indat ne $testcase{$tc}{input} ){
835         $indat = $testcase{$tc}{input};
836         open( IN, ">$stdin" ) || goto FAIL_BOTH;
837         print IN $input{$indat};
838         close( IN ) || goto FAIL_BOTH;
839     }
840
841     # on VMS, runperl eats blank lines to work around 
842     # spurious newlines in pipes
843     $testcase{$tc}{expect} =~ s/\n\n/\n/ if $^O eq 'VMS';
844
845     # run and compare
846     #
847     $psedres = runperl( args => $sedcmd, switches => $switches );
848     is( $psedres, $testcase{$tc}{expect}, "psed $tc" );
849
850     # 2nd test: run s2p
851     # translate the sed script to a Perl program
852
853     my $perlprog = runperl( args => $s2pcmd, switches => $switches );
854     open( PP, ">$plsed" ) || goto FAIL_S2P;
855     print PP $perlprog;
856     close( PP ) || goto FAIL_S2P;
857
858     # execute generated Perl program, compare
859     $s2pres = runperl( args => $plcmd, switches => $switches );
860     is( $s2pres, $testcase{$tc}{expect}, "s2p $tc" );
861     next;
862
863 FAIL_BOTH:
864     fail( "psed $tc" );
865 FAIL_S2P:
866     fail( "s2p $tc" );
867 }
868
869 END {
870     for my $f ( $script, $stdin, $plsed, @aux ){
871         1 while unlink( $f ); # hats off to VMS...
872     }
873 }