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 'rt127633' => "-baao",
44 ############################
45 # BEGIN SECTION 2: Sources #
46 ############################
49 'align10' => <<'----------',
50 $message =~ &rhs_wordwrap( $message, $width );
51 $message_len =~ split( /^/, $message );
54 'align11' => <<'----------',
55 my $accountno = getnextacctno( $env, $bornum, $dbh );
56 my $item = getiteminformation( $env, $itemno );
57 my $account = "Insert into accountlines
61 'align12' => <<'----------',
62 my $type = shift || "o";
63 my $fname = ( $type eq 'oo' ? 'orte_city' : 'orte' );
64 my $suffix = ( $coord_system eq 'standard' ? '' : '-orig' );
67 'align13' => <<'----------',
68 # symbols =~ and !~ are equivalent in alignment
69 ok( $out !~ /EXACT <fop>/, "No 'baz'" );
70 ok( $out =~ /<liz>/, "Got 'liz'" ); # liz
71 ok( $out =~ /<zoo>/, "Got 'zoo'" ); # zoo
72 ok( $out !~ /<zap>/, "Got 'zap'" ); # zap
75 'align14' => <<'----------',
77 my($apple)=new Fruit("Apple1",.1,.30);
78 my($grapefruit)=new Grapefruit("Grapefruit1",.3);
79 my($redgrapefruit)=new RedGrapefruit("Grapefruit2",.3);
82 'align15' => <<'----------',
84 my$color=$opts{'-color'}//'black';
85 my$background=$opts{'-background'}//'none';
86 my$linewidth=$opts{'-linewidth'}//1;
87 my$radius=$opts{'-radius'}//0;
90 'align16' => <<'----------',
91 # align all at first =>
93 PHFAM => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
94 FAMILY => [qw( John Jane Sally )],
95 AGES => { John => 33, Jane => 28, Sally => 3 },
96 RFAM => [ [qw( John Jane Sally )] ],
98 SPIT => sub { shift },
103 'align19' => <<'----------',
104 # different lhs patterns, do not align the '='
105 @_ = qw(sort grep map do eval);
106 @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
109 'align20' => <<'----------',
110 # marginal two-line match; different lhs patterns; do not align
115 'align21' => <<'----------',
116 # two lines with large gap but same lhs pattern so align equals
117 local (@pieces) = split( /\./, $filename, 2 );
118 local ($just_dir_and_base) = $pieces[0];
120 # two lines with 3 alignment tokens
121 $expect = "1$expect" if $expect =~ /^e/i;
122 $p = "1$p" if defined $p and $p =~ /^e/i;
124 # two lines where alignment causes a large gap
125 is( eval { sysopen( my $ro, $foo, &O_RDONLY | $TAINT0 ) }, undef );
129 'align22' => <<'----------',
130 # two equality lines with different patterns to left of equals do not align
131 $signame{$_} = ++$signal;
132 $signum[$signal] = $_;
135 'align23' => <<'----------',
136 # two equality lines with same pattern on left of equals will align
137 my $orig = my $format = "^<<<<< ~~\n";
141 'align24' => <<'----------',
142 # Do not align interior fat commas here; different container types
143 my $p = TAP::Parser::SubclassTest->new(
145 exec => [ $cat => $file ],
146 sources => { MySourceHandler => { accept_all => 1 } },
151 'align25' => <<'----------',
152 # do not align internal commas here; different container types
153 is_deeply( [ $a, $a ], [ $b, $c ] );
154 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
155 is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
159 'align26' => <<'----------',
160 # align first of multiple equals
161 $SIG{PIPE}=sub{die"writingtoaclosedpipe"};
162 $SIG{BREAK}=$SIG{INT}=$SIG{TERM};
163 $SIG{HUP}=\&some_handler;
166 'align27' => <<'----------',
167 # do not align first equals here (unmatched commas on left side of =)
168 my ( $self, $name, $type ) = @_;
169 my $html_toc_fh = $self->{_html_toc_fh};
170 my $html_prelim_fh = $self->{_html_prelim_fh};
173 'break5' => <<'----------',
174 # do not break at .'s after the ?
176 ( $pod eq $pod2 ) & amp;
182 . "\">\n$text</A>\n"
183 : "\n$type$pod2.html\#" . $value . "\">$text<\/A>\n";
186 'rt127633' => <<'----------',
187 # keep lines long; do not break after 'return' and '.' with -baoo
188 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) : $ref eq 'ARRAY';
189 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' . 'bbbbbbbbbbbbbbbbbbbbbbbbb';
193 ####################################
194 # BEGIN SECTION 3: Expected output #
195 ####################################
201 expect => <<'#1...........',
202 $message =~ &rhs_wordwrap( $message, $width );
203 $message_len =~ split( /^/, $message );
210 expect => <<'#2...........',
211 my $accountno = getnextacctno( $env, $bornum, $dbh );
212 my $item = getiteminformation( $env, $itemno );
213 my $account = "Insert into accountlines
221 expect => <<'#3...........',
222 my $type = shift || "o";
223 my $fname = ( $type eq 'oo' ? 'orte_city' : 'orte' );
224 my $suffix = ( $coord_system eq 'standard' ? '' : '-orig' );
231 expect => <<'#4...........',
232 # symbols =~ and !~ are equivalent in alignment
233 ok( $out !~ /EXACT <fop>/, "No 'baz'" );
234 ok( $out =~ /<liz>/, "Got 'liz'" ); # liz
235 ok( $out =~ /<zoo>/, "Got 'zoo'" ); # zoo
236 ok( $out !~ /<zap>/, "Got 'zap'" ); # zap
241 source => "rt127633",
243 expect => <<'#5...........',
244 # keep lines long; do not break after 'return' and '.' with -baoo
245 return $ref eq 'SCALAR'
246 ? $self->encode_scalar( $object, $name, $type, $attr )
248 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
249 . 'bbbbbbbbbbbbbbbbbbbbbbbbb';
253 'rt127633.rt127633' => {
254 source => "rt127633",
255 params => "rt127633",
256 expect => <<'#6...........',
257 # keep lines long; do not break after 'return' and '.' with -baoo
258 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) :
260 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' .
261 'bbbbbbbbbbbbbbbbbbbbbbbbb';
268 expect => <<'#7...........',
270 my ($apple) = new Fruit( "Apple1", .1, .30 );
271 my ($grapefruit) = new Grapefruit( "Grapefruit1", .3 );
272 my ($redgrapefruit) = new RedGrapefruit( "Grapefruit2", .3 );
279 expect => <<'#8...........',
280 # align both = and //
281 my $color = $opts{'-color'} // 'black';
282 my $background = $opts{'-background'} // 'none';
283 my $linewidth = $opts{'-linewidth'} // 1;
284 my $radius = $opts{'-radius'} // 0;
291 expect => <<'#9...........',
292 # align all at first =>
294 PHFAM => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
295 FAMILY => [qw( John Jane Sally )],
296 AGES => { John => 33, Jane => 28, Sally => 3 },
297 RFAM => [ [qw( John Jane Sally )] ],
299 SPIT => sub { shift },
308 expect => <<'#10...........',
309 # do not break at .'s after the ?
311 ( $pod eq $pod2 ) & amp;
315 ? "\n<A NAME=\"" . $value . "\">\n$text</A>\n"
316 : "\n$type$pod2.html\#" . $value . "\">$text<\/A>\n";
323 expect => <<'#11...........',
324 # different lhs patterns, do not align the '='
325 @_ = qw(sort grep map do eval);
326 @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
333 expect => <<'#12...........',
334 # marginal two-line match; different lhs patterns; do not align
343 expect => <<'#13...........',
344 # two lines with large gap but same lhs pattern so align equals
345 local (@pieces) = split( /\./, $filename, 2 );
346 local ($just_dir_and_base) = $pieces[0];
348 # two lines with 3 alignment tokens
349 $expect = "1$expect" if $expect =~ /^e/i;
350 $p = "1$p" if defined $p and $p =~ /^e/i;
352 # two lines where alignment causes a large gap
353 is( eval { sysopen( my $ro, $foo, &O_RDONLY | $TAINT0 ) }, undef );
361 expect => <<'#14...........',
362 # two equality lines with different patterns to left of equals do not align
363 $signame{$_} = ++$signal;
364 $signum[$signal] = $_;
371 expect => <<'#15...........',
372 # two equality lines with same pattern on left of equals will align
373 my $orig = my $format = "^<<<<< ~~\n";
381 expect => <<'#16...........',
382 # Do not align interior fat commas here; different container types
383 my $p = TAP::Parser::SubclassTest->new(
385 exec => [ $cat => $file ],
386 sources => { MySourceHandler => { accept_all => 1 } },
395 expect => <<'#17...........',
396 # do not align internal commas here; different container types
397 is_deeply( [ $a, $a ], [ $b, $c ] );
398 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
399 is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
407 expect => <<'#18...........',
408 # align first of multiple equals
409 $SIG{PIPE} = sub { die "writingtoaclosedpipe" };
410 $SIG{BREAK} = $SIG{INT} = $SIG{TERM};
411 $SIG{HUP} = \&some_handler;
418 expect => <<'#19...........',
419 # do not align first equals here (unmatched commas on left side of =)
420 my ( $self, $name, $type ) = @_;
421 my $html_toc_fh = $self->{_html_toc_fh};
422 my $html_prelim_fh = $self->{_html_prelim_fh};
427 my $ntests = 0 + keys %{$rtests};
428 plan tests => $ntests;
435 foreach my $key ( sort keys %{$rtests} ) {
437 my $sname = $rtests->{$key}->{source};
438 my $expect = $rtests->{$key}->{expect};
439 my $pname = $rtests->{$key}->{params};
440 my $source = $rsources->{$sname};
441 my $params = defined($pname) ? $rparams->{$pname} : "";
443 my $errorfile_string;
444 my $err = Perl::Tidy::perltidy(
446 destination => \$output,
447 perltidyrc => \$params,
448 argv => '', # for safety; hide any ARGV from perltidy
449 stderr => \$stderr_string,
450 errorfile => \$errorfile_string, # not used when -se flag is set
452 if ( $err || $stderr_string || $errorfile_string ) {
453 print STDERR "Error output received for test '$key'\n";
455 print STDERR "An error flag '$err' was returned\n";
458 if ($stderr_string) {
459 print STDERR "---------------------\n";
460 print STDERR "<<STDERR>>\n$stderr_string\n";
461 print STDERR "---------------------\n";
462 ok( !$stderr_string );
464 if ($errorfile_string) {
465 print STDERR "---------------------\n";
466 print STDERR "<<.ERR file>>\n$errorfile_string\n";
467 print STDERR "---------------------\n";
468 ok( !$errorfile_string );
472 if ( !is( $output, $expect, $key ) ) {
473 my $leno = length($output);
474 my $lene = length($expect);
475 if ( $leno == $lene ) {
477 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
481 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";