#7 break_old_methods.def
#8 bom1.bom
#9 bom1.def
+#10 align28.def
+#11 align29.def
+#12 align30.def
+#13 git09.def
+#14 git09.git09
+#15 git14.def
+#16 sal.def
+#17 sal.sal
+#18 spp.def
+#19 spp.spp0
# 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;
'bom' => "-bom -wn",
'break_old_methods' => "--break-at-old-method-breakpoints",
'def' => "",
+ 'git09' => "-ce -cbl=map,sort,grep",
'gnu' => "-gnu",
'olbs0' => "-olbs=0",
'olbs2' => "-olbs=2",
+ 'sal' => <<'----------',
+-sal='method fun'
+----------
+ 'spp0' => "-spp=0",
};
############################
############################
$rsources = {
+ 'align28' => <<'----------',
+# tests for 'delete_needless_parens'
+# align all '='s; but do not align parens
+my $w = $columns * $cell_w + ( $columns + 1 ) * $border;
+my $h = $rows * $cell_h + ( $rows + 1 ) * $border;
+my $img = new Gimp::Image( $w, $h, RGB );
+
+# keep leading paren after if as alignment for padding
+eval {
+ if ( $a->{'abc'} eq 'ABC' ) { no_op(23) }
+ else { no_op(42) }
+};
+----------
+
+ 'align29' => <<'----------',
+# alignment with lots of commas
+is( floor(1.23441242), 1, "Basic floor(1.23441242) test" );
+is( fmod( 3.5, 2.0 ), 1.5, "Basic fmod(3.5, 2.0) test" );
+is( join( " ", frexp(1) ), "0.5 1", "Basic frexp(1) test" );
+is( ldexp( 0, 1 ), 0, "Basic ldexp(0,1) test" );
+is( log10(1), 0, "Basic log10(1) test" );
+----------
+
+ 'align30' => <<'----------',
+# commas on lhs align, commas on rhs do not (different subs)
+($x,$y,$z)=spherical_to_cartesian($rho,$theta,$phi);
+($rho_c,$theta,$z)=spherical_to_cylindrical($rho_s,$theta,$phi);
+( $r2, $theta2, $z2 )=cartesian_to_cylindrical( $x1, $y1, $z1 );
+
+# two-line if/elsif gets aligned
+if($i==$depth){$_++;}
+elsif($i>$depth){$_=0;}
+----------
+
'bom1' => <<'----------',
# keep cuddled call chain with -bom
return Mojo::Promise->resolve(
->as_query;
----------
+ 'git09' => <<'----------',
+# no one-line block for first map with -ce -cbl=map,sort,grep
+@sorted = map {
+ $_->[0]
+} sort {
+ $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
+} map {
+ [$_, length($_)]
+} @unsorted;
+----------
+
+ 'git14' => <<'----------',
+# git#14; do not break at trailing 'or'
+$second = {
+ key1 => 'aaa',
+ key2 => 'bbb',
+} if $flag1 or $flag2;
+----------
+
'gnu5' => <<'----------',
# side comments limit gnu type formatting with l=80; note extra comma
push @tests, [
for $x ( 1, 2 ) { s/(.*)/+$1/; }
for $x ( 1, 2 ) { s/(.*)/+$1/; } # side comment
if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
+----------
+
+ 'sal' => <<'----------',
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
+----------
+
+ 'spp' => <<'----------',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+my $sub1=sub () { };
+my $sub2=sub () { };
----------
'wngnu1' => <<'----------',
expect => <<'#1...........',
# side comments limit gnu type formatting with l=80; note extra comma
push @tests, [
- "Lowest code point requiring 13 bytes to represent", # 2**36
- "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
- ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
+ "Lowest code point requiring 13 bytes to represent", # 2**36
+ "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+ ($::is64bit) ? 0x1000000000 : -1, # overflows on 32bit
],
;
#1...........
params => "def",
expect => <<'#3...........',
for $x ( 1, 2 ) { s/(.*)/+$1/ }
-for $x ( 1, 2 ) { s/(.*)/+$1/ } # side comment
+for $x ( 1, 2 ) { s/(.*)/+$1/ } # side comment
if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
for $x ( 1, 2 ) { s/(.*)/+$1/; }
for $x ( 1, 2 ) { s/(.*)/+$1/; } # side comment
);
#9...........
},
+
+ 'align28.def' => {
+ source => "align28",
+ params => "def",
+ expect => <<'#10...........',
+# tests for 'delete_needless_parens'
+# align all '='s; but do not align parens
+my $w = $columns * $cell_w + ( $columns + 1 ) * $border;
+my $h = $rows * $cell_h + ( $rows + 1 ) * $border;
+my $img = new Gimp::Image( $w, $h, RGB );
+
+# keep leading paren after if as alignment for padding
+eval {
+ if ( $a->{'abc'} eq 'ABC' ) { no_op(23) }
+ else { no_op(42) }
+};
+#10...........
+ },
+
+ 'align29.def' => {
+ source => "align29",
+ params => "def",
+ expect => <<'#11...........',
+# alignment with lots of commas
+is( floor(1.23441242), 1, "Basic floor(1.23441242) test" );
+is( fmod( 3.5, 2.0 ), 1.5, "Basic fmod(3.5, 2.0) test" );
+is( join( " ", frexp(1) ), "0.5 1", "Basic frexp(1) test" );
+is( ldexp( 0, 1 ), 0, "Basic ldexp(0,1) test" );
+is( log10(1), 0, "Basic log10(1) test" );
+#11...........
+ },
+
+ 'align30.def' => {
+ source => "align30",
+ params => "def",
+ expect => <<'#12...........',
+# commas on lhs align, commas on rhs do not (different subs)
+( $x, $y, $z ) = spherical_to_cartesian( $rho, $theta, $phi );
+( $rho_c, $theta, $z ) = spherical_to_cylindrical( $rho_s, $theta, $phi );
+( $r2, $theta2, $z2 ) = cartesian_to_cylindrical( $x1, $y1, $z1 );
+
+# two-line if/elsif gets aligned
+if ( $i == $depth ) { $_++; }
+elsif ( $i > $depth ) { $_ = 0; }
+#12...........
+ },
+
+ 'git09.def' => {
+ source => "git09",
+ params => "def",
+ expect => <<'#13...........',
+# no one-line block for first map with -ce -cbl=map,sort,grep
+@sorted =
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
+ map { [ $_, length($_) ] } @unsorted;
+#13...........
+ },
+
+ 'git09.git09' => {
+ source => "git09",
+ params => "git09",
+ expect => <<'#14...........',
+# no one-line block for first map with -ce -cbl=map,sort,grep
+@sorted = map {
+ $_->[0]
+ } sort {
+ $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
+ } map {
+ [ $_, length($_) ]
+ } @unsorted;
+#14...........
+ },
+
+ 'git14.def' => {
+ source => "git14",
+ params => "def",
+ expect => <<'#15...........',
+# git#14; do not break at trailing 'or'
+$second = {
+ key1 => 'aaa',
+ key2 => 'bbb',
+} if $flag1 or $flag2;
+#15...........
+ },
+
+ 'sal.def' => {
+ source => "sal",
+ params => "def",
+ expect => <<'#16...........',
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value() {
+
+}
+#16...........
+ },
+
+ 'sal.sal' => {
+ source => "sal",
+ params => "sal",
+ expect => <<'#17...........',
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
+#17...........
+ },
+
+ 'spp.def' => {
+ source => "spp",
+ params => "def",
+ expect => <<'#18...........',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+my $sub1 = sub () { };
+my $sub2 = sub () { };
+#18...........
+ },
+
+ 'spp.spp0' => {
+ source => "spp",
+ params => "spp0",
+ expect => <<'#19...........',
+sub get_val() { }
+
+sub get_Val() { }
+
+sub Get_val() { }
+my $sub1 = sub() { };
+my $sub2 = sub() { };
+#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";
+ }
+ }
}
}
projects / perltidy.git / blobdiff