#15 ndsm1.ndsm
#16 rt131288.def
#17 rt130394.rt130394
+#18 git18.def
+#19 here2.def
# 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;
# git#16, two equality lines with fat commas on the right
my $Package = $Self->RepositoryGet( %Param, Result => 'SCALAR' );
my %Structure = $Self->PackageParse( String => $Package );
+----------
+
+ 'git18' => <<'----------',
+# parsing stuff like 'x17' before fat comma
+my %bb = (
+ 123x18 => '123x18',
+ 123 x19 => '123 x19',
+ 123x 20 => '123x 20',
+ 2 x 7 => '2 x 7',
+ x40 => 'x40',
+ 'd' x17 => "'d' x17",
+ c x17 => 'c x17',
+);
+foreach my $key ( keys %bb ) {
+ print "key='$key' => $bb{$key}\n";
+}
+----------
+
+ 'here2' => <<'----------',
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
----------
'multiple_equals' => <<'----------',
sub get_Val () { }
sub Get_val () { }
+my $sub1=sub () { };
+my $sub2=sub () { };
----------
};
sub get_Val () { }
sub Get_val () { }
+my $sub1 = sub () { };
+my $sub2 = sub () { };
#1...........
},
sub get_Val () { }
sub Get_val () { }
+my $sub1 = sub () { };
+my $sub2 = sub () { };
#2...........
},
$query_all = $opt_A if $opt_A;
# not aligning multiple '='s here
-$start = $end = $len = $ismut = $number = $allele_ori = $allele_mut =
- $proof = $xxxxreg = $reg = $dist = '';
+$start = $end = $len = $ismut = $number = $allele_ori = $allele_mut = $proof =
+ $xxxxreg = $reg = $dist = '';
#6...........
},
# not a good alignment
sub head {
match_on_type @_ => Null => sub { die "Cannot get head of Null" },
- ArrayRef => sub { $_->[0] };
+ ArrayRef => sub { $_->[0] };
}
#10...........
$factorial = sub { reduce { $a * $b } 1 .. 11 };
#17...........
},
+
+ 'git18.def' => {
+ source => "git18",
+ params => "def",
+ expect => <<'#18...........',
+# parsing stuff like 'x17' before fat comma
+my %bb = (
+ 123 x 18 => '123x18',
+ 123 x 19 => '123 x19',
+ 123 x 20 => '123x 20',
+ 2 x 7 => '2 x 7',
+ x40 => 'x40',
+ 'd' x 17 => "'d' x17",
+ c x17 => 'c x17',
+);
+foreach my $key ( keys %bb ) {
+ print "key='$key' => $bb{$key}\n";
+}
+#18...........
+ },
+
+ 'here2.def' => {
+ source => "here2",
+ params => "def",
+ expect => <<'#19...........',
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
+#19...........
+ },
};
my $ntests = 0 + 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 "<<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";
+ }
+ }
}
}