1 # Created with: ./make_t.pl
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
41 'git10' => "-wn -ce -cbl=sort,map,grep",
43 'rt130394' => "-olbn=1",
49 ############################
50 # BEGIN SECTION 2: Sources #
51 ############################
54 'align31' => <<'----------',
55 # do not align the commas
57 ListBox => origin => [ 270, 160 ],
62 'almost1' => <<'----------',
63 # not a good alignment
64 my $realname = catfile( $dir, $file );
65 my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
68 'almost2' => <<'----------',
69 # not a good alignment
70 my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
71 my $incname = $indname . ( $indtot > 1 ? $indno : "" );
74 'almost3' => <<'----------',
75 # not a good alignment
77 match_on_type @_ => Null => sub { die "Cannot get head of Null" },
78 ArrayRef => sub { $_->[0] };
83 'git10' => <<'----------',
84 # perltidy -wn -ce -cbl=sort,map,grep
88 $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
94 'git16' => <<'----------',
95 # git#16, two equality lines with fat commas on the right
96 my $Package = $Self->RepositoryGet( %Param, Result => 'SCALAR' );
97 my %Structure = $Self->PackageParse( String => $Package );
100 'git18' => <<'----------',
101 # parsing stuff like 'x17' before fat comma
104 123 x19 => '123 x19',
105 123x 20 => '123x 20',
108 'd' x17 => "'d' x17",
111 foreach my $key ( keys %bb ) {
112 print "key='$key' => $bb{$key}\n";
116 'here2' => <<'----------',
119 ok $test - here2.in "" in multiline s///e outside eval
122 print $_ || "not ok $test\n";
125 'multiple_equals' => <<'----------',
126 # ignore second '=' here
127 $| = $debug = 1 if $opt_d;
128 $full_index = 1 if $opt_i;
129 $query_all = $opt_A if $opt_A;
131 # not aligning multiple '='s here
132 $start = $end = $len = $ismut = $number = $allele_ori = $allele_mut =
133 $proof = $xxxxreg = $reg = $dist = '';
136 'ndsm1' => <<'----------',
137 ;;;;; # 1 trapped semicolon
138 sub numerically {$a <=> $b};
140 sub Numerically {$a <=> $b}; # trapped semicolon
141 @: = qw;2c72656b636168
146 'rt130394' => <<'----------',
147 # rt130394: keep on one line with -olbn=1
148 $factorial = sub { reduce { $a * $b } 1 .. 11 };
151 'rt131115' => <<'----------',
152 # closing braces to be inteded with -bli
155 foreach my $par (@_) {
161 'rt131288' => <<'----------',
162 sub OptArgs2::STYLE_FULL { 3 }
163 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage', 'usage: ' . $usage . "\n";
166 'spp' => <<'----------',
177 ####################################
178 # BEGIN SECTION 3: Expected output #
179 ####################################
185 expect => <<'#1...........',
191 my $sub1 = sub () { };
192 my $sub2 = sub () { };
199 expect => <<'#2...........',
205 my $sub1 = sub () { };
206 my $sub2 = sub () { };
213 expect => <<'#3...........',
214 # git#16, two equality lines with fat commas on the right
215 my $Package = $Self->RepositoryGet( %Param, Result => 'SCALAR' );
216 my %Structure = $Self->PackageParse( String => $Package );
223 expect => <<'#4...........',
224 # perltidy -wn -ce -cbl=sort,map,grep
227 sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
228 map { [ $_, length($_) ] } @unsorted;
235 expect => <<'#5...........',
236 # perltidy -wn -ce -cbl=sort,map,grep
240 $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
247 'multiple_equals.def' => {
248 source => "multiple_equals",
250 expect => <<'#6...........',
251 # ignore second '=' here
252 $| = $debug = 1 if $opt_d;
253 $full_index = 1 if $opt_i;
254 $query_all = $opt_A if $opt_A;
256 # not aligning multiple '='s here
257 $start = $end = $len = $ismut = $number = $allele_ori = $allele_mut = $proof =
258 $xxxxreg = $reg = $dist = '';
265 expect => <<'#7...........',
266 # do not align the commas
268 ListBox => origin => [ 270, 160 ],
277 expect => <<'#8...........',
278 # not a good alignment
279 my $realname = catfile( $dir, $file );
280 my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
287 expect => <<'#9...........',
288 # not a good alignment
289 my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
290 my $incname = $indname . ( $indtot > 1 ? $indno : "" );
297 expect => <<'#10...........',
298 # not a good alignment
300 match_on_type @_ => Null => sub { die "Cannot get head of Null" },
301 ArrayRef => sub { $_->[0] };
308 source => "rt130394",
310 expect => <<'#11...........',
311 # rt130394: keep on one line with -olbn=1
313 reduce { $a * $b } 1 .. 11;
319 source => "rt131115",
321 expect => <<'#12...........',
322 # closing braces to be inteded with -bli
325 foreach my $par (@_) {
332 'rt131115.rt131115' => {
333 source => "rt131115",
334 params => "rt131115",
335 expect => <<'#13...........',
336 # closing braces to be inteded with -bli
351 expect => <<'#14...........',
352 ; # 1 trapped semicolon
353 sub numerically { $a <=> $b }
355 sub Numerically { $a <=> $b }; # trapped semicolon
356 @: = qw;2c72656b636168
366 expect => <<'#15...........',
371 ; # 1 trapped semicolon
372 sub numerically { $a <=> $b };
378 sub Numerically { $a <=> $b }; # trapped semicolon
379 @: = qw;2c72656b636168
387 source => "rt131288",
389 expect => <<'#16...........',
390 sub OptArgs2::STYLE_FULL { 3 }
391 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
392 'usage: ' . $usage . "\n";
396 'rt130394.rt130394' => {
397 source => "rt130394",
398 params => "rt130394",
399 expect => <<'#17...........',
400 # rt130394: keep on one line with -olbn=1
401 $factorial = sub { reduce { $a * $b } 1 .. 11 };
408 expect => <<'#18...........',
409 # parsing stuff like 'x17' before fat comma
411 123 x 18 => '123x18',
412 123 x 19 => '123 x19',
413 123 x 20 => '123x 20',
416 'd' x 17 => "'d' x17",
419 foreach my $key ( keys %bb ) {
420 print "key='$key' => $bb{$key}\n";
428 expect => <<'#19...........',
431 ok $test - here2.in "" in multiline s///e outside eval
434 print $_ || "not ok $test\n";
439 my $ntests = 0 + keys %{$rtests};
440 plan tests => $ntests;
447 foreach my $key ( sort keys %{$rtests} ) {
449 my $sname = $rtests->{$key}->{source};
450 my $expect = $rtests->{$key}->{expect};
451 my $pname = $rtests->{$key}->{params};
452 my $source = $rsources->{$sname};
453 my $params = defined($pname) ? $rparams->{$pname} : "";
455 my $errorfile_string;
456 my $err = Perl::Tidy::perltidy(
458 destination => \$output,
459 perltidyrc => \$params,
460 argv => '', # for safety; hide any ARGV from perltidy
461 stderr => \$stderr_string,
462 errorfile => \$errorfile_string, # not used when -se flag is set
464 if ( $err || $stderr_string || $errorfile_string ) {
465 print STDERR "Error output received for test '$key'\n";
467 print STDERR "An error flag '$err' was returned\n";
470 if ($stderr_string) {
471 print STDERR "---------------------\n";
472 print STDERR "<<STDERR>>\n$stderr_string\n";
473 print STDERR "---------------------\n";
474 ok( !$stderr_string );
476 if ($errorfile_string) {
477 print STDERR "---------------------\n";
478 print STDERR "<<.ERR file>>\n$errorfile_string\n";
479 print STDERR "---------------------\n";
480 ok( !$errorfile_string );
484 if ( !is( $output, $expect, $key ) ) {
485 my $leno = length($output);
486 my $lene = length($expect);
487 if ( $leno == $lene ) {
489 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
493 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";