1 # Created with: ./make_t.pl
22 # To locate test #13 you can search for its name or the string '#13'
34 ###########################################
35 # BEGIN SECTION 1: Parameter combinations #
36 ###########################################
39 'git10' => "-wn -ce -cbl=sort,map,grep",
41 'rt130394' => "-olbn=1",
47 ############################
48 # BEGIN SECTION 2: Sources #
49 ############################
52 'align31' => <<'----------',
53 # do not align the commas
55 ListBox => origin => [ 270, 160 ],
60 'almost1' => <<'----------',
61 # not a good alignment
62 my $realname = catfile( $dir, $file );
63 my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
66 'almost2' => <<'----------',
67 # not a good alignment
68 my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
69 my $incname = $indname . ( $indtot > 1 ? $indno : "" );
72 'almost3' => <<'----------',
73 # not a good alignment
75 match_on_type @_ => Null => sub { die "Cannot get head of Null" },
76 ArrayRef => sub { $_->[0] };
81 'git10' => <<'----------',
82 # perltidy -wn -ce -cbl=sort,map,grep
86 $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
92 'git16' => <<'----------',
93 # git#16, two equality lines with fat commas on the right
94 my $Package = $Self->RepositoryGet( %Param, Result => 'SCALAR' );
95 my %Structure = $Self->PackageParse( String => $Package );
98 'multiple_equals' => <<'----------',
99 # ignore second '=' here
100 $| = $debug = 1 if $opt_d;
101 $full_index = 1 if $opt_i;
102 $query_all = $opt_A if $opt_A;
104 # not aligning multiple '='s here
105 $start = $end = $len = $ismut = $number = $allele_ori = $allele_mut =
106 $proof = $xxxxreg = $reg = $dist = '';
109 'ndsm1' => <<'----------',
110 ;;;;; # 1 trapped semicolon
111 sub numerically {$a <=> $b};
113 sub Numerically {$a <=> $b}; # trapped semicolon
114 @: = qw;2c72656b636168
119 'rt130394' => <<'----------',
120 # rt130394: keep on one line with -olbn=1
121 $factorial = sub { reduce { $a * $b } 1 .. 11 };
124 'rt131115' => <<'----------',
125 # closing braces to be inteded with -bli
128 foreach my $par (@_) {
134 'rt131288' => <<'----------',
135 sub OptArgs2::STYLE_FULL { 3 }
136 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage', 'usage: ' . $usage . "\n";
139 'spp' => <<'----------',
148 ####################################
149 # BEGIN SECTION 3: Expected output #
150 ####################################
156 expect => <<'#1...........',
168 expect => <<'#2...........',
180 expect => <<'#3...........',
181 # git#16, two equality lines with fat commas on the right
182 my $Package = $Self->RepositoryGet( %Param, Result => 'SCALAR' );
183 my %Structure = $Self->PackageParse( String => $Package );
190 expect => <<'#4...........',
191 # perltidy -wn -ce -cbl=sort,map,grep
194 sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
195 map { [ $_, length($_) ] } @unsorted;
202 expect => <<'#5...........',
203 # perltidy -wn -ce -cbl=sort,map,grep
207 $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
214 'multiple_equals.def' => {
215 source => "multiple_equals",
217 expect => <<'#6...........',
218 # ignore second '=' here
219 $| = $debug = 1 if $opt_d;
220 $full_index = 1 if $opt_i;
221 $query_all = $opt_A if $opt_A;
223 # not aligning multiple '='s here
224 $start = $end = $len = $ismut = $number = $allele_ori = $allele_mut =
225 $proof = $xxxxreg = $reg = $dist = '';
232 expect => <<'#7...........',
233 # do not align the commas
235 ListBox => origin => [ 270, 160 ],
244 expect => <<'#8...........',
245 # not a good alignment
246 my $realname = catfile( $dir, $file );
247 my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
254 expect => <<'#9...........',
255 # not a good alignment
256 my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
257 my $incname = $indname . ( $indtot > 1 ? $indno : "" );
264 expect => <<'#10...........',
265 # not a good alignment
267 match_on_type @_ => Null => sub { die "Cannot get head of Null" },
268 ArrayRef => sub { $_->[0] };
275 source => "rt130394",
277 expect => <<'#11...........',
278 # rt130394: keep on one line with -olbn=1
280 reduce { $a * $b } 1 .. 11;
286 source => "rt131115",
288 expect => <<'#12...........',
289 # closing braces to be inteded with -bli
292 foreach my $par (@_) {
299 'rt131115.rt131115' => {
300 source => "rt131115",
301 params => "rt131115",
302 expect => <<'#13...........',
303 # closing braces to be inteded with -bli
318 expect => <<'#14...........',
319 ; # 1 trapped semicolon
320 sub numerically { $a <=> $b }
322 sub Numerically { $a <=> $b }; # trapped semicolon
323 @: = qw;2c72656b636168
333 expect => <<'#15...........',
338 ; # 1 trapped semicolon
339 sub numerically { $a <=> $b };
345 sub Numerically { $a <=> $b }; # trapped semicolon
346 @: = qw;2c72656b636168
354 source => "rt131288",
356 expect => <<'#16...........',
357 sub OptArgs2::STYLE_FULL { 3 }
358 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
359 'usage: ' . $usage . "\n";
363 'rt130394.rt130394' => {
364 source => "rt130394",
365 params => "rt130394",
366 expect => <<'#17...........',
367 # rt130394: keep on one line with -olbn=1
368 $factorial = sub { reduce { $a * $b } 1 .. 11 };
373 my $ntests = 0 + keys %{$rtests};
374 plan tests => $ntests;
381 foreach my $key ( sort keys %{$rtests} ) {
383 my $sname = $rtests->{$key}->{source};
384 my $expect = $rtests->{$key}->{expect};
385 my $pname = $rtests->{$key}->{params};
386 my $source = $rsources->{$sname};
387 my $params = defined($pname) ? $rparams->{$pname} : "";
389 my $errorfile_string;
390 my $err = Perl::Tidy::perltidy(
392 destination => \$output,
393 perltidyrc => \$params,
394 argv => '', # for safety; hide any ARGV from perltidy
395 stderr => \$stderr_string,
396 errorfile => \$errorfile_string, # not used when -se flag is set
398 if ( $err || $stderr_string || $errorfile_string ) {
401 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
404 if ($stderr_string) {
405 print STDERR "---------------------\n";
406 print STDERR "<<STDERR>>\n$stderr_string\n";
407 print STDERR "---------------------\n";
409 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
410 ok( !$stderr_string );
412 if ($errorfile_string) {
413 print STDERR "---------------------\n";
414 print STDERR "<<.ERR file>>\n$errorfile_string\n";
415 print STDERR "---------------------\n";
417 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
418 ok( !$errorfile_string );
422 ok( $output, $expect );