From 5d3e8a69e31de1c7151320aafa23516227c603af Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Sat, 10 Nov 2018 09:08:35 -0800 Subject: [PATCH] Fixed rt #126965 --- dev-bin/build.pl | 2 +- lib/Perl/Tidy/Tokenizer.pm | 42 ++++++-- local-docs/ChangeLog.pod | 4 + t/snippets/README.md | 3 + t/snippets/expect/rt126965.def | 1 + t/snippets/make_t.pl | 22 ++-- t/snippets/rt126965.in | 1 + t/snippets1.t | 24 +++-- t/snippets10.t | 166 ++++++++++++------------------ t/snippets11.t | 182 +++++++++++++++++++-------------- t/snippets12.t | 119 ++++++++++++--------- t/snippets2.t | 24 +++-- t/snippets3.t | 24 +++-- t/snippets4.t | 24 +++-- t/snippets5.t | 24 +++-- t/snippets6.t | 24 +++-- t/snippets7.t | 24 +++-- t/snippets8.t | 91 ++++++++--------- t/snippets9.t | 145 ++++++++++++++------------ 19 files changed, 520 insertions(+), 426 deletions(-) create mode 100644 t/snippets/expect/rt126965.def create mode 100644 t/snippets/rt126965.in diff --git a/dev-bin/build.pl b/dev-bin/build.pl index bb05e67f..86183b27 100755 --- a/dev-bin/build.pl +++ b/dev-bin/build.pl @@ -43,7 +43,7 @@ my $fh_log; # These are the main steps, in approximate order, for making a new version # Note: Since perl critic is in the .tidyallrc, a separate 'PC' step is not # needed -my $rsteps = [qw( CHK V TIDY T CL POD DIST)]; +my $rsteps = [qw( CHK V PC TIDY T CL POD DIST)]; my $rstatus = {}; foreach my $step ( @{$rsteps} ) { $rstatus->{$step} = 'TBD' } diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 2363f66a..c5a7fe66 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -111,6 +111,7 @@ use vars qw{ @opening_brace_names @closing_brace_names %is_keyword_taking_list + %is_keyword_taking_optional_args %is_q_qq_qw_qx_qr_s_y_tr_m }; @@ -1787,7 +1788,14 @@ sub prepare_for_a_new_file { '/' => sub { my $is_pattern; - if ( $expecting == UNKNOWN ) { # indeterminate, must guess.. + # a pattern cannot follow certain keywords which take optional + # arguments, like 'shift' and 'pop'. See also '?'. + if ( $last_nonblank_type eq 'k' + && $is_keyword_taking_optional_args{$last_nonblank_token} ) + { + $is_pattern = 0; + } + elsif ( $expecting == UNKNOWN ) { # indeterminate, must guess.. my $msg; ( $is_pattern, $msg ) = guess_if_pattern_or_division( $i, $rtokens, $rtoken_map, @@ -2016,7 +2024,15 @@ sub prepare_for_a_new_file { my $is_pattern; - if ( $expecting == UNKNOWN ) { + # Patch for rt #126965 + # a pattern cannot follow certain keywords which take optional + # arguments, like 'shift' and 'pop'. See also '/'. + if ( $last_nonblank_type eq 'k' + && $is_keyword_taking_optional_args{$last_nonblank_token} ) + { + $is_pattern = 0; + } + elsif ( $expecting == UNKNOWN ) { my $msg; ( $is_pattern, $msg ) = @@ -4287,14 +4303,12 @@ sub operator_expected { # no operator after many keywords, such as "die", "warn", etc elsif ( $expecting_term_token{$last_nonblank_token} ) { - # patch for dor.t (defined or). - # perl functions which may be unary operators - # TODO: This list is incomplete, and these should be put - # into a hash. + # // may follow perl functions which may be unary operators + # see test file dor.t (defined or); if ( $tok eq '/' && $next_type eq '/' && $last_nonblank_type eq 'k' - && $last_nonblank_token =~ /^eof|undef|shift|pop$/ ) + && $is_keyword_taking_optional_args{$last_nonblank_token} ) { $op_expected = OPERATOR; } @@ -7843,6 +7857,20 @@ BEGIN { @is_keyword_taking_list{@keyword_taking_list} = (1) x scalar(@keyword_taking_list); + # perl functions which may be unary operators + my @keyword_taking_optional_args = qw( + chomp + eof + eval + lc + pop + shift + uc + undef + ); + @is_keyword_taking_optional_args{@keyword_taking_optional_args} = + (1) x scalar(@keyword_taking_optional_args); + # These are not used in any way yet # my @unused_keywords = qw( # __FILE__ diff --git a/local-docs/ChangeLog.pod b/local-docs/ChangeLog.pod index 97ec0a80..ea2cad33 100644 --- a/local-docs/ChangeLog.pod +++ b/local-docs/ChangeLog.pod @@ -2,6 +2,10 @@ =head2 2018 02 20.01 + - Fixed RT #126965, in which a ternary operator was misparsed if immediately + following a function call without arguments, such as: + my $restrict_customer = shift ? 1 : 0; + - Fixed RT #125012: bug in -mangle --delete-all-comments A needed blank space bareword tokens was being removed when comments were deleted diff --git a/t/snippets/README.md b/t/snippets/README.md index 69ff612c..d9c07970 100644 --- a/t/snippets/README.md +++ b/t/snippets/README.md @@ -68,6 +68,9 @@ It is best to avoid file names which are pure digits because they can be difficu to avoid accidentally invoking unexpected parameter combinations. If you just want to format with default parameters, skip to the the run 'make' step. + - For example, you might add a file named "rt126965.in" and then type 'make' +and follow the directions. + - All snippets are run with default parameters. If the new snippet is to also be run with special parameters, put them in a file with the same base name but extension ".par". diff --git a/t/snippets/expect/rt126965.def b/t/snippets/expect/rt126965.def new file mode 100644 index 00000000..46866aa2 --- /dev/null +++ b/t/snippets/expect/rt126965.def @@ -0,0 +1 @@ +my $restrict_customer = shift ? 1 : 0; diff --git a/t/snippets/make_t.pl b/t/snippets/make_t.pl index 1be9df57..0a190c1f 100755 --- a/t/snippets/make_t.pl +++ b/t/snippets/make_t.pl @@ -133,9 +133,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { EOM @@ -161,9 +161,9 @@ XYZ $script .= <<'++++++++++'; }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { ++++++++++ @@ -192,9 +192,9 @@ XYZ $script .= <<'TMP'; }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { TMP @@ -224,6 +224,10 @@ ENDCASE plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets/rt126965.in b/t/snippets/rt126965.in new file mode 100644 index 00000000..46866aa2 --- /dev/null +++ b/t/snippets/rt126965.in @@ -0,0 +1 @@ +my $restrict_customer = shift ? 1 : 0; diff --git a/t/snippets1.t b/t/snippets1.t index fae1e0b4..21403836 100644 --- a/t/snippets1.t +++ b/t/snippets1.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,14 +14,14 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { '105484' => <<'----------', @@ -202,9 +202,9 @@ if ( ( ( $old_new and $old_new eq 'changed' ) ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { '105484.def' => { @@ -493,6 +493,10 @@ if ( plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets10.t b/t/snippets10.t index b02b42fd..86cca9d2 100644 --- a/t/snippets10.t +++ b/t/snippets10.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:23 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'scl' => "-scl=12", @@ -112,9 +112,9 @@ BEGIN { ---------- }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'scl' => <<'----------', @@ -350,36 +350,33 @@ sub arrange_topframe { } } ----------- - - 'sub1' => <<'----------', -my::doit(); -join::doit(); -for::doit(); -sub::doit(); -package::doit(); -__END__::doit(); -__DATA__::doit(); -package my; -sub doit{print"Hello My\n";}package join; -sub doit{print"Hello Join\n";}package for; -sub doit{print"Hello for\n";}package package; -sub doit{print"Hello package\n";}package sub; -sub doit{print"Hello sub\n";}package __END__; -sub doit{print"Hello __END__\n";}package __DATA__; -sub doit{print"Hello __DATA__\n";} ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { + 'scl.def' => { + source => "scl", + params => "def", + expect => <<'#1...........', + # try -scl=12 to see '$returns' joined with the previous line + $format = + "format STDOUT =\n" + . &format_line('Function: @') . '$name' . "\n" + . &format_line('Arguments: @') . '$args' . "\n" + . &format_line('Returns: @') + . '$returns' . "\n" + . &format_line(' ~~ ^') . '$desc' . "\n.\n"; +#1........... + }, + 'scl.scl' => { source => "scl", params => "scl", - expect => <<'#1...........', + expect => <<'#2...........', # try -scl=12 to see '$returns' joined with the previous line $format = "format STDOUT =\n" @@ -387,24 +384,24 @@ sub doit{print"Hello __DATA__\n";} . &format_line('Arguments: @') . '$args' . "\n" . &format_line('Returns: @') . '$returns' . "\n" . &format_line(' ~~ ^') . '$desc' . "\n.\n"; -#1........... +#2........... }, 'semicolon2.def' => { source => "semicolon2", params => "def", - expect => <<'#2...........', + expect => <<'#3...........', # will not add semicolon for this block type $highest = List::Util::reduce { Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b } -#2........... +#3........... }, 'side_comments1.def' => { source => "side_comments1", params => "def", - expect => <<'#3...........', + expect => <<'#4...........', # side comments at different indentation levels should not be aligned { { @@ -415,13 +412,13 @@ sub doit{print"Hello __DATA__\n";} } # end level 3 } # end level 2 } # end level 1 -#3........... +#4........... }, 'sil1.def' => { source => "sil1", params => "def", - expect => <<'#4...........', + expect => <<'#5...........', ############################################################# # This will walk to the left because of bad -sil guess SKIP: { @@ -435,13 +432,13 @@ sub doit{print"Hello __DATA__\n";} or ov_method mycan( $package, '(bool' ), $package or ov_method mycan( $package, '(nomethod' ), $package; -#4........... +#5........... }, 'sil1.sil' => { source => "sil1", params => "sil", - expect => <<'#5...........', + expect => <<'#6...........', ############################################################# # This will walk to the left because of bad -sil guess SKIP: { @@ -455,13 +452,13 @@ SKIP: { or ov_method mycan( $package, '(bool' ), $package or ov_method mycan( $package, '(nomethod' ), $package; -#5........... +#6........... }, 'slashslash.def' => { source => "slashslash", params => "def", - expect => <<'#6...........', + expect => <<'#7...........', $home = $ENV{HOME} // $ENV{LOGDIR} // ( getpwuid($<) )[7] // die "You're homeless!\n"; defined( $x // $y ); @@ -469,13 +466,13 @@ $version = 'v' . join '.', map ord, split //, $version->PV; foreach ( split( //, $lets ) ) { } foreach ( split( //, $input ) ) { } 'xyz' =~ //; -#6........... +#7........... }, 'smart.def' => { source => "smart", params => "def", - expect => <<'#7...........', + expect => <<'#8...........', \&foo !~~ \&foo; \&foo ~~ \&foo; \&foo ~~ \&foo; @@ -588,13 +585,13 @@ qr/3/ ~~ 12345; "foo" ~~ %hash; %hash ~~ /bar/; /bar/ ~~ %hash; -#7........... +#8........... }, 'space1.def' => { source => "space1", params => "def", - expect => <<'#8...........', + expect => <<'#9...........', # We usually want a space at '} (', for example: map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s ); @@ -603,60 +600,60 @@ qr/3/ ~~ 12345; # remove unwanted spaces after $ and -> here &{ $_->[1] }( delete $_[$#_]{ $_->[0] } ); -#8........... +#9........... }, 'space2.def' => { source => "space2", params => "def", - expect => <<'#9...........', + expect => <<'#10...........', # space before this opening paren for $i ( 0 .. 20 ) { } # retain any space between '-' and bare word $myhash{ USER-NAME } = 'steve'; -#9........... +#10........... }, 'space3.def' => { source => "space3", params => "def", - expect => <<'#10...........', + expect => <<'#11...........', # Treat newline as a whitespace. Otherwise, we might combine # 'Send' and '-recipients' here my $msg = new Fax::Send -recipients => $to, -data => $data; -#10........... +#11........... }, 'space4.def' => { source => "space4", params => "def", - expect => <<'#11...........', + expect => <<'#12...........', # first prototype line will cause space between 'redirect' and '(' to close sub html::redirect($); #<-- temporary prototype; use html; print html::redirect('http://www.glob.com.au/'); -#11........... +#12........... }, 'space5.def' => { source => "space5", params => "def", - expect => <<'#12...........', + expect => <<'#13...........', # first prototype line commented out; space after 'redirect' remains #sub html::redirect($); #<-- temporary prototype; use html; print html::redirect ('http://www.glob.com.au/'); -#12........... +#13........... }, 'structure1.def' => { source => "structure1", params => "def", - expect => <<'#13...........', + expect => <<'#14...........', push @contents, $c->table( { -width => '100%' }, @@ -675,13 +672,13 @@ push @contents, ) ) ); -#13........... +#14........... }, 'style.def' => { source => "style", params => "def", - expect => <<'#14...........', + expect => <<'#15...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { my (@order) = ( @@ -727,13 +724,13 @@ sub arrange_topframe { } } -#14........... +#15........... }, 'style.style1' => { source => "style", params => "style1", - expect => <<'#15...........', + expect => <<'#16...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { my (@order) = ( @@ -772,13 +769,13 @@ sub arrange_topframe { } } -#15........... +#16........... }, 'style.style2' => { source => "style", params => "style2", - expect => <<'#16...........', + expect => <<'#17...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { my (@order) = ( @@ -820,13 +817,13 @@ sub arrange_topframe { } } -#16........... +#17........... }, 'style.style3' => { source => "style", params => "style3", - expect => <<'#17...........', + expect => <<'#18...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { my (@order) = ( @@ -864,13 +861,13 @@ sub arrange_topframe { } } ## end sub arrange_topframe -#17........... +#18........... }, 'style.style4' => { source => "style", params => "style4", - expect => <<'#18...........', + expect => <<'#19...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { my (@order) = ( @@ -912,13 +909,13 @@ sub arrange_topframe { } } -#18........... +#19........... }, 'style.style5' => { source => "style", params => "style5", - expect => <<'#19...........', + expect => <<'#20...........', # This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence sub arrange_topframe { @@ -964,41 +961,6 @@ sub arrange_topframe } } -#19........... - }, - - 'sub1.def' => { - source => "sub1", - params => "def", - expect => <<'#20...........', -my::doit(); -join::doit(); -for::doit(); -sub::doit(); -package::doit(); -__END__::doit(); -__DATA__::doit(); - -package my; -sub doit { print "Hello My\n"; } - -package join; -sub doit { print "Hello Join\n"; } - -package for; -sub doit { print "Hello for\n"; } - -package package; -sub doit { print "Hello package\n"; } - -package sub; -sub doit { print "Hello sub\n"; } - -package __END__; -sub doit { print "Hello __END__\n"; } - -package __DATA__; -sub doit { print "Hello __DATA__\n"; } #20........... }, }; @@ -1007,6 +969,10 @@ sub doit { print "Hello __DATA__\n"; } plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets11.t b/t/snippets11.t index a2e5c356..7ecf70d8 100644 --- a/t/snippets11.t +++ b/t/snippets11.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:35 2018 +# Sat Nov 10 08:48:23 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'tso' => "-tso", @@ -29,11 +29,29 @@ BEGIN { ---------- }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { + 'sub1' => <<'----------', +my::doit(); +join::doit(); +for::doit(); +sub::doit(); +package::doit(); +__END__::doit(); +__DATA__::doit(); +package my; +sub doit{print"Hello My\n";}package join; +sub doit{print"Hello Join\n";}package for; +sub doit{print"Hello for\n";}package package; +sub doit{print"Hello package\n";}package sub; +sub doit{print"Hello sub\n";}package __END__; +sub doit{print"Hello __END__\n";}package __DATA__; +sub doit{print"Hello __DATA__\n";} +---------- + 'sub2' => <<'----------', my $selector; @@ -180,29 +198,52 @@ sub Restore { This has the comma on the next line exception {Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)}, ---------- - - 'vtc1' => <<'----------', -@lol = ( - [ 'Dr. Watson', undef, '221b', 'Baker St.', - undef, 'London', 'NW1', undef, - 'England', undef - ], - [ 'Sam Gamgee', undef, undef, 'Bagshot Row', - undef, 'Hobbiton', undef, undef, - 'The Shire', undef], - ); ----------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { + 'sub1.def' => { + source => "sub1", + params => "def", + expect => <<'#1...........', +my::doit(); +join::doit(); +for::doit(); +sub::doit(); +package::doit(); +__END__::doit(); +__DATA__::doit(); + +package my; +sub doit { print "Hello My\n"; } + +package join; +sub doit { print "Hello Join\n"; } + +package for; +sub doit { print "Hello for\n"; } + +package package; +sub doit { print "Hello package\n"; } + +package sub; +sub doit { print "Hello sub\n"; } + +package __END__; +sub doit { print "Hello __END__\n"; } + +package __DATA__; +sub doit { print "Hello __DATA__\n"; } +#1........... + }, + 'sub2.def' => { source => "sub2", params => "def", - expect => <<'#1...........', + expect => <<'#2...........', my $selector; # leading atrribute separator: @@ -221,13 +262,13 @@ $a = $selector print "GOODBYE!\n"; }; $a->(); -#1........... +#2........... }, 'switch1.def' => { source => "switch1", params => "def", - expect => <<'#2...........', + expect => <<'#3...........', sub classify_digit($digit) { switch ($digit) { case 0 { return 'zero' } @@ -236,31 +277,31 @@ sub classify_digit($digit) { case /[A-F]/i { return 'hex' } } } -#2........... +#3........... }, 'syntax1.def' => { source => "syntax1", params => "def", - expect => <<'#3...........', + expect => <<'#4...........', # Caused trouble: print $x **2; -#3........... +#4........... }, 'syntax2.def' => { source => "syntax2", params => "def", - expect => <<'#4...........', + expect => <<'#5...........', # ? was taken as pattern my $case_flag = File::Spec->case_tolerant ? '(?i)' : ''; -#4........... +#5........... }, 'ternary1.def' => { source => "ternary1", params => "def", - expect => <<'#5...........', + expect => <<'#6...........', my $flags = ( $_ & 1 ) ? ( $_ & 4 ) @@ -268,13 +309,13 @@ my $flags = : $THRf_ZOMBIE : ( $_ & 4 ) ? $THRf_R_DETACHED : $THRf_R_JOINABLE; -#5........... +#6........... }, 'ternary2.def' => { source => "ternary2", params => "def", - expect => <<'#6...........', + expect => <<'#7...........', my $a = ($b) ? ($c) @@ -288,13 +329,13 @@ my $a = : $g2 : ($h) ? $h1 : $h2; -#6........... +#7........... }, 'tick1.def' => { source => "tick1", params => "def", - expect => <<'#7...........', + expect => <<'#8...........', sub a'this { $p'u'a = "mooo\n"; print $p::u::a; } a::this(); # print "mooo" print $p'u'a; # print "mooo" @@ -308,42 +349,42 @@ $a'that->(); # print "wwoo" $a'that = a'that(); $p::t::u = "booo\n"; $a'that->(); # print "booo" -#7........... +#8........... }, 'trim_quote.def' => { source => "trim_quote", params => "def", - expect => <<'#8...........', + expect => <<'#9...........', # space after quote will get trimmed push @m, ' all :: pure_all manifypods ' . $self->{NOECHO} . '$(NOOP) ' unless $self->{SKIPHASH}{'all'}; -#8........... +#9........... }, 'tso1.def' => { source => "tso1", params => "def", - expect => <<'#9...........', + expect => <<'#10...........', print 0 + '42 EUR'; # 42 -#9........... +#10........... }, 'tso1.tso' => { source => "tso1", params => "tso", - expect => <<'#10...........', + expect => <<'#11...........', print 0+ '42 EUR'; # 42 -#10........... +#11........... }, 'tutor.def' => { source => "tutor", params => "def", - expect => <<'#11...........', + expect => <<'#12...........', #!/usr/bin/perl $y = shift || 5; for $i ( 1 .. 10 ) { $l[$i] = "T"; $w[$i] = 999999; } @@ -381,24 +422,24 @@ while (1) { print $l[$i], "\t", $w[$i], "\r\n"; } } -#11........... +#12........... }, 'undoci1.def' => { source => "undoci1", params => "def", - expect => <<'#12...........', + expect => <<'#13...........', $rinfo{deleteStyle} = [ -fill => 'red', -stipple => '@' . Tk->findINC('demos/images/grey.25'), ]; -#12........... +#13........... }, 'use1.def' => { source => "use1", params => "def", - expect => <<'#13...........', + expect => <<'#14...........', # previously this caused an incorrect error message after '2.42' use lib "$Common::global::gInstallRoot/lib"; use CGI 2.42 qw(fatalsToBrowser); @@ -408,44 +449,44 @@ use RRDs 1.000101; use constant MODE => do { 0666 & ( 0777 & ~umask ) }; use IO::File (); -#13........... +#14........... }, 'use2.def' => { source => "use2", params => "def", - expect => <<'#14...........', + expect => <<'#15...........', # Keep the space before the '()' here: use Foo::Bar (); use Foo::Bar (); use Foo::Bar 1.0 (); use Foo::Bar qw(baz); use Foo::Bar 1.0 qw(baz); -#14........... +#15........... }, 'version1.def' => { source => "version1", params => "def", - expect => <<'#15...........', + expect => <<'#16...........', # VERSION statement unbroken, no semicolon added; our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r } -#15........... +#16........... }, 'version2.def' => { source => "version2", params => "def", - expect => <<'#16...........', + expect => <<'#17...........', # On one line so MakeMaker will see it. require Exporter; our $VERSION = $Exporter::VERSION; -#16........... +#17........... }, 'vert.def' => { source => "vert", params => "def", - expect => <<'#17...........', + expect => <<'#18...........', # if $w->vert is tokenized as type 'U' then the ? will start a quote # and an error will occur. sub vert { @@ -454,13 +495,13 @@ sub vert { sub Restore { $w->vert ? $w->delta_width(0) : $w->delta_height(0); } -#17........... +#18........... }, 'vmll.def' => { source => "vmll", params => "def", - expect => <<'#18...........', + expect => <<'#19...........', # perltidy -act=2 -vmll will leave these intact and greater than 80 columns # in length, which is what vmll does BEGIN { @@ -471,13 +512,13 @@ sub Restore { This has the comma on the next line exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }, -#18........... +#19........... }, 'vmll.vmll' => { source => "vmll", params => "vmll", - expect => <<'#19...........', + expect => <<'#20...........', # perltidy -act=2 -vmll will leave these intact and greater than 80 columns # in length, which is what vmll does BEGIN {is_deeply(\@init_metas_called, [1]) || diag(Dumper(\@init_metas_called))} @@ -485,25 +526,6 @@ sub Restore { This has the comma on the next line exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }, -#19........... - }, - - 'vtc1.def' => { - source => "vtc1", - params => "def", - expect => <<'#20...........', -@lol = ( - [ - 'Dr. Watson', undef, '221b', 'Baker St.', - undef, 'London', 'NW1', undef, - 'England', undef - ], - [ - 'Sam Gamgee', undef, undef, 'Bagshot Row', - undef, 'Hobbiton', undef, undef, - 'The Shire', undef - ], -); #20........... }, }; @@ -512,6 +534,10 @@ sub Restore { plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets12.t b/t/snippets12.t index 722f21ee..208720ef 100644 --- a/t/snippets12.t +++ b/t/snippets12.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:35 2018 +# Sat Nov 10 08:48:23 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'vtc' => <<'----------', @@ -27,9 +27,9 @@ BEGIN { 'wn' => "-wn", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'vtc1' => <<'----------', @@ -161,15 +161,34 @@ use_all_ok( ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { + 'vtc1.def' => { + source => "vtc1", + params => "def", + expect => <<'#1...........', +@lol = ( + [ + 'Dr. Watson', undef, '221b', 'Baker St.', + undef, 'London', 'NW1', undef, + 'England', undef + ], + [ + 'Sam Gamgee', undef, undef, 'Bagshot Row', + undef, 'Hobbiton', undef, undef, + 'The Shire', undef + ], +); +#1........... + }, + 'vtc1.vtc' => { source => "vtc1", params => "vtc", - expect => <<'#1...........', + expect => <<'#2...........', @lol = ( [ 'Dr. Watson', undef, '221b', 'Baker St.', @@ -179,13 +198,13 @@ use_all_ok( 'Sam Gamgee', undef, undef, 'Bagshot Row', undef, 'Hobbiton', undef, undef, 'The Shire', undef ], ); -#1........... +#2........... }, 'vtc2.def' => { source => "vtc2", params => "def", - expect => <<'#2...........', + expect => <<'#3...........', ok( $s->call( SOAP::Data->name('getStateName') @@ -193,46 +212,46 @@ use_all_ok( 1 )->result eq 'Alabama' ); -#2........... +#3........... }, 'vtc2.vtc' => { source => "vtc2", params => "vtc", - expect => <<'#3...........', + expect => <<'#4...........', ok( $s->call( SOAP::Data->name('getStateName') ->attr( { xmlns => 'urn:/My/Examples' } ), 1 )->result eq 'Alabama' ); -#3........... +#4........... }, 'vtc3.def' => { source => "vtc3", params => "def", - expect => <<'#4...........', + expect => <<'#5...........', $day_long = ( "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday" )[$wday]; -#4........... +#5........... }, 'vtc3.vtc' => { source => "vtc3", params => "vtc", - expect => <<'#5...........', + expect => <<'#6...........', $day_long = ( "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday" )[$wday]; -#5........... +#6........... }, 'vtc4.def' => { source => "vtc4", params => "def", - expect => <<'#6...........', + expect => <<'#7...........', my $bg_color = $im->colorAllocate( unpack( 'C3', @@ -249,13 +268,13 @@ my $bg_color = $im->colorAllocate( ) ) ); -#6........... +#7........... }, 'vtc4.vtc' => { source => "vtc4", params => "vtc", - expect => <<'#7...........', + expect => <<'#8...........', my $bg_color = $im->colorAllocate( unpack( 'C3', @@ -267,13 +286,13 @@ my $bg_color = $im->colorAllocate( length( $options_r->{'bg_color'} ) ? $options_r->{'bg_color'} : $MIDI::Opus::BG_color ) ) ) ) ); -#7........... +#8........... }, 'wn1.def' => { source => "wn1", params => "def", - expect => <<'#8...........', + expect => <<'#9...........', my $bg_color = $im->colorAllocate( unpack( 'C3', @@ -290,13 +309,13 @@ my $bg_color = $im->colorAllocate( ) ) ); -#8........... +#9........... }, 'wn1.wn' => { source => "wn1", params => "wn", - expect => <<'#9...........', + expect => <<'#10...........', my $bg_color = $im->colorAllocate( unpack( 'C3', pack( @@ -311,13 +330,13 @@ my $bg_color = $im->colorAllocate( ) ) ) ); -#9........... +#10........... }, 'wn2.def' => { source => "wn2", params => "def", - expect => <<'#10...........', + expect => <<'#11...........', if ( $PLATFORM eq 'aix' ) { skip_symbols( [ @@ -330,13 +349,13 @@ if ( $PLATFORM eq 'aix' ) { ] ); } -#10........... +#11........... }, 'wn2.wn' => { source => "wn2", params => "wn", - expect => <<'#11...........', + expect => <<'#12...........', if ( $PLATFORM eq 'aix' ) { skip_symbols( [ qw( Perl_dump_fds @@ -345,13 +364,13 @@ if ( $PLATFORM eq 'aix' ) { PL_sys_intern ) ] ); } -#11........... +#12........... }, 'wn3.def' => { source => "wn3", params => "def", - expect => <<'#12...........', + expect => <<'#13...........', deferred->resolve->then( sub { push @out, 'Resolve'; @@ -363,13 +382,13 @@ deferred->resolve->then( push @out, @_; } ); -#12........... +#13........... }, 'wn3.wn' => { source => "wn3", params => "wn", - expect => <<'#13...........', + expect => <<'#14...........', deferred->resolve->then( sub { push @out, 'Resolve'; return $then; @@ -377,13 +396,13 @@ deferred->resolve->then( sub { push @out, 'Reject'; push @out, @_; } ); -#13........... +#14........... }, 'wn4.def' => { source => "wn4", params => "def", - expect => <<'#14...........', + expect => <<'#15...........', { { { @@ -397,13 +416,13 @@ deferred->resolve->then( sub { } } } -#14........... +#15........... }, 'wn4.wn' => { source => "wn4", params => "wn", - expect => <<'#15...........', + expect => <<'#16...........', { { { # Orignal formatting looks nice but would be hard to duplicate @@ -413,13 +432,13 @@ deferred->resolve->then( sub { ? %{ $G->{Attr}->{E}->{$u}->{$v} } : (); } } } -#15........... +#16........... }, 'wn5.def' => { source => "wn5", params => "def", - expect => <<'#16...........', + expect => <<'#17...........', # qw weld with -wn use_all_ok( qw{ @@ -433,13 +452,13 @@ use_all_ok( PPI::Cache } ); -#16........... +#17........... }, 'wn5.wn' => { source => "wn5", params => "wn", - expect => <<'#17...........', + expect => <<'#18...........', # qw weld with -wn use_all_ok( qw{ PPI @@ -451,13 +470,13 @@ use_all_ok( qw{ PPI::Util PPI::Cache } ); -#17........... +#18........... }, 'wn6.def' => { source => "wn6", params => "def", - expect => <<'#18...........', + expect => <<'#19...........', # illustration of some do-not-weld rules # do not weld a two-line function call @@ -489,13 +508,13 @@ use_all_ok( qw{ $_[0]->(); } ); -#18........... +#19........... }, 'wn6.wn' => { source => "wn6", params => "wn", - expect => <<'#19...........', + expect => <<'#20...........', # illustration of some do-not-weld rules # do not weld a two-line function call @@ -521,7 +540,7 @@ use_all_ok( qw{ push @tracelog => 'around 1'; $_[0]->(); } ); -#19........... +#20........... }, }; @@ -529,6 +548,10 @@ use_all_ok( qw{ plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets2.t b/t/snippets2.t index 70b066c4..643312bb 100644 --- a/t/snippets2.t +++ b/t/snippets2.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'bar' => "-bar", 'boc' => "-boc", @@ -24,9 +24,9 @@ BEGIN { 'def' => "", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'angle' => <<'----------', @@ -180,9 +180,9 @@ elsif($value[0] =~ /^(b)$/ or $value[0] =~ /^(dbfile)$/) ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'angle.def' => { @@ -480,6 +480,10 @@ else { plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets3.t b/t/snippets3.t index f3bcc92d..555521d2 100644 --- a/t/snippets3.t +++ b/t/snippets3.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'ce_wn' => <<'----------', -cuddled-blocks @@ -58,9 +58,9 @@ BEGIN { 'fabrice_bug' => "-bt=0", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'ce_wn1' => <<'----------', @@ -224,9 +224,9 @@ $_, $val ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'ce_wn1.ce_wn' => { @@ -801,6 +801,10 @@ $_, $val plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets4.t b/t/snippets4.t index 60989670..f283a601 100644 --- a/t/snippets4.t +++ b/t/snippets4.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'gnu' => "-gnu", @@ -27,9 +27,9 @@ BEGIN { 'iscl' => "-iscl", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'gnu1' => <<'----------', @@ -152,9 +152,9 @@ print(" MiXeD"),redo LOOP if/\G[A-Za-z]+\b[,.;]?\s*/gc;print( ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'gnu1.gnu' => { @@ -503,6 +503,10 @@ LOOP: { plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets5.t b/t/snippets5.t index e2dab826..adfeb6b3 100644 --- a/t/snippets5.t +++ b/t/snippets5.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'lp' => "-lp", @@ -25,9 +25,9 @@ BEGIN { 'nothing' => "", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'list1' => <<'----------', @@ -306,9 +306,9 @@ return $pdl->slice( ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'list1.def' => { @@ -902,6 +902,10 @@ return $pdl->slice( plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets6.t b/t/snippets6.t index 8238c502..bd517ad6 100644 --- a/t/snippets6.t +++ b/t/snippets6.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'otr' => <<'----------', @@ -27,9 +27,9 @@ BEGIN { 'pbp' => "-pbp -nst -nse", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'otr1' => <<'----------', @@ -139,9 +139,9 @@ state $b //= ccc(); ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'otr1.otr' => { @@ -392,6 +392,10 @@ state $b //= ccc(); plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets7.t b/t/snippets7.t index 4a6e4092..1be22359 100644 --- a/t/snippets7.t +++ b/t/snippets7.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:22 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'rt107832' => <<'----------', @@ -36,9 +36,9 @@ BEGIN { 'rt119970' => "-wn", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'rt102451' => <<'----------', @@ -199,9 +199,9 @@ get('http://mojolicious.org')->then( ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'rt102451.def' => { @@ -496,6 +496,10 @@ get('http://mojolicious.org')->then( plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets8.t b/t/snippets8.t index 5c23ffeb..936bc771 100644 --- a/t/snippets8.t +++ b/t/snippets8.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:23 2018 # To locate test #13 for example, search for the string '#13' @@ -14,9 +14,9 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", 'rt123749' => "-wn", @@ -32,12 +32,11 @@ BEGIN { 'rt50702' => <<'----------', -wbb='=' ---------- - 'rt70747' => "-i=2", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { 'rt123749' => <<'----------', @@ -108,6 +107,10 @@ my $t = ' '; ---------- + 'rt126965' => <<'----------', +my $restrict_customer = shift ? 1 : 0; +---------- + 'rt15735' => <<'----------', my $user_prefs = $ref_type eq 'SCALAR' ? _load_from_string( $profile ) : $ref_type eq 'ARRAY' ? _load_from_array( $profile ) : $ref_type eq 'HASH' ? _load_from_hash( $profile ) : _load_from_file( $profile ); ---------- @@ -158,9 +161,9 @@ coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { 'rt123749.rt123749' => { @@ -288,44 +291,52 @@ my $t = ' #9........... }, + 'rt126965.def' => { + source => "rt126965", + params => "def", + expect => <<'#10...........', +my $restrict_customer = shift ? 1 : 0; +#10........... + }, + 'rt15735.def' => { source => "rt15735", params => "def", - expect => <<'#10...........', + expect => <<'#11...........', my $user_prefs = $ref_type eq 'SCALAR' ? _load_from_string($profile) : $ref_type eq 'ARRAY' ? _load_from_array($profile) : $ref_type eq 'HASH' ? _load_from_hash($profile) : _load_from_file($profile); -#10........... +#11........... }, 'rt18318.def' => { source => "rt18318", params => "def", - expect => <<'#11...........', + expect => <<'#12...........', # Class::Std attribute list # The token type of the first colon is 'A' so use -nwrs='A' to avoid space # after it my %rank_of : ATTR( :init_arg :get :set ); -#11........... +#12........... }, 'rt18318.rt18318' => { source => "rt18318", params => "rt18318", - expect => <<'#12...........', + expect => <<'#13...........', # Class::Std attribute list # The token type of the first colon is 'A' so use -nwrs='A' to avoid space # after it my %rank_of :ATTR( :init_arg :get :set ); -#12........... +#13........... }, 'rt27000.def' => { source => "rt27000", params => "def", - expect => <<'#13...........', + expect => <<'#14...........', print add( 3, 4 ), "\n"; print add( 4, 3 ), "\n"; @@ -335,29 +346,29 @@ sub add { die "$term1 > $term2" if $term1 > $term2; return $term1 + $term2; } -#13........... +#14........... }, 'rt31741.def' => { source => "rt31741", params => "def", - expect => <<'#14...........', + expect => <<'#15...........', $msg //= 'World'; -#14........... +#15........... }, 'rt49289.def' => { source => "rt49289", params => "def", - expect => <<'#15...........', + expect => <<'#16...........', use constant qw{ DEBUG 0 }; -#15........... +#16........... }, 'rt50702.def' => { source => "rt50702", params => "def", - expect => <<'#16...........', + expect => <<'#17...........', if (1) { my $uid = $ENV{'ORIG_LOGNAME'} @@ -372,13 +383,13 @@ if (2) { || $ENV{'REMOTE_USER'} || 'foobar' ); } -#16........... +#17........... }, 'rt50702.rt50702' => { source => "rt50702", params => "rt50702", - expect => <<'#17...........', + expect => <<'#18...........', if (1) { my $uid = $ENV{'ORIG_LOGNAME'} @@ -393,21 +404,21 @@ if (2) { || $ENV{'REMOTE_USER'} || 'foobar' ); } -#17........... +#18........... }, 'rt68870.def' => { source => "rt68870", params => "def", - expect => <<'#18...........', + expect => <<'#19...........', s///r; -#18........... +#19........... }, 'rt70747.def' => { source => "rt70747", params => "def", - expect => <<'#19...........', + expect => <<'#20...........', coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { [ map { @@ -417,22 +428,6 @@ coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { } @$_; ] }; -#19........... - }, - - 'rt70747.rt70747' => { - source => "rt70747", - params => "rt70747", - expect => <<'#20...........', -coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { - [ - map { - my $g = $_->as_hash; - $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; - $g; - } @$_; - ] -}; #20........... }, }; @@ -441,6 +436,10 @@ coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; diff --git a/t/snippets9.t b/t/snippets9.t index 1e17e633..be0aeb6c 100644 --- a/t/snippets9.t +++ b/t/snippets9.t @@ -1,6 +1,6 @@ # **This script was automatically generated** # Created with: ./make_t.pl -# Thu Jun 14 13:29:34 2018 +# Sat Nov 10 08:48:23 2018 # To locate test #13 for example, search for the string '#13' @@ -14,11 +14,12 @@ my $rtests; BEGIN { - ##################################### - # SECTION 1: Parameter combinations # - ##################################### + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### $rparams = { 'def' => "", + 'rt70747' => "-i=2", 'rt81852' => <<'----------', -wn -act=2 @@ -26,11 +27,21 @@ BEGIN { 'rt98902' => "-boc", }; - ###################### - # SECTION 2: Sources # - ###################### + ############################ + # BEGIN SECTION 2: Sources # + ############################ $rsources = { + 'rt70747' => <<'----------', +coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { + [ map { + my $g = $_->as_hash; + $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; $g; + } @$_; + ] +}; +---------- + 'rt74856' => <<'----------', { my $foo = '1'; @@ -166,23 +177,34 @@ padding => ( ' ' x $_ ), 'rt99961' => <<'----------', %thing = %{ print qq[blah1\n]; $b; }; ----------- - - 'scl' => <<'----------', - # try -scl=12 to see '$returns' joined with the previous line - $format = "format STDOUT =\n" . &format_line('Function: @') . '$name' . "\n" . &format_line('Arguments: @') . '$args' . "\n" . &format_line('Returns: @') . '$returns' . "\n" . &format_line(' ~~ ^') . '$desc' . "\n.\n"; ---------- }; - ############################## - # SECTION 3: Expected output # - ############################## + #################################### + # BEGIN SECTION 3: Expected output # + #################################### $rtests = { + 'rt70747.rt70747' => { + source => "rt70747", + params => "rt70747", + expect => <<'#1...........', +coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via { + [ + map { + my $g = $_->as_hash; + $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; + $g; + } @$_; + ] +}; +#1........... + }, + 'rt74856.def' => { source => "rt74856", params => "def", - expect => <<'#1...........', + expect => <<'#2...........', { my $foo = '1'; #<<< @@ -192,30 +214,30 @@ my $bar = (test()) #>>> my $baz = 'something else'; } -#1........... +#2........... }, 'rt78156.def' => { source => "rt78156", params => "def", - expect => <<'#2...........', + expect => <<'#3...........', package Some::Class 2.012; -#2........... +#3........... }, 'rt78764.def' => { source => "rt78764", params => "def", - expect => <<'#3...........', + expect => <<'#4...........', qr/3/ ~~ ['1234'] ? 1 : 0; map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a; -#3........... +#4........... }, 'rt79813.def' => { source => "rt79813", params => "def", - expect => <<'#4...........', + expect => <<'#5...........', my %hash = ( a => { bbbbbbbbb => { @@ -223,113 +245,113 @@ my %hash = ( }, }, ); -#4........... +#5........... }, 'rt79947.def' => { source => "rt79947", params => "def", - expect => <<'#5...........', + expect => <<'#6...........', try { croak "An Error!"; } catch ($error) { print STDERR $error . "\n"; } -#5........... +#6........... }, 'rt80645.def' => { source => "rt80645", params => "def", - expect => <<'#6...........', + expect => <<'#7...........', BEGIN { $^W = 1; } use warnings; use strict; @$ = 'test'; print $#{$}; -#6........... +#7........... }, 'rt81852.def' => { source => "rt81852", params => "def", - expect => <<'#7...........', + expect => <<'#8...........', do { { next if ( $n % 2 ); print $n, "\n"; } } while ( $n++ < 10 ); -#7........... +#8........... }, 'rt81852.rt81852' => { source => "rt81852", params => "rt81852", - expect => <<'#8...........', + expect => <<'#9...........', do {{ next if ($n % 2); print $n, "\n"; }} while ($n++ < 10); -#8........... +#9........... }, 'rt81854.def' => { source => "rt81854", params => "def", - expect => <<'#9...........', + expect => <<'#10...........', return "this is a descriptive error message" if $res->is_error or not length $data; -#9........... +#10........... }, 'rt87502.def' => { source => "rt87502", params => "def", - expect => <<'#10...........', + expect => <<'#11...........', if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) { # CODE } -#10........... +#11........... }, 'rt93197.def' => { source => "rt93197", params => "def", - expect => <<'#11...........', + expect => <<'#12...........', $to = $to->{$_} ||= {} for @key; if (1) { 2; } else { 3; } -#11........... +#12........... }, 'rt94338.def' => { source => "rt94338", params => "def", - expect => <<'#12...........', + expect => <<'#13...........', # for-loop in a parenthesized block-map triggered an error message map( { foreach my $item ( '0', '1' ) { print $item; } } qw(a b c) ); -#12........... +#13........... }, 'rt95419.def' => { source => "rt95419", params => "def", - expect => <<'#13...........', + expect => <<'#14...........', case "blah" => sub { { a => 1 } }; -#13........... +#14........... }, 'rt95708.def' => { source => "rt95708", params => "def", - expect => <<'#14...........', + expect => <<'#15...........', use strict; use JSON; my $ref = { @@ -344,26 +366,26 @@ my $json2 = encode_json + { when => time(), message => 'abc' }; -#14........... +#15........... }, 'rt96021.def' => { source => "rt96021", params => "def", - expect => <<'#15...........', + expect => <<'#16...........', $a->@*; $a->**; $a->$*; $a->&*; $a->%*; $a->$#* -#15........... +#16........... }, 'rt96101.def' => { source => "rt96101", params => "def", - expect => <<'#16...........', + expect => <<'#17...........', # Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine # references inside subroutine execution. @@ -384,13 +406,13 @@ sub startup { ); } -#16........... +#17........... }, 'rt98902.def' => { source => "rt98902", params => "def", - expect => <<'#17...........', + expect => <<'#18...........', my %foo = ( alpha => 1, beta => 2, @@ -400,13 +422,13 @@ my %foo = ( my @bar = map { { number => $_, character => chr $_, padding => ( ' ' x $_ ), } } ( 0 .. 32 ); -#17........... +#18........... }, 'rt98902.rt98902' => { source => "rt98902", params => "rt98902", - expect => <<'#18...........', + expect => <<'#19...........', my %foo = ( alpha => 1, beta => 2, gamma => 3, @@ -419,32 +441,17 @@ my @bar = map { padding => ( ' ' x $_ ), } } ( 0 .. 32 ); -#18........... +#19........... }, 'rt99961.def' => { source => "rt99961", params => "def", - expect => <<'#19...........', + expect => <<'#20...........', %thing = %{ print qq[blah1\n]; $b; }; -#19........... - }, - - 'scl.def' => { - source => "scl", - params => "def", - expect => <<'#20...........', - # try -scl=12 to see '$returns' joined with the previous line - $format = - "format STDOUT =\n" - . &format_line('Function: @') . '$name' . "\n" - . &format_line('Arguments: @') . '$args' . "\n" - . &format_line('Returns: @') - . '$returns' . "\n" - . &format_line(' ~~ ^') . '$desc' . "\n.\n"; #20........... }, }; @@ -453,6 +460,10 @@ my @bar = map { plan tests => $ntests; } +############### +# EXECUTE TESTS +############### + foreach my $key ( sort keys %{$rtests} ) { my $output; my $sname = $rtests->{$key}->{source}; -- 2.39.5