1 # Created with: ./make_t.pl
25 # To locate test #13 you can search for its name or the string '#13'
37 ###########################################
38 # BEGIN SECTION 1: Parameter combinations #
39 ###########################################
40 $rparams = { 'def' => "", };
42 ############################
43 # BEGIN SECTION 2: Sources #
44 ############################
47 '105484' => <<'----------',
53 'align1' => <<'----------',
54 return ( $fetch_key eq $fk
56 && $fetch_value eq $fv
57 && $store_value eq $sv
58 && $_ eq 'original' );
61 'align2' => <<'----------',
66 && ( $a->{'title'} eq $b->{'title'} )
67 && ( $a->{'href'} eq $b->{'href'} ) );
70 'align3' => <<'----------',
71 # This greatly improved after dropping 'ne' and 'eq':
73 $dir eq $updir and # if we have an updir
74 @collapsed and # and something to collapse
75 length $collapsed[-1] and # and its not the rootdir
76 $collapsed[-1] ne $updir and # nor another updir
77 $collapsed[-1] ne $curdir # nor the curdir
81 'align4' => <<'----------',
82 # removed 'eq' and '=~' from alignment tokens to get alignment of '?'s
84 $name eq $EMPTY_STR ? 'Customer'
85 : $name =~ m/\A((?:Sir|Dame) \s+ \S+) /xms ? $1
86 : $name =~ m/(.*), \s+ Ph[.]?D \z /xms ? "Dr $1"
90 'align5' => <<'----------',
92 printline( "Broadcast", &bintodq($b), ( $b, $mask, $bcolor, 0 ) );
93 printline( "HostMin", &bintodq($hmin), ( $hmin, $mask, $bcolor, 0 ) );
94 printline( "HostMax", &bintodq($hmax), ( $hmax, $mask, $bcolor, 0 ) );
97 'align6' => <<'----------',
98 # align opening parens
99 if ( ( index( $msg_line_lc, $nick1 ) != -1 ) ||
100 ( index( $msg_line_lc, $nick2 ) != -1 ) ||
101 ( index( $msg_line_lc, $nick3 ) != -1 ) ) {
106 'align7' => <<'----------',
107 # Alignment with two fat commas in second line
108 my $ct = Courriel::Header::ContentType->new(
109 mime_type => 'multipart/alternative',
110 attributes => { boundary => unique_boundary },
114 'align8' => <<'----------',
115 # aligning '=' and padding 'if'
116 if ( $tag == 263 ) { $bbi->{"Info.Thresholding"} = $value }
117 elsif ( $tag == 264 ) { $bbi->{"Info.CellWidth"} = $value }
118 elsif ( $tag == 265 ) { $bbi->{"Info.CellLength"} = $value }
121 'align9' => <<'----------',
122 # test of aligning ||
124 ( $ExtUtils::MM_Unix::Is_OS2 || 0 ) +
125 ( $ExtUtils::MM_Unix::Is_Mac || 0 ) +
126 ( $ExtUtils::MM_Unix::Is_Win32 || 0 ) +
127 ( $ExtUtils::MM_Unix::Is_Dos || 0 ) +
128 ( $ExtUtils::MM_Unix::Is_VMS || 0 );
131 'andor1' => <<'----------',
132 return 1 if $det_a < 0 and $det_b > 0 or
133 $det_a > 0 and $det_b < 0;
136 'andor10' => <<'----------',
137 if ( ( ($a) and ( $b == 13 ) and ( $c - 24 = 0 ) and ("test")
138 and ( $rudolph eq "reindeer" or $rudolph eq "red nosed" )
140 ) or ( $nobody and ( $noone or $none ) )
145 'andor2' => <<'----------',
146 # breaks at = or at && but not both
147 my $success = ( system("$Config{cc} -o $te $tc $libs $HIDE") == 0 ) && -e $te ? 1 : 0;
150 'andor3' => <<'----------',
151 ok( ( $obj->name() eq $obj2->name() )
152 and ( $obj->version() eq $obj2->version() )
153 and ( $obj->help() eq $obj2->help() ) );
156 'andor4' => <<'----------',
157 if ( !$verbose_error && ( !$options->{'log'}
158 && ( ( $options->{'verbose'} & 8 ) || ( $options->{'verbose'} & 16 )
159 || ( $options->{'verbose'} & 32 )
160 || ( $options->{'verbose'} & 64 ) ) ) )
163 'andor5' => <<'----------',
164 # two levels of && with side comments
167 && \&syscopy != \©
169 && !( $from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle
170 && !( $from_a_handle && $^O eq 'mpeix' ) # and neither can MPE/iX.
173 return syscopy( $from, $to );
177 'andor6' => <<'----------',
178 # Example of nested ands and ors
179 sub is_miniwhile { # check for one-line loop (`foo() while $y--')
182 !null($op) and null( $op->sibling )
183 and $op->ppaddr eq "pp_null"
184 and class($op) eq "UNOP"
187 $op->first->ppaddr =~ /^pp_(and|or)$/
188 and $op->first->first->sibling->ppaddr eq "pp_lineseq"
190 or ( $op->first->ppaddr eq "pp_lineseq"
191 and not null $op->first->first->sibling
192 and $op->first->first->sibling->ppaddr eq "pp_unstack" )
198 'andor7' => <<'----------',
199 # original is single line:
200 $a = 1 if $l and !$r or !$l and $r;
203 'andor8' => <<'----------',
204 # original is broken:
206 if $l and !$r or !$l and $r;
209 'andor9' => <<'----------',
210 if ( ( ( $old_new and $old_new eq 'changed' )
211 and ( $db_new and $db_new eq 'changed' )
212 and ( not defined $old_db )
213 ) or ( ( $old_new and $old_new eq 'changed' )
214 and ( $db_new and $db_new eq 'new' )
215 and ( $old_db and $old_db eq 'new' )
216 ) or ( ( $old_new and $old_new eq 'new' )
217 and ( $db_new and $db_new eq 'new' )
218 and ( not defined $old_db )
226 ####################################
227 # BEGIN SECTION 3: Expected output #
228 ####################################
234 expect => <<'#1...........',
236 case x { 2 } else { }
244 expect => <<'#2...........',
245 return ( $fetch_key eq $fk
247 && $fetch_value eq $fv
248 && $store_value eq $sv
249 && $_ eq 'original' );
256 expect => <<'#3...........',
261 && ( $a->{'title'} eq $b->{'title'} )
262 && ( $a->{'href'} eq $b->{'href'} ) );
269 expect => <<'#4...........',
270 # This greatly improved after dropping 'ne' and 'eq':
272 $dir eq $updir and # if we have an updir
273 @collapsed and # and something to collapse
274 length $collapsed[-1] and # and its not the rootdir
275 $collapsed[-1] ne $updir and # nor another updir
276 $collapsed[-1] ne $curdir # nor the curdir
287 expect => <<'#5...........',
288 # removed 'eq' and '=~' from alignment tokens to get alignment of '?'s
290 $name eq $EMPTY_STR ? 'Customer'
291 : $name =~ m/\A((?:Sir|Dame) \s+ \S+) /xms ? $1
292 : $name =~ m/(.*), \s+ Ph[.]?D \z /xms ? "Dr $1"
300 expect => <<'#6...........',
302 printline( "Broadcast", &bintodq($b), ( $b, $mask, $bcolor, 0 ) );
303 printline( "HostMin", &bintodq($hmin), ( $hmin, $mask, $bcolor, 0 ) );
304 printline( "HostMax", &bintodq($hmax), ( $hmax, $mask, $bcolor, 0 ) );
311 expect => <<'#7...........',
312 # align opening parens
313 if ( ( index( $msg_line_lc, $nick1 ) != -1 )
314 || ( index( $msg_line_lc, $nick2 ) != -1 )
315 || ( index( $msg_line_lc, $nick3 ) != -1 ) )
325 expect => <<'#8...........',
326 # Alignment with two fat commas in second line
327 my $ct = Courriel::Header::ContentType->new(
328 mime_type => 'multipart/alternative',
329 attributes => { boundary => unique_boundary },
337 expect => <<'#9...........',
338 # aligning '=' and padding 'if'
339 if ( $tag == 263 ) { $bbi->{"Info.Thresholding"} = $value }
340 elsif ( $tag == 264 ) { $bbi->{"Info.CellWidth"} = $value }
341 elsif ( $tag == 265 ) { $bbi->{"Info.CellLength"} = $value }
348 expect => <<'#10...........',
349 # test of aligning ||
351 ( $ExtUtils::MM_Unix::Is_OS2 || 0 ) +
352 ( $ExtUtils::MM_Unix::Is_Mac || 0 ) +
353 ( $ExtUtils::MM_Unix::Is_Win32 || 0 ) +
354 ( $ExtUtils::MM_Unix::Is_Dos || 0 ) +
355 ( $ExtUtils::MM_Unix::Is_VMS || 0 );
362 expect => <<'#11...........',
364 if $det_a < 0 and $det_b > 0
365 or $det_a > 0 and $det_b < 0;
372 expect => <<'#12...........',
379 and ( $rudolph eq "reindeer" or $rudolph eq "red nosed" )
382 or ( $nobody and ( $noone or $none ) )
393 expect => <<'#13...........',
394 # breaks at = or at && but not both
396 ( system("$Config{cc} -o $te $tc $libs $HIDE") == 0 ) && -e $te ? 1 : 0;
403 expect => <<'#14...........',
404 ok( ( $obj->name() eq $obj2->name() )
405 and ( $obj->version() eq $obj2->version() )
406 and ( $obj->help() eq $obj2->help() ) );
413 expect => <<'#15...........',
418 && ( ( $options->{'verbose'} & 8 )
419 || ( $options->{'verbose'} & 16 )
420 || ( $options->{'verbose'} & 32 )
421 || ( $options->{'verbose'} & 64 ) )
430 expect => <<'#16...........',
431 # two levels of && with side comments
434 && \&syscopy != \©
436 && !( $from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle
437 && !( $from_a_handle && $^O eq 'mpeix' ) # and neither can MPE/iX.
440 return syscopy( $from, $to );
448 expect => <<'#17...........',
449 # Example of nested ands and ors
450 sub is_miniwhile { # check for one-line loop (`foo() while $y--')
454 and null( $op->sibling )
455 and $op->ppaddr eq "pp_null"
456 and class($op) eq "UNOP"
459 $op->first->ppaddr =~ /^pp_(and|or)$/
460 and $op->first->first->sibling->ppaddr eq "pp_lineseq"
462 or ( $op->first->ppaddr eq "pp_lineseq"
463 and not null $op->first->first->sibling
464 and $op->first->first->sibling->ppaddr eq "pp_unstack" )
474 expect => <<'#18...........',
475 # original is single line:
476 $a = 1 if $l and !$r or !$l and $r;
483 expect => <<'#19...........',
484 # original is broken:
494 expect => <<'#20...........',
497 ( $old_new and $old_new eq 'changed' )
498 and ( $db_new and $db_new eq 'changed' )
499 and ( not defined $old_db )
501 or ( ( $old_new and $old_new eq 'changed' )
502 and ( $db_new and $db_new eq 'new' )
503 and ( $old_db and $old_db eq 'new' ) )
504 or ( ( $old_new and $old_new eq 'new' )
505 and ( $db_new and $db_new eq 'new' )
506 and ( not defined $old_db ) )
515 my $ntests = 0 + keys %{$rtests};
516 plan tests => $ntests;
523 foreach my $key ( sort keys %{$rtests} ) {
525 my $sname = $rtests->{$key}->{source};
526 my $expect = $rtests->{$key}->{expect};
527 my $pname = $rtests->{$key}->{params};
528 my $source = $rsources->{$sname};
529 my $params = defined($pname) ? $rparams->{$pname} : "";
531 my $errorfile_string;
532 my $err = Perl::Tidy::perltidy(
534 destination => \$output,
535 perltidyrc => \$params,
536 argv => '', # for safety; hide any ARGV from perltidy
537 stderr => \$stderr_string,
538 errorfile => \$errorfile_string, # not used when -se flag is set
540 if ( $err || $stderr_string || $errorfile_string ) {
541 print STDERR "Error output received for test '$key'\n";
543 print STDERR "An error flag '$err' was returned\n";
546 if ($stderr_string) {
547 print STDERR "---------------------\n";
548 print STDERR "<<STDERR>>\n$stderr_string\n";
549 print STDERR "---------------------\n";
550 ok( !$stderr_string );
552 if ($errorfile_string) {
553 print STDERR "---------------------\n";
554 print STDERR "<<.ERR file>>\n$errorfile_string\n";
555 print STDERR "---------------------\n";
556 ok( !$errorfile_string );
560 if ( !is( $output, $expect, $key ) ) {
561 my $leno = length($output);
562 my $lene = length($expect);
563 if ( $leno == $lene ) {
565 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
569 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";