X-Git-Url: https://git.donarmstrong.com/perltidy.git?a=blobdiff_plain;f=t%2Fsnippets12.t;h=76958dace1ae69c94f27d4cbe445e392e86c8469;hb=57d829ae0e2c75828f8ecc9c7139579350927dbc;hp=9b0332a17007559a70c36884fad3796d0b1c7864;hpb=7f27e55dce5925b2bbe8fcfca64f385e917a52be;p=perltidy.git diff --git a/t/snippets12.t b/t/snippets12.t index 9b0332a..76958da 100644 --- a/t/snippets12.t +++ b/t/snippets12.t @@ -25,7 +25,7 @@ # To locate test #13 you can search for its name or the string '#13' use strict; -use Test; +use Test::More; use Carp; use Perl::Tidy; my $rparams; @@ -166,8 +166,9 @@ use_all_ok( my $compass = uc( opposite_direction( line_to_canvas_direction( @{ $coords[0] }, @{ $coords[1] } ) ) ); - # do not weld to a one-line block because the function could get separated - # from its opening paren + # OLD: do not weld to a one-line block because the function could + # get separated from its opening paren. + # NEW: (30-jan-2021): keep one-line block together for stability $_[0]->code_handler ( sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } ); @@ -365,7 +366,7 @@ if ( $PLATFORM eq 'aix' ) { Perl_ErrorNo Perl_GetVars PL_sys_intern - ) + ) ] ); } @@ -470,7 +471,7 @@ use_all_ok( PPI::Normal PPI::Util PPI::Cache - } + } ); #17........... }, @@ -512,8 +513,9 @@ use_all_ok( qw{ ) ); - # do not weld to a one-line block because the function could get separated - # from its opening paren + # OLD: do not weld to a one-line block because the function could + # get separated from its opening paren. + # NEW: (30-jan-2021): keep one-line block together for stability $_[0]->code_handler( sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } ); @@ -546,8 +548,9 @@ use_all_ok( qw{ @{ $coords[0] }, @{ $coords[1] } ) ) ); - # do not weld to a one-line block because the function could get separated - # from its opening paren + # OLD: do not weld to a one-line block because the function could + # get separated from its opening paren. + # NEW: (30-jan-2021): keep one-line block together for stability $_[0]->code_handler( sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } ); @@ -587,32 +590,39 @@ foreach my $key ( sort keys %{$rtests} ) { perltidyrc => \$params, argv => '', # for safety; hide any ARGV from perltidy stderr => \$stderr_string, - errorfile => \$errorfile_string, # not used when -se flag is set + errorfile => \$errorfile_string, # not used when -se flag is set ); if ( $err || $stderr_string || $errorfile_string ) { + print STDERR "Error output received for test '$key'\n"; if ($err) { - print STDERR -"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + print STDERR "An error flag '$err' was returned\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 ); + if ( !is( $output, $expect, $key ) ) { + my $leno = length($output); + my $lene = length($expect); + if ( $leno == $lene ) { + print STDERR +"#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n"; + } + else { + print STDERR +"#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n"; + } + } } }