1 # Created with: ./make_t.pl
13 #10 long_line.long_line
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
41 'comments1' => <<'----------',
42 # testing --fixed-position-side-comment=40,
43 # --ignore-side-comment-lengths,
44 # --noindent-block-comments,
45 # --nohanging-side-comments
46 # --static-side-comments
48 -fpsc=40 -iscl -nibc -nhsc -ssc -trp
50 'comments2' => <<'----------',
51 # testing --minimum-space-to-comment=10, --delete-block-comments, --delete-pod
54 'comments3' => <<'----------',
55 # testing --maximum-consecutive-blank-lines=2 and --indent-spaced-block-comments --no-format-skipping
58 'comments4' => <<'----------',
59 # testing --keep-old-blank-lines=2 [=all] and
60 # --nooutdent-long-comments and
61 # --outdent-static-block-comments
62 # --format-skipping-begin and --format-skipping-end
63 -kbl=2 -nolc -osbc -fsb='#<{2,}' -fse='#>{2,}'
66 'long_line' => "-l=0",
67 'pbp' => "-pbp -nst -nse",
69 "-pbp -nst --ignore-side-comment-lengths --converge -l=0 -q",
73 ############################
74 # BEGIN SECTION 2: Sources #
75 ############################
78 'align32' => <<'----------',
79 # align just the last two lines
80 my $c_sub_khwnd = WindowFromId $k_hwnd, 0x8008; # FID_CLIENT
81 ok $c_sub_khwnd, 'have kids client window';
82 ok IsWindow($c_sub_khwnd), 'IsWindow works on the client';
85 mkTextConfig $c, $x, $y, -anchor => 'se', $color;
86 mkTextConfig $c, $x + 30, $y, -anchor => 's', $color;
87 mkTextConfig $c, $x + 60, $y, -anchor => 'sw', $color;
88 mkTextConfig $c, $x, $y + 30, -anchor => 'e', $color;
90 permute_test [ 'a', 'b', 'c' ], '/', '/', [ 'a', 'b', 'c' ];
91 permute_test [ 'a,', 'b', 'c,' ], '/', '/', [ 'a,', 'b', 'c,' ];
92 permute_test [ 'a', ',', '#', 'c' ], '/', '/', [ 'a', ',', '#', 'c' ];
93 permute_test [ 'f_oo', 'b_ar' ], '/', '/', [ 'f_oo', 'b_ar' ];
95 # issue c093 - broken sub, but align fat commas
96 use constant UNDEF_ONLY => sub { not defined $_[0] };
97 use constant EMPTY_OR_UNDEF => sub {
98 !@_ or @_ == 1 && !defined $_[0];
102 'bos' => <<'----------',
103 $top_label->set_text( gettext("check permissions.") )
107 'comments' => <<'----------',
109 # an initial hash bang line cannot be deleted with -dp
110 #<<< format skipping of first code can cause an error message in perltidy v20210625
111 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
113 sub length { return length($_[0]) } # side comment
114 # hanging side comment
115 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
117 # a blank will be inserted to prevent forming a hanging side comment
118 sub macro_get_names { #
120 # %name = macro_get_names(); (key=macrohandle, value=macroname)
122 ##local(%name); # a static block comment without indentation
123 local(%name)=(); ## a static side comment to test -ssc
125 # a spaced block comment to test -isbc
127 # a very long comment for testing the parameter --nooutdent-long-comments (or -nolc)
128 $name{$_} = $mac_ext[$idx{$mac_exti[$_]}];
129 $vmsfile =~ s/;[\d\-]*$//; # very long side comment; Clip off version number; we can use a newer version as well
138 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
139 ## 'Dec', 'Nov' [a static block comment with indentation]
143 { # this side comment will not align
144 my $IGNORE = 0; # This is a side comment
145 # This is a hanging side comment
148 # A blank line interrupts the hsc's; this is a block comment
152 # side comments at different indentation levels should not normally be aligned
153 { { { { { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } } #end level 4
159 #<<< do not let perltidy touch this unless -nfs is set
167 #<< test alternate format skipping string
177 # some blank lines follow
182 Some pod before __END__ to delete with -dp
189 # text following __END__, not a comment
193 Some pod after __END__ to delete with -dp and trim with -trp
199 'long_line' => <<'----------',
200 # This single line should break into multiple lines, even with -l=0
201 # sub 'tight_paren_follows' should break the do block
202 $body = SOAP::Data->name('~V:Fault')->attr( { 'xmlns' => $SOAP::Constants::NS_ENV } )->value( \SOAP::Data->set_value( SOAP::Data->name( faultcode => qualify( $self->namespace => shift(@parameters) ) ), SOAP::Data->name( faultstring => shift(@parameters) ), @parameters ? SOAP::Data->name( detail => do { my $detail = shift(@parameters); ref $detail ? \$detail : $detail } ) : (), @parameters ? SOAP::Data->name( faultactor => shift(@parameters) ) : (), ) );
205 'pbp6' => <<'----------',
206 # These formerly blinked with -pbp
207 return $width1*$common_length*(
210 - $RTHSQPWSQ*atan2(1,$RTHSQPWSQ)
212 ($WSQP1*$HSQP1)/(1+$WSQ+$HSQ)
213 *($WSQ*(1+$WSQ+$HSQ)/($WSQP1*$HSQPWSQ))**$WSQ
214 *($HSQ*(1+$WSQ+$HSQ)/($HSQP1*$HSQPWSQ))**$HSQ
218 my $oldSec = ( 60 * $session->{originalStartHour} + $session->{originalStartMin} ) * 60;
222 'rperl' => <<'----------',
223 # Some test cases for RPerl, https://github.com/wbraswell/rperl/
224 # These must not remain as single lines with default formatting and long lines
225 sub multiply_return_F { { my number $RETURN_TYPE }; ( my integer $multiplicand, my number $multiplier ) = @ARG; return $multiplicand * $multiplier; }
227 sub empty_method { { my void::method $RETURN_TYPE }; return 2; }
229 sub foo_subroutine_in_main { { my void $RETURN_TYPE }; print 'Howdy from foo_subroutine_in_main()...', "\n"; return; }
232 'rt132059' => <<'----------',
233 # Test deleting comments and pod
235 sub f { # a side comment
236 # a hanging side comment
248 'signature' => <<'----------',
249 # git22: Preserve function signature on a single line
250 # This behavior is controlled by 'sub weld_signature_parens'
252 sub foo($x, $y="abcd") {
256 # do not break after closing do brace
257 sub foo($x, $y=do{{}}, $z=42, $w=do{"abcd"}) {
261 # This signature should get put back on one line
263 $p = do { $z += 10; 222 }, $a = do { $z++; 333 }
266 # anonymous sub with signature
267 my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) {
271 # signature and prototype and attribute
272 sub foo1 ( $x, $y ) : prototype ( $$ ) : shared { }
274 sub foo11 ( $thing, % ) { print $thing }
276 sub animal4 ( $cat, $ = ) { } # second argument is optional
294 "first=$first, third=$third"
299 sub fnord (&\%) : switch(10,foo(7,3)) : expensive;
300 sub plugh () : Ugly('\(") : Bad;
303 'ternary4' => <<'----------',
305 *{"${callpkg}::$sym"} =
306 $type eq '&' ? \&{"${pkg}::$sym"} #
307 : $type eq '$' ? \${"${pkg}::$sym"} #
308 : $type eq '@' ? \@{"${pkg}::$sym"}
309 : $type eq '%' ? \%{"${pkg}::$sym"} # side comment
310 : $type eq '*' ? *{"${pkg}::$sym"} #
311 : do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
314 'wn7' => <<'----------',
315 # do not weld paren to opening one-line non-paren container
316 $Self->_Add($SortOrderDisplay{$Field->GenerateFieldForSelectSQL()});
318 # this will not get welded with -wn
320 do { 1; !!(my $x = bless []); }
325 ####################################
326 # BEGIN SECTION 3: Expected output #
327 ####################################
333 expect => <<'#1...........',
334 # align just the last two lines
335 my $c_sub_khwnd = WindowFromId $k_hwnd, 0x8008; # FID_CLIENT
336 ok $c_sub_khwnd, 'have kids client window';
337 ok IsWindow($c_sub_khwnd), 'IsWindow works on the client';
340 mkTextConfig $c, $x, $y, -anchor => 'se', $color;
341 mkTextConfig $c, $x + 30, $y, -anchor => 's', $color;
342 mkTextConfig $c, $x + 60, $y, -anchor => 'sw', $color;
343 mkTextConfig $c, $x, $y + 30, -anchor => 'e', $color;
345 permute_test [ 'a', 'b', 'c' ], '/', '/', [ 'a', 'b', 'c' ];
346 permute_test [ 'a,', 'b', 'c,' ], '/', '/', [ 'a,', 'b', 'c,' ];
347 permute_test [ 'a', ',', '#', 'c' ], '/', '/', [ 'a', ',', '#', 'c' ];
348 permute_test [ 'f_oo', 'b_ar' ], '/', '/', [ 'f_oo', 'b_ar' ];
350 # issue c093 - broken sub, but align fat commas
351 use constant UNDEF_ONLY => sub { not defined $_[0] };
352 use constant EMPTY_OR_UNDEF => sub {
353 !@_ or @_ == 1 && !defined $_[0];
361 expect => <<'#2...........',
362 $top_label->set_text( gettext("check permissions.") )
370 expect => <<'#3...........',
371 $top_label->set_text( gettext("check permissions.") );
375 'comments.comments1' => {
376 source => "comments",
377 params => "comments1",
378 expect => <<'#4...........',
380 # an initial hash bang line cannot be deleted with -dp
381 #<<< format skipping of first code can cause an error message in perltidy v20210625
382 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
384 sub length { return length( $_[0] ) } # side comment
386 # hanging side comment
387 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
389 # a blank will be inserted to prevent forming a hanging side comment
390 sub macro_get_names { #
393 # %name = macro_get_names(); (key=macrohandle, value=macroname)
395 ##local(%name); # a static block comment without indentation
396 local (%name) = (); ## a static side comment to test -ssc
398 # a spaced block comment to test -isbc
399 for ( 0 .. $#mac_ver ) {
401 # a very long comment for testing the parameter --nooutdent-long-comments (or -nolc)
402 $name{$_} = $mac_ext[ $idx{ $mac_exti[$_] } ];
403 $vmsfile =~ s/;[\d\-]*$//; # very long side comment; Clip off version number; we can use a newer version as well
410 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
411 ## 'Dec', 'Nov' [a static block comment with indentation]
415 { # this side comment will not align
416 my $IGNORE = 0; # This is a side comment
418 # This is a hanging side comment
421 # A blank line interrupts the hsc's; this is a block comment
425 # side comments at different indentation levels should not normally be aligned
430 { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
436 #<<< do not let perltidy touch this unless -nfs is set
444 #<< test alternate format skipping string
445 my @list = ( 1, 1, 1, 1, 2, 1, 1, 3, 3, 1, 1, 4, 6, 4, 1, );
449 # some blank lines follow
452 Some pod before __END__ to delete with -dp
458 # text following __END__, not a comment
462 Some pod after __END__ to delete with -dp and trim with -trp
469 'comments.comments2' => {
470 source => "comments",
471 params => "comments2",
472 expect => <<'#5...........',
474 #<<< format skipping of first code can cause an error message in perltidy v20210625
475 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
477 sub length { return length( $_[0] ) } # side comment
478 # hanging side comment
479 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
481 sub macro_get_names { #
482 local (%name) = (); ## a static side comment to test -ssc
484 for ( 0 .. $#mac_ver ) {
485 $name{$_} = $mac_ext[ $idx{ $mac_exti[$_] } ];
486 $vmsfile =~ s/;[\d\-]*$//
487 ; # very long side comment; Clip off version number; we can use a newer version as well
494 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
498 { # this side comment will not align
499 my $IGNORE = 0; # This is a side comment
500 # This is a hanging side comment
509 { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
515 #<<< do not let perltidy touch this unless -nfs is set
523 my @list = ( 1, 1, 1, 1, 2, 1, 1, 3, 3, 1, 1, 4, 6, 4, 1, );
529 # text following __END__, not a comment
537 'comments.comments3' => {
538 source => "comments",
539 params => "comments3",
540 expect => <<'#6...........',
542 # an initial hash bang line cannot be deleted with -dp
543 #<<< format skipping of first code can cause an error message in perltidy v20210625
544 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
547 sub length { return length( $_[0] ) } # side comment
548 # hanging side comment
549 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
551 # a blank will be inserted to prevent forming a hanging side comment
552 sub macro_get_names { #
555 # %name = macro_get_names(); (key=macrohandle, value=macroname)
557 ##local(%name); # a static block comment without indentation
558 local (%name) = (); ## a static side comment to test -ssc
560 # a spaced block comment to test -isbc
561 for ( 0 .. $#mac_ver ) {
563 # a very long comment for testing the parameter --nooutdent-long-comments (or -nolc)
564 $name{$_} = $mac_ext[ $idx{ $mac_exti[$_] } ];
565 $vmsfile =~ s/;[\d\-]*$//
566 ; # very long side comment; Clip off version number; we can use a newer version as well
574 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
575 ## 'Dec', 'Nov' [a static block comment with indentation]
580 { # this side comment will not align
581 my $IGNORE = 0; # This is a side comment
582 # This is a hanging side comment
585 # A blank line interrupts the hsc's; this is a block comment
589 # side comments at different indentation levels should not normally be aligned
594 { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
601 #<<< do not let perltidy touch this unless -nfs is set
602 my @list = ( 1, 1, 1, 1, 2, 1, 1, 3, 3, 1, 1, 4, 6, 4, 1, );
606 #<< test alternate format skipping string
607 my @list = ( 1, 1, 1, 1, 2, 1, 1, 3, 3, 1, 1, 4, 6, 4, 1, );
612 # some blank lines follow
616 Some pod before __END__ to delete with -dp
623 # text following __END__, not a comment
627 Some pod after __END__ to delete with -dp and trim with -trp
634 'comments.comments4' => {
635 source => "comments",
636 params => "comments4",
637 expect => <<'#7...........',
639 # an initial hash bang line cannot be deleted with -dp
640 #<<< format skipping of first code can cause an error message in perltidy v20210625
641 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
643 sub length { return length( $_[0] ) } # side comment
644 # hanging side comment
645 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
647 # a blank will be inserted to prevent forming a hanging side comment
648 sub macro_get_names { #
651 # %name = macro_get_names(); (key=macrohandle, value=macroname)
653 ##local(%name); # a static block comment without indentation
654 local (%name) = (); ## a static side comment to test -ssc
656 # a spaced block comment to test -isbc
657 for ( 0 .. $#mac_ver ) {
659 # a very long comment for testing the parameter --nooutdent-long-comments (or -nolc)
660 $name{$_} = $mac_ext[ $idx{ $mac_exti[$_] } ];
661 $vmsfile =~ s/;[\d\-]*$//
662 ; # very long side comment; Clip off version number; we can use a newer version as well
671 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
672 ## 'Dec', 'Nov' [a static block comment with indentation]
677 { # this side comment will not align
678 my $IGNORE = 0; # This is a side comment
679 # This is a hanging side comment
682 # A blank line interrupts the hsc's; this is a block comment
686 # side comments at different indentation levels should not normally be aligned
691 { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
698 #<<< do not let perltidy touch this unless -nfs is set
706 #<< test alternate format skipping string
716 # some blank lines follow
721 Some pod before __END__ to delete with -dp
728 # text following __END__, not a comment
732 Some pod after __END__ to delete with -dp and trim with -trp
740 source => "comments",
742 expect => <<'#8...........',
744 # an initial hash bang line cannot be deleted with -dp
745 #<<< format skipping of first code can cause an error message in perltidy v20210625
746 my $rvar = [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
748 sub length { return length( $_[0] ) } # side comment
749 # hanging side comment
750 # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment
752 # a blank will be inserted to prevent forming a hanging side comment
753 sub macro_get_names { #
756 # %name = macro_get_names(); (key=macrohandle, value=macroname)
758 ##local(%name); # a static block comment without indentation
759 local (%name) = (); ## a static side comment to test -ssc
761 # a spaced block comment to test -isbc
762 for ( 0 .. $#mac_ver ) {
764 # a very long comment for testing the parameter --nooutdent-long-comments (or -nolc)
765 $name{$_} = $mac_ext[ $idx{ $mac_exti[$_] } ];
766 $vmsfile =~ s/;[\d\-]*$//
767 ; # very long side comment; Clip off version number; we can use a newer version as well
774 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
775 ## 'Dec', 'Nov' [a static block comment with indentation]
779 { # this side comment will not align
780 my $IGNORE = 0; # This is a side comment
781 # This is a hanging side comment
784 # A blank line interrupts the hsc's; this is a block comment
788 # side comments at different indentation levels should not normally be aligned
793 { ${msg} = "Hello World!"; print "My message: ${msg}\n"; }
799 #<<< do not let perltidy touch this unless -nfs is set
807 #<< test alternate format skipping string
808 my @list = ( 1, 1, 1, 1, 2, 1, 1, 3, 3, 1, 1, 4, 6, 4, 1, );
812 # some blank lines follow
815 Some pod before __END__ to delete with -dp
821 # text following __END__, not a comment
825 Some pod after __END__ to delete with -dp and trim with -trp
833 source => "long_line",
835 expect => <<'#9...........',
836 # This single line should break into multiple lines, even with -l=0
837 # sub 'tight_paren_follows' should break the do block
839 SOAP::Data->name('~V:Fault')->attr( { 'xmlns' => $SOAP::Constants::NS_ENV } )
841 \SOAP::Data->set_value(
843 faultcode => qualify( $self->namespace => shift(@parameters) )
845 SOAP::Data->name( faultstring => shift(@parameters) ),
849 my $detail = shift(@parameters);
850 ref $detail ? \$detail : $detail;
854 @parameters ? SOAP::Data->name( faultactor => shift(@parameters) ) : (),
860 'long_line.long_line' => {
861 source => "long_line",
862 params => "long_line",
863 expect => <<'#10...........',
864 # This single line should break into multiple lines, even with -l=0
865 # sub 'tight_paren_follows' should break the do block
866 $body = SOAP::Data->name('~V:Fault')->attr( { 'xmlns' => $SOAP::Constants::NS_ENV } )->value(
867 \SOAP::Data->set_value(
868 SOAP::Data->name( faultcode => qualify( $self->namespace => shift(@parameters) ) ),
869 SOAP::Data->name( faultstring => shift(@parameters) ),
872 detail => do { my $detail = shift(@parameters); ref $detail ? \$detail : $detail }
875 @parameters ? SOAP::Data->name( faultactor => shift(@parameters) ) : (),
884 expect => <<'#11...........',
885 # These formerly blinked with -pbp
889 $W * atan2( 1, $W ) +
890 $H * atan2( 1, $H ) -
891 $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ ) +
893 ( $WSQP1 * $HSQP1 ) /
894 ( 1 + $WSQ + $HSQ ) *
895 ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
897 ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )**$HSQ
903 ( 60 * $session->{originalStartHour} + $session->{originalStartMin} )
912 expect => <<'#12...........',
913 # These formerly blinked with -pbp
915 $width1 * $common_length
918 + $H * atan2( 1, $H )
919 - $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ )
922 / ( 1 + $WSQ + $HSQ )
923 * ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
925 * ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )
932 = ( 60 * $session->{originalStartHour}
933 + $session->{originalStartMin} )
942 expect => <<'#13...........',
943 # Some test cases for RPerl, https://github.com/wbraswell/rperl/
944 # These must not remain as single lines with default formatting and long lines
945 sub multiply_return_F {
946 { my number $RETURN_TYPE };
947 ( my integer $multiplicand, my number $multiplier ) = @ARG;
948 return $multiplicand * $multiplier;
952 { my void::method $RETURN_TYPE };
956 sub foo_subroutine_in_main {
957 { my void $RETURN_TYPE };
958 print 'Howdy from foo_subroutine_in_main()...', "\n";
967 expect => <<'#14...........',
968 # Some test cases for RPerl, https://github.com/wbraswell/rperl/
969 # These must not remain as single lines with default formatting and long lines
970 sub multiply_return_F {
971 { my number $RETURN_TYPE };
972 ( my integer $multiplicand, my number $multiplier ) = @ARG;
973 return $multiplicand * $multiplier;
977 { my void::method $RETURN_TYPE };
981 sub foo_subroutine_in_main {
982 { my void $RETURN_TYPE };
983 print 'Howdy from foo_subroutine_in_main()...', "\n";
990 source => "rt132059",
992 expect => <<'#15...........',
993 # Test deleting comments and pod
996 sub f { # a side comment
997 # a hanging side comment
1010 'rt132059.rt132059' => {
1011 source => "rt132059",
1012 params => "rt132059",
1013 expect => <<'#16...........',
1025 'signature.def' => {
1026 source => "signature",
1028 expect => <<'#17...........',
1029 # git22: Preserve function signature on a single line
1030 # This behavior is controlled by 'sub weld_signature_parens'
1032 sub foo ( $x, $y = "abcd" ) {
1036 # do not break after closing do brace
1037 sub foo ( $x, $y = do { {} }, $z = 42, $w = do { "abcd" } ) {
1041 # This signature should get put back on one line
1042 sub t022 ( $p = do { $z += 10; 222 }, $a = do { $z++; 333 } ) { "$p/$a" }
1044 # anonymous sub with signature
1045 my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) {
1049 # signature and prototype and attribute
1050 sub foo1 ( $x, $y ) : prototype ( $$ ) : shared { }
1052 sub foo11 ( $thing, % ) { print $thing }
1054 sub animal4 ( $cat, $ = ) { } # second argument is optional
1056 *share = sub ( \[$@%] ) { };
1059 sub foo2 ( $first, $, $third ) {
1060 return "first=$first, third=$third";
1064 sub fnord (&\%) : switch(10,foo(7,3)) : expensive;
1065 sub plugh () : Ugly('\(") : Bad;
1070 source => "ternary4",
1072 expect => <<'#18...........',
1073 # some side comments
1074 *{"${callpkg}::$sym"} = $type eq '&' ? \&{"${pkg}::$sym"} #
1075 : $type eq '$' ? \${"${pkg}::$sym"} #
1076 : $type eq '@' ? \@{"${pkg}::$sym"}
1077 : $type eq '%' ? \%{"${pkg}::$sym"} # side comment
1078 : $type eq '*' ? *{"${pkg}::$sym"} #
1079 : do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
1086 expect => <<'#19...........',
1087 # do not weld paren to opening one-line non-paren container
1090 $Field->GenerateFieldForSelectSQL()
1094 # this will not get welded with -wn
1096 do { 1; !!( my $x = bless [] ); }
1102 my $ntests = 0 + keys %{$rtests};
1103 plan tests => $ntests;
1110 foreach my $key ( sort keys %{$rtests} ) {
1112 my $sname = $rtests->{$key}->{source};
1113 my $expect = $rtests->{$key}->{expect};
1114 my $pname = $rtests->{$key}->{params};
1115 my $source = $rsources->{$sname};
1116 my $params = defined($pname) ? $rparams->{$pname} : "";
1118 my $errorfile_string;
1119 my $err = Perl::Tidy::perltidy(
1121 destination => \$output,
1122 perltidyrc => \$params,
1123 argv => '', # for safety; hide any ARGV from perltidy
1124 stderr => \$stderr_string,
1125 errorfile => \$errorfile_string, # not used when -se flag is set
1127 if ( $err || $stderr_string || $errorfile_string ) {
1128 print STDERR "Error output received for test '$key'\n";
1130 print STDERR "An error flag '$err' was returned\n";
1133 if ($stderr_string) {
1134 print STDERR "---------------------\n";
1135 print STDERR "<<STDERR>>\n$stderr_string\n";
1136 print STDERR "---------------------\n";
1137 ok( !$stderr_string );
1139 if ($errorfile_string) {
1140 print STDERR "---------------------\n";
1141 print STDERR "<<.ERR file>>\n$errorfile_string\n";
1142 print STDERR "---------------------\n";
1143 ok( !$errorfile_string );
1147 if ( !is( $output, $expect, $key ) ) {
1148 my $leno = length($output);
1149 my $lene = length($expect);
1150 if ( $leno == $lene ) {
1152 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
1156 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";