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