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; differnt 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];
121 'align22' => <<'----------',
122 # two equality lines with different patterns to left of equals do not align
123 $signame{$_} = ++$signal;
124 $signum[$signal] = $_;
127 'align23' => <<'----------',
128 # two equality lines with same pattern on left of equals will align
129 my $orig = my $format = "^<<<<< ~~\n";
133 'align24' => <<'----------',
134 # Do not align interior fat commas here; differnt container types
135 my $p = TAP::Parser::SubclassTest->new(
137 exec => [ $cat => $file ],
138 sources => { MySourceHandler => { accept_all => 1 } },
143 'align25' => <<'----------',
144 # do not align commas here; different container types
145 is_deeply( [ $a, $a ], [ $b, $c ] );
146 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
147 is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
151 'align26' => <<'----------',
152 # align first of multiple equals
153 $SIG{PIPE}=sub{die"writingtoaclosedpipe"};#1=
154 $SIG{HUP}=$SIG{BREAK}=$SIG{INT}=$SIG{TERM};#3=
157 'align27' => <<'----------',
158 # do not align first equals here (unmatched commas on left side of =)
159 my ( $self, $name, $type ) = @_;
160 my $html_toc_fh = $self->{_html_toc_fh};
161 my $html_prelim_fh = $self->{_html_prelim_fh};
164 'break5' => <<'----------',
165 # do not break at .'s after the ?
167 ( $pod eq $pod2 ) & amp;
173 . "\">\n$text</A>\n"
174 : "\n$type$pod2.html\#" . $value . "\">$text<\/A>\n";
177 'rt127633' => <<'----------',
178 # keep lines long; do not break after 'return' and '.' with -baoo
179 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) : $ref eq 'ARRAY';
180 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' . 'bbbbbbbbbbbbbbbbbbbbbbbbb';
184 ####################################
185 # BEGIN SECTION 3: Expected output #
186 ####################################
192 expect => <<'#1...........',
193 $message =~ &rhs_wordwrap( $message, $width );
194 $message_len =~ split( /^/, $message );
201 expect => <<'#2...........',
202 my $accountno = getnextacctno( $env, $bornum, $dbh );
203 my $item = getiteminformation( $env, $itemno );
204 my $account = "Insert into accountlines
212 expect => <<'#3...........',
213 my $type = shift || "o";
214 my $fname = ( $type eq 'oo' ? 'orte_city' : 'orte' );
215 my $suffix = ( $coord_system eq 'standard' ? '' : '-orig' );
222 expect => <<'#4...........',
223 # symbols =~ and !~ are equivalent in alignment
224 ok( $out !~ /EXACT <fop>/, "No 'baz'" );
225 ok( $out =~ /<liz>/, "Got 'liz'" ); # liz
226 ok( $out =~ /<zoo>/, "Got 'zoo'" ); # zoo
227 ok( $out !~ /<zap>/, "Got 'zap'" ); # zap
232 source => "rt127633",
234 expect => <<'#5...........',
235 # keep lines long; do not break after 'return' and '.' with -baoo
236 return $ref eq 'SCALAR'
237 ? $self->encode_scalar( $object, $name, $type, $attr )
239 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
240 . 'bbbbbbbbbbbbbbbbbbbbbbbbb';
244 'rt127633.rt127633' => {
245 source => "rt127633",
246 params => "rt127633",
247 expect => <<'#6...........',
248 # keep lines long; do not break after 'return' and '.' with -baoo
249 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) :
251 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' .
252 'bbbbbbbbbbbbbbbbbbbbbbbbb';
259 expect => <<'#7...........',
261 my ($apple) = new Fruit( "Apple1", .1, .30 );
262 my ($grapefruit) = new Grapefruit( "Grapefruit1", .3 );
263 my ($redgrapefruit) = new RedGrapefruit( "Grapefruit2", .3 );
270 expect => <<'#8...........',
271 # align both = and //
272 my $color = $opts{'-color'} // 'black';
273 my $background = $opts{'-background'} // 'none';
274 my $linewidth = $opts{'-linewidth'} // 1;
275 my $radius = $opts{'-radius'} // 0;
282 expect => <<'#9...........',
283 # align all at first =>
285 PHFAM => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
286 FAMILY => [qw( John Jane Sally )],
287 AGES => { John => 33, Jane => 28, Sally => 3 },
288 RFAM => [ [qw( John Jane Sally )] ],
290 SPIT => sub { shift },
299 expect => <<'#10...........',
300 # do not break at .'s after the ?
302 ( $pod eq $pod2 ) & amp;
306 ? "\n<A NAME=\"" . $value . "\">\n$text</A>\n"
307 : "\n$type$pod2.html\#" . $value . "\">$text<\/A>\n";
314 expect => <<'#11...........',
315 # different lhs patterns, do not align the '='
316 @_ = qw(sort grep map do eval);
317 @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
324 expect => <<'#12...........',
325 # marginal two-line match; differnt lhs patterns; do not align
334 expect => <<'#13...........',
335 # two lines with large gap but same lhs pattern so align equals
336 local (@pieces) = split( /\./, $filename, 2 );
337 local ($just_dir_and_base) = $pieces[0];
344 expect => <<'#14...........',
345 # two equality lines with different patterns to left of equals do not align
346 $signame{$_} = ++$signal;
347 $signum[$signal] = $_;
354 expect => <<'#15...........',
355 # two equality lines with same pattern on left of equals will align
356 my $orig = my $format = "^<<<<< ~~\n";
364 expect => <<'#16...........',
365 # Do not align interior fat commas here; differnt container types
366 my $p = TAP::Parser::SubclassTest->new(
368 exec => [ $cat => $file ],
369 sources => { MySourceHandler => { accept_all => 1 } },
378 expect => <<'#17...........',
379 # do not align commas here; different container types
380 is_deeply( [ $a, $a ], [ $b, $c ] );
381 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
382 is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
390 expect => <<'#18...........',
391 # align first of multiple equals
392 $SIG{PIPE} = sub { die "writingtoaclosedpipe" }; #1=
393 $SIG{HUP} = $SIG{BREAK} = $SIG{INT} = $SIG{TERM}; #3=
400 expect => <<'#19...........',
401 # do not align first equals here (unmatched commas on left side of =)
402 my ( $self, $name, $type ) = @_;
403 my $html_toc_fh = $self->{_html_toc_fh};
404 my $html_prelim_fh = $self->{_html_prelim_fh};
409 my $ntests = 0 + keys %{$rtests};
410 plan tests => $ntests;
417 foreach my $key ( sort keys %{$rtests} ) {
419 my $sname = $rtests->{$key}->{source};
420 my $expect = $rtests->{$key}->{expect};
421 my $pname = $rtests->{$key}->{params};
422 my $source = $rsources->{$sname};
423 my $params = defined($pname) ? $rparams->{$pname} : "";
425 my $errorfile_string;
426 my $err = Perl::Tidy::perltidy(
428 destination => \$output,
429 perltidyrc => \$params,
430 argv => '', # for safety; hide any ARGV from perltidy
431 stderr => \$stderr_string,
432 errorfile => \$errorfile_string, # not used when -se flag is set
434 if ( $err || $stderr_string || $errorfile_string ) {
437 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
440 if ($stderr_string) {
441 print STDERR "---------------------\n";
442 print STDERR "<<STDERR>>\n$stderr_string\n";
443 print STDERR "---------------------\n";
445 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
446 ok( !$stderr_string );
448 if ($errorfile_string) {
449 print STDERR "---------------------\n";
450 print STDERR "<<.ERR file>>\n$errorfile_string\n";
451 print STDERR "---------------------\n";
453 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
454 ok( !$errorfile_string );
458 ok( $output, $expect );