]> git.donarmstrong.com Git - perltidy.git/blob - t/snippets3.t
New upstream version 20210717
[perltidy.git] / t / snippets3.t
1 # Created with: ./make_t.pl
2
3 # Contents:
4 #1 ce_wn1.ce_wn
5 #2 ce_wn1.def
6 #3 colin.colin
7 #4 colin.def
8 #5 essential.def
9 #6 essential.essential1
10 #7 essential.essential2
11 #8 extrude1.def
12 #9 extrude1.extrude
13 #10 extrude2.def
14 #11 extrude2.extrude
15 #12 extrude3.def
16 #13 extrude3.extrude
17 #14 extrude4.def
18 #15 extrude4.extrude
19 #16 fabrice_bug.def
20 #17 fabrice_bug.fabrice_bug
21 #18 format1.def
22 #19 given1.def
23 #20 gnu1.def
24
25 # To locate test #13 you can search for its name or the string '#13'
26
27 use strict;
28 use Test::More;
29 use Carp;
30 use Perl::Tidy;
31 my $rparams;
32 my $rsources;
33 my $rtests;
34
35 BEGIN {
36
37     ###########################################
38     # BEGIN SECTION 1: Parameter combinations #
39     ###########################################
40     $rparams = {
41         'ce_wn' => <<'----------',
42 -cuddled-blocks
43 -wn
44 ----------
45         'colin' => <<'----------',
46 -l=0
47 -pt=2
48 -nsfs
49 -sbt=2
50 -ohbr
51 -opr
52 -osbr
53 -pvt=2
54 -schb
55 -scp
56 -scsb
57 -sohb
58 -sop
59 -sosb
60 ----------
61         'def'        => "",
62         'essential1' => <<'----------',
63 -syn
64 -i=0
65 -l=100000
66 -nasc
67 -naws
68 -dws
69 -nanl
70 -blbp=0
71 -blbs=0
72 -nbbb
73 -kbl=0
74 -mbl=0
75 ----------
76         'essential2'  => "-extrude",
77         'extrude'     => "--extrude",
78         'fabrice_bug' => "-bt=0",
79     };
80
81     ############################
82     # BEGIN SECTION 2: Sources #
83     ############################
84     $rsources = {
85
86         'ce_wn1' => <<'----------',
87 if ($BOLD_MATH) {
88     (
89         $labels, $comment,
90         join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
91       )
92 }
93 else {
94     (
95         &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
96         $after
97       )
98 }
99 ----------
100
101         'colin' => <<'----------',
102 env(0, 15, 0, 10, {
103     Xtitle => 'X-data',
104     Ytitle => 'Y-data',
105     Title  => 'An example of errb and points',
106     Font   => 'Italic'
107 });
108 ----------
109
110         'essential' => <<'----------',
111 # Run with mangle to squeeze out the white space
112 # also run with extrude
113
114 # never combine two bare words or numbers
115 status and ::ok(1);
116
117 return ::spw(...);
118
119 for bla::bla:: abc;
120
121 # do not combine 'overload::' and 'and'
122 if $self->{bareStringify} and ref $_
123 and defined %overload:: and defined &{'overload::StrVal'};
124
125 # do not combine 'SINK' and 'if'
126 my $size=-s::SINK if $file;
127
128 # do not combine to make $inputeq"quit"
129 if ($input eq"quit"); 
130
131 # do not combine a number with a concatenation dot to get a float '78.'
132 $vt100_compatible ? "\e[0;0H" : ('-' x 78 . "\n");
133
134 # do not join a minus with a bare word, because you might form
135 # a file test operator.  Here  "z-i" would be taken as a file test.
136 if (CORE::abs($z - i) < $eps); 
137
138 # '= -' should not become =- or you will get a warning
139
140 # and something like these could become ambiguous without space
141 # after the '-':
142 use constant III=>1;
143 $a = $b - III;
144 $a = - III;
145
146 # keep a space between a token ending in '$' and any word;
147 die @$ if $@;
148
149 # avoid combining tokens to create new meanings. Example:
150 # this must not become $a++$b
151 $a+ +$b;
152
153 # another example: do not combine these two &'s:
154 allow_options & &OPT_EXECCGI;
155
156 # Perl is sensitive to whitespace after the + here:
157 $b = xvals $a + 0.1 * yvals $a;
158
159 # keep paren separate here:
160 use Foo::Bar ();
161
162 # need space after foreach my; for example, this will fail in
163 # older versions of Perl:
164 foreach my$ft(@filetypes)...
165
166 # must retain space between grep and left paren; "grep(" may fail
167 my $match = grep (m/^-extrude$/, @list) ? 1 : 0;
168
169 # don't stick numbers next to left parens, as in:
170 use Mail::Internet 1.28 ();
171
172 # do not remove space between an '&' and a bare word because
173 # it may turn into a function evaluation, like here
174 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
175 $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
176 ----------
177
178         'extrude1' => <<'----------',
179 # do not break before the ++
180 print $x++ . "\n";
181 ----------
182
183         'extrude2' => <<'----------',
184     if (-l pid_filename()) {
185         return readlink(pid_filename());
186     }
187 ----------
188
189         'extrude3' => <<'----------',
190 # Breaking before a ++ can cause perl to guess wrong
191 print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
192
193 # Space between '&' and 'O_ACCMODE' is essential here
194 $opts{rdonly} = (($opts{mode} & O_ACCMODE) == O_RDONLY);
195 ----------
196
197         'extrude4' => <<'----------',
198 # From Safe.pm caused trouble with extrude
199 use Opcode 1.01, qw(
200   opset opset_to_ops opmask_add
201   empty_opset full_opset invert_opset verify_opset
202   opdesc opcodes opmask define_optag opset_to_hex
203 );
204 ----------
205
206         'fabrice_bug' => <<'----------',
207 # no space around ^variable with -bt=0
208 my $before = ${^PREMATCH};
209 my $after  = ${PREMATCH};
210 ----------
211
212         'format1' => <<'----------',
213     if (/^--list$/o) {
214         format =
215 @<<<<<<<<<<<<<<<<<<<<<<<<       @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
216 $_, $val
217 .
218           print "Available strips:\n";
219         for ( split ( /\|/, $known_strips ) ) {
220             $val = $defs{$_}{'name'};
221             write;
222         }
223     }
224 ----------
225
226         'given1' => <<'----------',
227         given ([9,"a",11]) {
228                 when (qr/\d/)  {
229                                 given ($count) {
230                                         when (1)      { ok($count==1) }
231                                                 else { ok($count!=1) }
232                                         when ([5,6])  { ok(0) } else { ok(1) }
233                                 }
234                             }
235                 ok(1) when 11;
236         }
237 ----------
238
239         'gnu1' => <<'----------',
240 @common_sometimes = (
241     "aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
242     "stamp-h.in", 'stamp-vti'
243 );
244 ----------
245     };
246
247     ####################################
248     # BEGIN SECTION 3: Expected output #
249     ####################################
250     $rtests = {
251
252         'ce_wn1.ce_wn' => {
253             source => "ce_wn1",
254             params => "ce_wn",
255             expect => <<'#1...........',
256 if ($BOLD_MATH) { (
257     $labels, $comment,
258     join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
259 ) } else { (
260     &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
261     $after
262 ) }
263 #1...........
264         },
265
266         'ce_wn1.def' => {
267             source => "ce_wn1",
268             params => "def",
269             expect => <<'#2...........',
270 if ($BOLD_MATH) {
271     (
272         $labels, $comment,
273         join( '', ' < B > ', &make_math( $mode, '', '', $_ ), ' < /B>' )
274     )
275 }
276 else {
277     (
278         &process_math_in_latex( $mode, $math_style, $slevel, "\\mbox{$text}" ),
279         $after
280     )
281 }
282 #2...........
283         },
284
285         'colin.colin' => {
286             source => "colin",
287             params => "colin",
288             expect => <<'#3...........',
289 env(0, 15, 0, 10, {
290     Xtitle => 'X-data',
291     Ytitle => 'Y-data',
292     Title  => 'An example of errb and points',
293     Font   => 'Italic'
294 });
295 #3...........
296         },
297
298         'colin.def' => {
299             source => "colin",
300             params => "def",
301             expect => <<'#4...........',
302 env(
303     0, 15, 0, 10,
304     {
305         Xtitle => 'X-data',
306         Ytitle => 'Y-data',
307         Title  => 'An example of errb and points',
308         Font   => 'Italic'
309     }
310 );
311 #4...........
312         },
313
314         'essential.def' => {
315             source => "essential",
316             params => "def",
317             expect => <<'#5...........',
318 # Run with mangle to squeeze out the white space
319 # also run with extrude
320
321 # never combine two bare words or numbers
322 status and ::ok(1);
323
324 return ::spw(...);
325
326 for bla::bla:: abc;
327
328 # do not combine 'overload::' and 'and'
329 if $self->{bareStringify}
330   and ref $_
331   and defined %overload::
332   and defined &{'overload::StrVal'};
333
334 # do not combine 'SINK' and 'if'
335 my $size = -s ::SINK if $file;
336
337 # do not combine to make $inputeq"quit"
338 if ( $input eq "quit" );
339
340 # do not combine a number with a concatenation dot to get a float '78.'
341 $vt100_compatible ? "\e[0;0H" : ( '-' x 78 . "\n" );
342
343 # do not join a minus with a bare word, because you might form
344 # a file test operator.  Here  "z-i" would be taken as a file test.
345 if ( CORE::abs( $z - i ) < $eps );
346
347 # '= -' should not become =- or you will get a warning
348
349 # and something like these could become ambiguous without space
350 # after the '-':
351 use constant III => 1;
352 $a = $b - III;
353 $a = - III;
354
355 # keep a space between a token ending in '$' and any word;
356 die @$ if $@;
357
358 # avoid combining tokens to create new meanings. Example:
359 # this must not become $a++$b
360 $a + +$b;
361
362 # another example: do not combine these two &'s:
363 allow_options & &OPT_EXECCGI;
364
365 # Perl is sensitive to whitespace after the + here:
366 $b = xvals $a + 0.1 * yvals $a;
367
368 # keep paren separate here:
369 use Foo::Bar ();
370
371 # need space after foreach my; for example, this will fail in
372 # older versions of Perl:
373 foreach my $ft (@filetypes) ...
374
375   # must retain space between grep and left paren; "grep(" may fail
376   my $match = grep ( m/^-extrude$/, @list ) ? 1 : 0;
377
378 # don't stick numbers next to left parens, as in:
379 use Mail::Internet 1.28 ();
380
381 # do not remove space between an '&' and a bare word because
382 # it may turn into a function evaluation, like here
383 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
384 $opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
385 #5...........
386         },
387
388         'essential.essential1' => {
389             source => "essential",
390             params => "essential1",
391             expect => <<'#6...........',
392 # Run with mangle to squeeze out the white space
393 # also run with extrude
394 # never combine two bare words or numbers
395 status and ::ok(1);
396 return ::spw(...);
397 for bla::bla:: abc;
398 # do not combine 'overload::' and 'and'
399 if$self->{bareStringify}and ref$_ and defined%overload:: and defined&{'overload::StrVal'};
400 # do not combine 'SINK' and 'if'
401 my$size=-s::SINK if$file;
402 # do not combine to make $inputeq"quit"
403 if($input eq"quit");
404 # do not combine a number with a concatenation dot to get a float '78.'
405 $vt100_compatible?"\e[0;0H":('-' x 78 ."\n");
406 # do not join a minus with a bare word, because you might form
407 # a file test operator.  Here  "z-i" would be taken as a file test.
408 if(CORE::abs($z- i)<$eps);
409 # '= -' should not become =- or you will get a warning
410 # and something like these could become ambiguous without space
411 # after the '-':
412 use constant III=>1;
413 $a=$b- III;
414 $a=- III;
415 # keep a space between a token ending in '$' and any word;
416 die@$ if$@;
417 # avoid combining tokens to create new meanings. Example:
418 # this must not become $a++$b
419 $a+ +$b;
420 # another example: do not combine these two &'s:
421 allow_options& &OPT_EXECCGI;
422 # Perl is sensitive to whitespace after the + here:
423 $b=xvals$a + 0.1*yvals$a;
424 # keep paren separate here:
425 use Foo::Bar ();
426 # need space after foreach my; for example, this will fail in
427 # older versions of Perl:
428 foreach my$ft(@filetypes)...
429   # must retain space between grep and left paren; "grep(" may fail
430   my$match=grep (m/^-extrude$/,@list)?1:0;
431 # don't stick numbers next to left parens, as in:
432 use Mail::Internet 1.28 ();
433 # do not remove space between an '&' and a bare word because
434 # it may turn into a function evaluation, like here
435 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
436 $opts{rdonly}=(($opts{mode}& O_ACCMODE)==O_RDONLY);
437 #6...........
438         },
439
440         'essential.essential2' => {
441             source => "essential",
442             params => "essential2",
443             expect => <<'#7...........',
444 # Run with mangle to squeeze out the white space
445 # also run with extrude
446 # never combine two bare words or numbers
447 status
448 and
449 ::ok(
450 1
451 )
452 ;
453 return
454 ::spw(
455 ...
456 )
457 ;
458 for
459 bla::bla::
460 abc
461 ;
462 # do not combine 'overload::' and 'and'
463 if
464 $self
465 ->
466 {bareStringify}
467 and
468 ref
469 $_
470 and
471 defined
472 %overload::
473 and
474 defined
475 &{
476 'overload::StrVal'
477 }
478 ;
479 # do not combine 'SINK' and 'if'
480 my$size
481 =
482 -s::SINK
483 if
484 $file
485 ;
486 # do not combine to make $inputeq"quit"
487 if
488 (
489 $input
490 eq
491 "quit"
492 )
493 ;
494 # do not combine a number with a concatenation dot to get a float '78.'
495 $vt100_compatible?
496 "\e[0;0H"
497 :
498 (
499 '-'
500 x
501 78
502 .
503 "\n"
504 )
505 ;
506 # do not join a minus with a bare word, because you might form
507 # a file test operator.  Here  "z-i" would be taken as a file test.
508 if
509 (
510 CORE::abs
511 (
512 $z
513 -
514 i
515 )
516 <
517 $eps
518 )
519 ;
520 # '= -' should not become =- or you will get a warning
521 # and something like these could become ambiguous without space
522 # after the '-':
523 use
524 constant
525 III=>
526 1
527 ;
528 $a
529 =
530 $b
531 -
532 III
533 ;
534 $a
535 =
536 -
537 III
538 ;
539 # keep a space between a token ending in '$' and any word;
540 die
541 @$
542 if
543 $@
544 ;
545 # avoid combining tokens to create new meanings. Example:
546 # this must not become $a++$b
547 $a
548 +
549 +
550 $b
551 ;
552 # another example: do not combine these two &'s:
553 allow_options
554 &
555 &OPT_EXECCGI
556 ;
557 # Perl is sensitive to whitespace after the + here:
558 $b
559 =
560 xvals$a
561 +
562 0.1
563 *
564 yvals$a;
565 # keep paren separate here:
566 use
567 Foo::Bar (
568 )
569 ;
570 # need space after foreach my; for example, this will fail in
571 # older versions of Perl:
572 foreach
573 my$ft
574 (
575 @filetypes
576 )
577 ...
578 # must retain space between grep and left paren; "grep(" may fail
579 my$match
580 =
581 grep
582 (
583 m/^-extrude$/
584 ,
585 @list
586 )
587 ?
588 1
589 :
590 0
591 ;
592 # don't stick numbers next to left parens, as in:
593 use
594 Mail::Internet
595 1.28
596 (
597 )
598 ;
599 # do not remove space between an '&' and a bare word because
600 # it may turn into a function evaluation, like here
601 # between '&' and 'O_ACCMODE', producing a syntax error [File.pm]
602 $opts{rdonly}
603 =
604 (
605 (
606 $opts{mode}
607 &
608 O_ACCMODE
609 )
610 ==
611 O_RDONLY
612 )
613 ;
614 #7...........
615         },
616
617         'extrude1.def' => {
618             source => "extrude1",
619             params => "def",
620             expect => <<'#8...........',
621 # do not break before the ++
622 print $x++ . "\n";
623 #8...........
624         },
625
626         'extrude1.extrude' => {
627             source => "extrude1",
628             params => "extrude",
629             expect => <<'#9...........',
630 # do not break before the ++
631 print$x++
632 .
633 "\n"
634 ;
635 #9...........
636         },
637
638         'extrude2.def' => {
639             source => "extrude2",
640             params => "def",
641             expect => <<'#10...........',
642     if ( -l pid_filename() ) {
643         return readlink( pid_filename() );
644     }
645 #10...........
646         },
647
648         'extrude2.extrude' => {
649             source => "extrude2",
650             params => "extrude",
651             expect => <<'#11...........',
652 if
653 (
654 -l pid_filename(
655 )
656 )
657 {
658 return
659 readlink
660 (
661 pid_filename(
662 )
663 )
664 ;
665 }
666 #11...........
667         },
668
669         'extrude3.def' => {
670             source => "extrude3",
671             params => "def",
672             expect => <<'#12...........',
673 # Breaking before a ++ can cause perl to guess wrong
674 print( ( $i++ & 1 ) ? $_ : ( $change{$_} || $_ ) );
675
676 # Space between '&' and 'O_ACCMODE' is essential here
677 $opts{rdonly} = ( ( $opts{mode} & O_ACCMODE ) == O_RDONLY );
678 #12...........
679         },
680
681         'extrude3.extrude' => {
682             source => "extrude3",
683             params => "extrude",
684             expect => <<'#13...........',
685 # Breaking before a ++ can cause perl to guess wrong
686 print
687 (
688 (
689 $i++
690 &
691 1
692 )
693 ?
694 $_
695 :
696 (
697 $change{
698 $_
699 }
700 ||
701 $_
702 )
703 )
704 ;
705 # Space between '&' and 'O_ACCMODE' is essential here
706 $opts{rdonly}
707 =
708 (
709 (
710 $opts{mode}
711 &
712 O_ACCMODE
713 )
714 ==
715 O_RDONLY
716 )
717 ;
718 #13...........
719         },
720
721         'extrude4.def' => {
722             source => "extrude4",
723             params => "def",
724             expect => <<'#14...........',
725 # From Safe.pm caused trouble with extrude
726 use Opcode 1.01, qw(
727   opset opset_to_ops opmask_add
728   empty_opset full_opset invert_opset verify_opset
729   opdesc opcodes opmask define_optag opset_to_hex
730 );
731 #14...........
732         },
733
734         'extrude4.extrude' => {
735             source => "extrude4",
736             params => "extrude",
737             expect => <<'#15...........',
738 # From Safe.pm caused trouble with extrude
739 use
740 Opcode
741 1.01
742 ,
743 qw(
744 opset opset_to_ops opmask_add
745 empty_opset full_opset invert_opset verify_opset
746 opdesc opcodes opmask define_optag opset_to_hex
747 )
748 ;
749 #15...........
750         },
751
752         'fabrice_bug.def' => {
753             source => "fabrice_bug",
754             params => "def",
755             expect => <<'#16...........',
756 # no space around ^variable with -bt=0
757 my $before = ${^PREMATCH};
758 my $after  = ${PREMATCH};
759 #16...........
760         },
761
762         'fabrice_bug.fabrice_bug' => {
763             source => "fabrice_bug",
764             params => "fabrice_bug",
765             expect => <<'#17...........',
766 # no space around ^variable with -bt=0
767 my $before = ${^PREMATCH};
768 my $after  = ${ PREMATCH };
769 #17...........
770         },
771
772         'format1.def' => {
773             source => "format1",
774             params => "def",
775             expect => <<'#18...........',
776     if (/^--list$/o) {
777         format =
778 @<<<<<<<<<<<<<<<<<<<<<<<<       @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
779 $_, $val
780 .
781         print "Available strips:\n";
782         for ( split( /\|/, $known_strips ) ) {
783             $val = $defs{$_}{'name'};
784             write;
785         }
786     }
787 #18...........
788         },
789
790         'given1.def' => {
791             source => "given1",
792             params => "def",
793             expect => <<'#19...........',
794         given ( [ 9, "a", 11 ] ) {
795             when (qr/\d/) {
796                 given ($count) {
797                     when (1)          { ok( $count == 1 ) }
798                     else              { ok( $count != 1 ) }
799                     when ( [ 5, 6 ] ) { ok(0) }
800                     else              { ok(1) }
801                 }
802             }
803             ok(1) when 11;
804         }
805 #19...........
806         },
807
808         'gnu1.def' => {
809             source => "gnu1",
810             params => "def",
811             expect => <<'#20...........',
812 @common_sometimes = (
813     "aclocal.m4", "acconfig.h", "config.h.top", "config.h.bot",
814     "stamp-h.in", 'stamp-vti'
815 );
816 #20...........
817         },
818     };
819
820     my $ntests = 0 + keys %{$rtests};
821     plan tests => $ntests;
822 }
823
824 ###############
825 # EXECUTE TESTS
826 ###############
827
828 foreach my $key ( sort keys %{$rtests} ) {
829     my $output;
830     my $sname  = $rtests->{$key}->{source};
831     my $expect = $rtests->{$key}->{expect};
832     my $pname  = $rtests->{$key}->{params};
833     my $source = $rsources->{$sname};
834     my $params = defined($pname) ? $rparams->{$pname} : "";
835     my $stderr_string;
836     my $errorfile_string;
837     my $err = Perl::Tidy::perltidy(
838         source      => \$source,
839         destination => \$output,
840         perltidyrc  => \$params,
841         argv        => '',             # for safety; hide any ARGV from perltidy
842         stderr      => \$stderr_string,
843         errorfile   => \$errorfile_string,    # not used when -se flag is set
844     );
845     if ( $err || $stderr_string || $errorfile_string ) {
846         print STDERR "Error output received for test '$key'\n";
847         if ($err) {
848             print STDERR "An error flag '$err' was returned\n";
849             ok( !$err );
850         }
851         if ($stderr_string) {
852             print STDERR "---------------------\n";
853             print STDERR "<<STDERR>>\n$stderr_string\n";
854             print STDERR "---------------------\n";
855             ok( !$stderr_string );
856         }
857         if ($errorfile_string) {
858             print STDERR "---------------------\n";
859             print STDERR "<<.ERR file>>\n$errorfile_string\n";
860             print STDERR "---------------------\n";
861             ok( !$errorfile_string );
862         }
863     }
864     else {
865         if ( !is( $output, $expect, $key ) ) {
866             my $leno = length($output);
867             my $lene = length($expect);
868             if ( $leno == $lene ) {
869                 print STDERR
870 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
871             }
872             else {
873                 print STDERR
874 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
875             }
876         }
877     }
878 }