X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=t%2Fsnippets14.t;h=aca0d3653761c02c75f8898e72d99301d1acd1c0;hb=57d829ae0e2c75828f8ecc9c7139579350927dbc;hp=b98162d95a9a4b8b004a1b21e8c8ba786367d661;hpb=7f27e55dce5925b2bbe8fcfca64f385e917a52be;p=perltidy.git diff --git a/t/snippets14.t b/t/snippets14.t index b98162d..aca0d36 100644 --- a/t/snippets14.t +++ b/t/snippets14.t @@ -24,7 +24,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; @@ -554,12 +554,12 @@ require Cwd; ( my $boot = $self->{NAME} ) =~ s/:/_/g; doit( sub { @E::ISA = qw/F/ }, - sub { @E::ISA = qw/D/; @C::ISA = qw/F/ }, - sub { @C::ISA = qw//; @A::ISA = qw/K/ }, - sub { @A::ISA = qw//; @J::ISA = qw/F K/ }, - sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ }, - sub { @H::ISA = qw/G/; @B::ISA = qw/B/ }, - sub { @B::ISA = qw//; @K::ISA = qw/K J I/ }, + sub { @E::ISA = qw/D/; @C::ISA = qw/F/ }, + sub { @C::ISA = qw//; @A::ISA = qw/K/ }, + sub { @A::ISA = qw//; @J::ISA = qw/F K/ }, + sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ }, + sub { @H::ISA = qw/G/; @B::ISA = qw/B/ }, + sub { @B::ISA = qw//; @K::ISA = qw/K J I/ }, sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ }, return; ); @@ -567,7 +567,7 @@ my %extractor_for = ( quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ], regex => [ $ws, $pod_or_DATA, $id, $exql ], string => [ $ws, $pod_or_DATA, $id, $exql ], - code => [ + code => [ $ws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], @@ -576,7 +576,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], @@ -673,12 +673,12 @@ require Cwd; ( my $boot = $self->{NAME} ) =~ s/:/_/g; doit( sub { @E::ISA = qw/F/ }, - sub { @E::ISA = qw/D/; @C::ISA = qw/F/ }, - sub { @C::ISA = qw//; @A::ISA = qw/K/ }, - sub { @A::ISA = qw//; @J::ISA = qw/F K/ }, - sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ }, - sub { @H::ISA = qw/G/; @B::ISA = qw/B/ }, - sub { @B::ISA = qw//; @K::ISA = qw/K J I/ }, + sub { @E::ISA = qw/D/; @C::ISA = qw/F/ }, + sub { @C::ISA = qw//; @A::ISA = qw/K/ }, + sub { @A::ISA = qw//; @J::ISA = qw/F K/ }, + sub { @J::ISA = qw/F/; @H::ISA = qw/K G/ }, + sub { @H::ISA = qw/G/; @B::ISA = qw/B/ }, + sub { @B::ISA = qw//; @K::ISA = qw/K J I/ }, sub { @K::ISA = qw/J I/; @D::ISA = qw/A H B C/ }, return; ); @@ -686,7 +686,7 @@ my %extractor_for = ( quotelike => [ $ws, $variable, $id, { MATCH => \&extract_quotelike } ], regex => [ $ws, $pod_or_DATA, $id, $exql ], string => [ $ws, $pod_or_DATA, $id, $exql ], - code => [ + code => [ $ws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], @@ -695,7 +695,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], @@ -760,7 +760,7 @@ use Blast::IPS::MathUtils qw( set_interpolation_points table_row_interpolation two_point_interpolation - ); # with -kgb, break around isolated 'local' below +); # with -kgb, break around isolated 'local' below use Text::Warp(); local ($delta2print) = ( defined $size ) ? int( $size / 50 ) : $defaultdelta2print; @@ -784,7 +784,7 @@ use Blast::IPS::MathUtils qw( set_interpolation_points table_row_interpolation two_point_interpolation - ); # with -kgb, break around isolated 'local' below +); # with -kgb, break around isolated 'local' below use Text::Warp(); local ($delta2print) = @@ -1054,32 +1054,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"; + } + } } }