From: Steve Hancock Date: Sun, 19 Apr 2020 14:23:07 +0000 (-0700) Subject: added tests for parameters -fpsc -iscl -msc -mbl X-Git-Tag: 20200619~86 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1251f8cdc3f576cb57e37fc8073dbe4ab0e70558;p=perltidy.git added tests for parameters -fpsc -iscl -msc -mbl --- diff --git a/t/snippets/comments.in b/t/snippets/comments.in new file mode 100644 index 00000000..3c57e797 --- /dev/null +++ b/t/snippets/comments.in @@ -0,0 +1,22 @@ +# test script for side comment and blank line flags +sub length { return length($_[0]) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + + +# side comments at different indentation levels should not normally be aligned +{ { { { { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + + + +# some blank lines follow + + + + + diff --git a/t/snippets/comments1.par b/t/snippets/comments1.par new file mode 100644 index 00000000..24bda256 --- /dev/null +++ b/t/snippets/comments1.par @@ -0,0 +1 @@ +-fpsc=40 -iscl diff --git a/t/snippets/comments2.par b/t/snippets/comments2.par new file mode 100644 index 00000000..189d47bf --- /dev/null +++ b/t/snippets/comments2.par @@ -0,0 +1 @@ +-msc=10 diff --git a/t/snippets/comments3.par b/t/snippets/comments3.par new file mode 100644 index 00000000..20cd6284 --- /dev/null +++ b/t/snippets/comments3.par @@ -0,0 +1 @@ +-mbl=2 diff --git a/t/snippets/comments4.par b/t/snippets/comments4.par new file mode 100644 index 00000000..e006eaf3 --- /dev/null +++ b/t/snippets/comments4.par @@ -0,0 +1 @@ +-kbl=2 diff --git a/t/snippets/expect/comments.comments1 b/t/snippets/expect/comments.comments1 new file mode 100644 index 00000000..9c15f38b --- /dev/null +++ b/t/snippets/expect/comments.comments1 @@ -0,0 +1,18 @@ +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow + diff --git a/t/snippets/expect/comments.comments2 b/t/snippets/expect/comments.comments2 new file mode 100644 index 00000000..3e6da005 --- /dev/null +++ b/t/snippets/expect/comments.comments2 @@ -0,0 +1,18 @@ +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow + diff --git a/t/snippets/expect/comments.comments3 b/t/snippets/expect/comments.comments3 new file mode 100644 index 00000000..e167541a --- /dev/null +++ b/t/snippets/expect/comments.comments3 @@ -0,0 +1,21 @@ +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + +# some blank lines follow + + diff --git a/t/snippets/expect/comments.comments4 b/t/snippets/expect/comments.comments4 new file mode 100644 index 00000000..d69b7d88 --- /dev/null +++ b/t/snippets/expect/comments.comments4 @@ -0,0 +1,27 @@ +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + + + +# some blank lines follow + + + + + diff --git a/t/snippets/expect/comments.def b/t/snippets/expect/comments.def new file mode 100644 index 00000000..18d14c73 --- /dev/null +++ b/t/snippets/expect/comments.def @@ -0,0 +1,18 @@ +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow + diff --git a/t/snippets/make_expect.pl b/t/snippets/make_expect.pl index 4a7516c2..0db334a1 100755 --- a/t/snippets/make_expect.pl +++ b/t/snippets/make_expect.pl @@ -147,9 +147,6 @@ foreach my $sname ( keys %{$rsources} ) { stderr => \$stderr_string, errorfile => \$errorfile_string, # not used when -se flag is set ); - if ($err) { - die "error calling Perl::Tidy with $source + $params\n"; - } if ($stderr_string) { print STDERR "---------------------\n"; print STDERR "<>\n$stderr_string\n"; @@ -162,6 +159,9 @@ foreach my $sname ( keys %{$rsources} ) { print STDERR "---------------------\n"; die "The above .ERR was received with $source + $params\n"; } + if ($err) { + die "error calling Perl::Tidy with $source + $params\n"; + } my $basename = "$sname.$pname"; my $ofile = $opath . $basename; diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 6d6b34fa..818c1477 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -155,21 +155,6 @@ ../snippets16.t rt130394.rt130394 ../snippets16.t git18.def ../snippets16.t here2.def -../snippets17.t rt132059.def -../snippets17.t rt132059.rt132059 -../snippets17.t signature.def -../snippets17.t rperl.def -../snippets17.t rperl.rperl -../snippets17.t wn7.def -../snippets17.t wn7.wn -../snippets17.t wn8.def -../snippets17.t wn8.wn -../snippets17.t pbp6.def -../snippets17.t pbp6.pbp -../snippets17.t bos.bos -../snippets17.t bos.def -../snippets17.t long_line.def -../snippets17.t long_line.long_line ../snippets2.t angle.def ../snippets2.t arrows1.def ../snippets2.t arrows2.def @@ -331,4 +316,24 @@ ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def ../snippets17.t align32.def +../snippets17.t bos.bos +../snippets17.t bos.def +../snippets17.t comments.comments1 +../snippets17.t comments.comments2 +../snippets17.t comments.comments3 +../snippets17.t comments.comments4 +../snippets17.t comments.def +../snippets17.t long_line.def +../snippets17.t long_line.long_line +../snippets17.t pbp6.def +../snippets17.t pbp6.pbp +../snippets17.t rperl.def +../snippets17.t rperl.rperl +../snippets17.t rt132059.def +../snippets17.t rt132059.rt132059 +../snippets17.t signature.def ../snippets17.t ternary4.def +../snippets17.t wn7.def +../snippets18.t wn7.wn +../snippets18.t wn8.def +../snippets18.t wn8.wn diff --git a/t/snippets17.t b/t/snippets17.t index fec8deee..2fed843a 100644 --- a/t/snippets17.t +++ b/t/snippets17.t @@ -1,23 +1,25 @@ # Created with: ./make_t.pl # Contents: -#1 rt132059.def -#2 rt132059.rt132059 -#3 signature.def -#4 rperl.def -#5 rperl.rperl -#6 wn7.def -#7 wn7.wn -#8 wn8.def -#9 wn8.wn -#10 pbp6.def -#11 pbp6.pbp -#12 bos.bos -#13 bos.def -#14 long_line.def -#15 long_line.long_line -#16 align32.def -#17 ternary4.def +#1 align32.def +#2 bos.bos +#3 bos.def +#4 comments.comments1 +#5 comments.comments2 +#6 comments.comments3 +#7 comments.comments4 +#8 comments.def +#9 long_line.def +#10 long_line.long_line +#11 pbp6.def +#12 pbp6.pbp +#13 rperl.def +#14 rperl.rperl +#15 rt132059.def +#16 rt132059.rt132059 +#17 signature.def +#18 ternary4.def +#19 wn7.def # To locate test #13 you can search for its name or the string '#13' @@ -36,12 +38,15 @@ BEGIN { ########################################### $rparams = { 'bos' => "-bos", + 'comments1' => "-fpsc=40 -iscl", + 'comments2' => "-msc=10", + 'comments3' => "-mbl=2", + 'comments4' => "-kbl=2", 'def' => "", 'long_line' => "-l=0", 'pbp' => "-pbp -nst -nse", 'rperl' => "-l=0", 'rt132059' => "-dac", - 'wn' => "-wn", }; ############################ @@ -59,6 +64,31 @@ ok IsWindow($c_sub_khwnd), 'IsWindow works on the client'; 'bos' => <<'----------', $top_label->set_text( gettext("check permissions.") ) ; +---------- + + 'comments' => <<'----------', +# test script for side comment and blank line flags +sub length { return length($_[0]) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + + +# side comments at different indentation levels should not normally be aligned +{ { { { { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + + + +# some blank lines follow + + + + + ---------- 'long_line' => <<'----------', @@ -154,27 +184,6 @@ my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) { do { 1; !!(my $x = bless []); } ); ---------- - - 'wn8' => <<'----------', - # Former -wn blinkers, which oscillated between two states - - # fixed RULE 1 only applies to '(' - my $res = eval { { $die_on_fetch, 0 } }; - - my $res = eval { - { $die_on_fetch, 0 } - }; - - # fixed RULE 2 applies to any inner opening token; this is a stable - # state with -wn - $app->FORM->{'appbar1'}->set_status( - _("Cannot delete zone $name: sub-zones or appellations exist.") - ); - - # fixed RULE 1: this is now a stable state with -wn - $app->FORM->{'appbar1'}->set_status(_( - "Cannot delete zone $name: sub-zones or appellations exist.")); ----------- }; #################################### @@ -182,207 +191,224 @@ my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) { #################################### $rtests = { - 'rt132059.def' => { - source => "rt132059", + 'align32.def' => { + source => "align32", params => "def", expect => <<'#1...........', -# Test deleting comments and pod -$1 = 2; - -sub f { # a side comment - # a hanging side comment - - # a block comment -} - -=pod -bonjour! -=cut - -$i++; +# should not get alignment here: +my $c_sub_khwnd = WindowFromId $k_hwnd, 0x8008; # FID_CLIENT +ok $c_sub_khwnd, 'have kids client window'; +ok IsWindow($c_sub_khwnd), 'IsWindow works on the client'; #1........... }, - 'rt132059.rt132059' => { - source => "rt132059", - params => "rt132059", + 'bos.bos' => { + source => "bos", + params => "bos", expect => <<'#2...........', -$1 = 2; - -sub f { - -} - - -$i++; + $top_label->set_text( gettext("check permissions.") ) + ; #2........... }, - 'signature.def' => { - source => "signature", + 'bos.def' => { + source => "bos", params => "def", expect => <<'#3...........', -# git22: Preserve function signature on a single line -# This behavior is controlled by 'sub weld_signature_parens' - -sub foo ( $x, $y = "abcd" ) { - $x . $y; -} - -# do not break after closing do brace -sub foo ( $x, $y = do { {} }, $z = 42, $w = do { "abcd" } ) { - $x . $y . $z; -} - -# This signature should get put back on one line -sub t022 ( $p = do { $z += 10; 222 }, $a = do { $z++; 333 } ) { - "$p/$a"; -} - -# anonymous sub with signature -my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) { - ...; -}; + $top_label->set_text( gettext("check permissions.") ); #3........... }, - 'rperl.def' => { - source => "rperl", - params => "def", + 'comments.comments1' => { + source => "comments", + params => "comments1", expect => <<'#4...........', -# Some test cases for RPerl, https://github.com/wbraswell/rperl/ -# These must not remain as single lines with default formatting and long lines -sub multiply_return_F { - { my number $RETURN_TYPE }; - ( my integer $multiplicand, my number $multiplier ) = @ARG; - return $multiplicand * $multiplier; -} +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow -sub empty_method { - { my void::method $RETURN_TYPE }; - return 2; -} - -sub foo_subroutine_in_main { - { my void $RETURN_TYPE }; - print 'Howdy from foo_subroutine_in_main()...', "\n"; - return; -} #4........... }, - 'rperl.rperl' => { - source => "rperl", - params => "rperl", + 'comments.comments2' => { + source => "comments", + params => "comments2", expect => <<'#5...........', -# Some test cases for RPerl, https://github.com/wbraswell/rperl/ -# These must not remain as single lines with default formatting and long lines -sub multiply_return_F { - { my number $RETURN_TYPE }; - ( my integer $multiplicand, my number $multiplier ) = @ARG; - return $multiplicand * $multiplier; -} - -sub empty_method { - { my void::method $RETURN_TYPE }; - return 2; -} +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow -sub foo_subroutine_in_main { - { my void $RETURN_TYPE }; - print 'Howdy from foo_subroutine_in_main()...', "\n"; - return; -} #5........... }, - 'wn7.def' => { - source => "wn7", - params => "def", + 'comments.comments3' => { + source => "comments", + params => "comments3", expect => <<'#6...........', - # do not weld paren to opening one-line non-paren container - $Self->_Add( - $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } - ); +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + +# some blank lines follow + - # this will not get welded with -wn - f( - do { 1; !!( my $x = bless [] ); } - ); #6........... }, - 'wn7.wn' => { - source => "wn7", - params => "wn", + 'comments.comments4' => { + source => "comments", + params => "comments4", expect => <<'#7...........', - # do not weld paren to opening one-line non-paren container - $Self->_Add( - $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } - ); +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + + + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + + + + +# some blank lines follow + + + + - # this will not get welded with -wn - f( - do { 1; !!( my $x = bless [] ); } - ); #7........... }, - 'wn8.def' => { - source => "wn8", + 'comments.def' => { + source => "comments", params => "def", expect => <<'#8...........', - # Former -wn blinkers, which oscillated between two states - - # fixed RULE 1 only applies to '(' - my $res = eval { - { $die_on_fetch, 0 } - }; - - my $res = eval { - { $die_on_fetch, 0 } - }; - - # fixed RULE 2 applies to any inner opening token; this is a stable - # state with -wn - $app->FORM->{'appbar1'}->set_status( - _("Cannot delete zone $name: sub-zones or appellations exist.") - ); - - # fixed RULE 1: this is now a stable state with -wn - $app->FORM->{'appbar1'}->set_status( - _("Cannot delete zone $name: sub-zones or appellations exist.") - ); +# test script for side comment and blank line flags +sub length { return length( $_[0] ) } # side comment + # hanging side comment + # very longgggggggggggggggggggggggggggggggggggggggggggggggggggg hanging side comment + +# side comments at different indentation levels should not normally be aligned +{ + { + { + { + { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } + } #end level 4 + } # end level 3 + } # end level 2 +} # end level 1 + +# some blank lines follow + #8........... }, - 'wn8.wn' => { - source => "wn8", - params => "wn", + 'long_line.def' => { + source => "long_line", + params => "def", expect => <<'#9...........', - # Former -wn blinkers, which oscillated between two states - - # fixed RULE 1 only applies to '(' - my $res = eval { { $die_on_fetch, 0 } }; - - my $res = eval { { $die_on_fetch, 0 } }; - - # fixed RULE 2 applies to any inner opening token; this is a stable - # state with -wn - $app->FORM->{'appbar1'}->set_status( - _("Cannot delete zone $name: sub-zones or appellations exist.") - ); - - # fixed RULE 1: this is now a stable state with -wn - $app->FORM->{'appbar1'}->set_status( _( - "Cannot delete zone $name: sub-zones or appellations exist.") ); +# This single line should break into multiple lines, even with -l=0 +# sub 'tight_paren_follows' should break the do block +$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) ) : (), + ) + ); #9........... }, + 'long_line.long_line' => { + source => "long_line", + params => "long_line", + expect => <<'#10...........', +# This single line should break into multiple lines, even with -l=0 +# sub 'tight_paren_follows' should break the do block +$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) ) : (), + ) +); +#10........... + }, + 'pbp6.def' => { source => "pbp6", params => "def", - expect => <<'#10...........', + expect => <<'#11...........', # These formerly blinked with -pbp return $width1 * $common_length * @@ -404,13 +430,13 @@ sub foo_subroutine_in_main { ( 60 * $session->{originalStartHour} + $session->{originalStartMin} ) * 60; -#10........... +#11........... }, 'pbp6.pbp' => { source => "pbp6", params => "pbp", - expect => <<'#11...........', + expect => <<'#12...........', # These formerly blinked with -pbp return $width1 * $common_length @@ -434,90 +460,127 @@ sub foo_subroutine_in_main { + $session->{originalStartMin} ) * 60; -#11........... - }, - - 'bos.bos' => { - source => "bos", - params => "bos", - expect => <<'#12...........', - $top_label->set_text( gettext("check permissions.") ) - ; #12........... }, - 'bos.def' => { - source => "bos", + 'rperl.def' => { + source => "rperl", params => "def", expect => <<'#13...........', - $top_label->set_text( gettext("check permissions.") ); +# Some test cases for RPerl, https://github.com/wbraswell/rperl/ +# These must not remain as single lines with default formatting and long lines +sub multiply_return_F { + { my number $RETURN_TYPE }; + ( my integer $multiplicand, my number $multiplier ) = @ARG; + return $multiplicand * $multiplier; +} + +sub empty_method { + { my void::method $RETURN_TYPE }; + return 2; +} + +sub foo_subroutine_in_main { + { my void $RETURN_TYPE }; + print 'Howdy from foo_subroutine_in_main()...', "\n"; + return; +} #13........... }, - 'long_line.def' => { - source => "long_line", - params => "def", + 'rperl.rperl' => { + source => "rperl", + params => "rperl", expect => <<'#14...........', -# This single line should break into multiple lines, even with -l=0 -# sub 'tight_paren_follows' should break the do block -$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) ) : (), - ) - ); +# Some test cases for RPerl, https://github.com/wbraswell/rperl/ +# These must not remain as single lines with default formatting and long lines +sub multiply_return_F { + { my number $RETURN_TYPE }; + ( my integer $multiplicand, my number $multiplier ) = @ARG; + return $multiplicand * $multiplier; +} + +sub empty_method { + { my void::method $RETURN_TYPE }; + return 2; +} + +sub foo_subroutine_in_main { + { my void $RETURN_TYPE }; + print 'Howdy from foo_subroutine_in_main()...', "\n"; + return; +} #14........... }, - 'long_line.long_line' => { - source => "long_line", - params => "long_line", + 'rt132059.def' => { + source => "rt132059", + params => "def", expect => <<'#15...........', -# This single line should break into multiple lines, even with -l=0 -# sub 'tight_paren_follows' should break the do block -$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) ) : (), - ) -); +# Test deleting comments and pod +$1 = 2; + +sub f { # a side comment + # a hanging side comment + + # a block comment +} + +=pod +bonjour! +=cut + +$i++; #15........... }, - 'align32.def' => { - source => "align32", - params => "def", + 'rt132059.rt132059' => { + source => "rt132059", + params => "rt132059", expect => <<'#16...........', -# should not get alignment here: -my $c_sub_khwnd = WindowFromId $k_hwnd, 0x8008; # FID_CLIENT -ok $c_sub_khwnd, 'have kids client window'; -ok IsWindow($c_sub_khwnd), 'IsWindow works on the client'; +$1 = 2; + +sub f { + +} + + +$i++; #16........... }, + 'signature.def' => { + source => "signature", + params => "def", + expect => <<'#17...........', +# git22: Preserve function signature on a single line +# This behavior is controlled by 'sub weld_signature_parens' + +sub foo ( $x, $y = "abcd" ) { + $x . $y; +} + +# do not break after closing do brace +sub foo ( $x, $y = do { {} }, $z = 42, $w = do { "abcd" } ) { + $x . $y . $z; +} + +# This signature should get put back on one line +sub t022 ( $p = do { $z += 10; 222 }, $a = do { $z++; 333 } ) { + "$p/$a"; +} + +# anonymous sub with signature +my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) { + ...; +}; +#17........... + }, + 'ternary4.def' => { source => "ternary4", params => "def", - expect => <<'#17...........', + expect => <<'#18...........', # some side comments *{"${callpkg}::$sym"} = $type eq '&' ? \&{"${pkg}::$sym"} # : $type eq '$' ? \${"${pkg}::$sym"} # @@ -525,7 +588,23 @@ ok IsWindow($c_sub_khwnd), 'IsWindow works on the client'; : $type eq '%' ? \%{"${pkg}::$sym"} # side comment : $type eq '*' ? *{"${pkg}::$sym"} # : do { require Carp; Carp::croak("Can't export symbol: $type$sym") }; -#17........... +#18........... + }, + + 'wn7.def' => { + source => "wn7", + params => "def", + expect => <<'#19...........', + # do not weld paren to opening one-line non-paren container + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # this will not get welded with -wn + f( + do { 1; !!( my $x = bless [] ); } + ); +#19........... }, }; diff --git a/t/snippets18.t b/t/snippets18.t new file mode 100644 index 00000000..b4b606e3 --- /dev/null +++ b/t/snippets18.t @@ -0,0 +1,189 @@ +# Created with: ./make_t.pl + +# Contents: +#1 wn7.wn +#2 wn8.def +#3 wn8.wn + +# To locate test #13 you can search for its name or the string '#13' + +use strict; +use Test; +use Carp; +use Perl::Tidy; +my $rparams; +my $rsources; +my $rtests; + +BEGIN { + + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### + $rparams = { + 'def' => "", + 'wn' => "-wn", + }; + + ############################ + # BEGIN SECTION 2: Sources # + ############################ + $rsources = { + + 'wn7' => <<'----------', + # do not weld paren to opening one-line non-paren container + $Self->_Add($SortOrderDisplay{$Field->GenerateFieldForSelectSQL()}); + + # this will not get welded with -wn + f( + do { 1; !!(my $x = bless []); } + ); +---------- + + 'wn8' => <<'----------', + # Former -wn blinkers, which oscillated between two states + + # fixed RULE 1 only applies to '(' + my $res = eval { { $die_on_fetch, 0 } }; + + my $res = eval { + { $die_on_fetch, 0 } + }; + + # fixed RULE 2 applies to any inner opening token; this is a stable + # state with -wn + $app->FORM->{'appbar1'}->set_status( + _("Cannot delete zone $name: sub-zones or appellations exist.") + ); + + # fixed RULE 1: this is now a stable state with -wn + $app->FORM->{'appbar1'}->set_status(_( + "Cannot delete zone $name: sub-zones or appellations exist.")); +---------- + }; + + #################################### + # BEGIN SECTION 3: Expected output # + #################################### + $rtests = { + + 'wn7.wn' => { + source => "wn7", + params => "wn", + expect => <<'#1...........', + # do not weld paren to opening one-line non-paren container + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # this will not get welded with -wn + f( + do { 1; !!( my $x = bless [] ); } + ); +#1........... + }, + + 'wn8.def' => { + source => "wn8", + params => "def", + expect => <<'#2...........', + # Former -wn blinkers, which oscillated between two states + + # fixed RULE 1 only applies to '(' + my $res = eval { + { $die_on_fetch, 0 } + }; + + my $res = eval { + { $die_on_fetch, 0 } + }; + + # fixed RULE 2 applies to any inner opening token; this is a stable + # state with -wn + $app->FORM->{'appbar1'}->set_status( + _("Cannot delete zone $name: sub-zones or appellations exist.") + ); + + # fixed RULE 1: this is now a stable state with -wn + $app->FORM->{'appbar1'}->set_status( + _("Cannot delete zone $name: sub-zones or appellations exist.") + ); +#2........... + }, + + 'wn8.wn' => { + source => "wn8", + params => "wn", + expect => <<'#3...........', + # Former -wn blinkers, which oscillated between two states + + # fixed RULE 1 only applies to '(' + my $res = eval { { $die_on_fetch, 0 } }; + + my $res = eval { { $die_on_fetch, 0 } }; + + # fixed RULE 2 applies to any inner opening token; this is a stable + # state with -wn + $app->FORM->{'appbar1'}->set_status( + _("Cannot delete zone $name: sub-zones or appellations exist.") + ); + + # fixed RULE 1: this is now a stable state with -wn + $app->FORM->{'appbar1'}->set_status( _( + "Cannot delete zone $name: sub-zones or appellations exist.") ); +#3........... + }, + }; + + my $ntests = 0 + keys %{$rtests}; + plan tests => $ntests; +} + +############### +# EXECUTE TESTS +############### + +foreach my $key ( sort keys %{$rtests} ) { + my $output; + my $sname = $rtests->{$key}->{source}; + my $expect = $rtests->{$key}->{expect}; + my $pname = $rtests->{$key}->{params}; + my $source = $rsources->{$sname}; + my $params = defined($pname) ? $rparams->{$pname} : ""; + my $stderr_string; + my $errorfile_string; + my $err = Perl::Tidy::perltidy( + source => \$source, + destination => \$output, + perltidyrc => \$params, + argv => '', # for safety; hide any ARGV from perltidy + stderr => \$stderr_string, + errorfile => \$errorfile_string, # not used when -se flag is set + ); + if ( $err || $stderr_string || $errorfile_string ) { + if ($err) { + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$err ); + } + if ($stderr_string) { + print STDERR "---------------------\n"; + print STDERR "<>\n$stderr_string\n"; + print STDERR "---------------------\n"; + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$stderr_string ); + } + if ($errorfile_string) { + print STDERR "---------------------\n"; + print STDERR "<<.ERR file>>\n$errorfile_string\n"; + print STDERR "---------------------\n"; + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$errorfile_string ); + } + } + else { + ok( $output, $expect ); + } +}