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 ###########################################
43 'vmll' => <<'----------',
52 ############################
53 # BEGIN SECTION 2: Sources #
54 ############################
57 'sub1' => <<'----------',
66 sub doit{print"Hello My\n";}package join;
67 sub doit{print"Hello Join\n";}package for;
68 sub doit{print"Hello for\n";}package package;
69 sub doit{print"Hello package\n";}package sub;
70 sub doit{print"Hello sub\n";}package __END__;
71 sub doit{print"Hello __END__\n";}package __DATA__;
72 sub doit{print"Hello __DATA__\n";}
75 'sub2' => <<'----------',
78 # leading atrribute separator:
82 print "Hello, World!\n";
86 # colon as both ?/: and attribute separator
89 print "Hello, World!\n";
97 'switch1' => <<'----------',
98 sub classify_digit ($digit)
100 { case 0 { return 'zero' } case [ 2, 4, 6, 8 ]{ return 'even' }
101 case [ 1, 3, 4, 7, 9 ]{ return 'odd' } case /[A-F]/i { return 'hex' } }
105 'syntax1' => <<'----------',
110 'syntax2' => <<'----------',
111 # ? was taken as pattern
112 my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
115 'ternary1' => <<'----------',
117 ( $_ & 1 ) ? ( $_ & 4 ) ? $THRf_DEAD : $THRf_ZOMBIE :
118 ( $_ & 4 ) ? $THRf_R_DETACHED : $THRf_R_JOINABLE;
121 'ternary2' => <<'----------',
122 my $a=($b) ? ($c) ? ($d) ? $d1
132 'tick1' => <<'----------',
133 sub a'this { $p'u'a = "mooo\n"; print $p::u::a; }
134 a::this(); # print "mooo"
135 print $p'u'a; # print "mooo"
138 return sub { print $p't'u}
141 $a'that->(); # print "wwoo"
144 $a'that->(); # print "booo"
147 'trim_quote' => <<'----------',
148 # space after quote will get trimmed
150 all :: pure_all manifypods
151 ' . $self->{NOECHO} . '$(NOOP)
153 unless $self->{SKIPHASH}{'all'};
156 'tso1' => <<'----------',
157 print 0+ '42 EUR'; # 42
160 'tutor' => <<'----------',
162 $y=shift||5;for $i(1..10){$l[$i]="T";$w[$i]=999999;}while(1){print"Name:";$u=<STDIN>;$t=50;$a=time;for(0..9){$x="";for(1..$y){$x.=chr(int(rand(126-33)+33));}while($z ne $x){print"\r\n$x\r\n";$z=<STDIN>;chomp($z);$t-=5;}}$b=time;$t-=($b-$a)*2;$t=0-$t;$z=1;@q=@l;@p=@w;print "You scored $t points\r\nTopTen\r\n";for $i(1..10){if ($t<$p[$z]){$l[$i]=$u;chomp($l[$i]);$w[$i]=$t;$t=1000000}else{$l[$i]=$q[$z];$w[$i]=$p[$z];$z++;}print $l[$i],"\t",$w[$i],"\r\n";}}
165 'undoci1' => <<'----------',
166 $rinfo{deleteStyle} = [
168 -stipple => '@' . Tk->findINC('demos/images/grey.25'),
172 'use1' => <<'----------',
173 # previously this caused an incorrect error message after '2.42'
174 use lib "$Common::global::gInstallRoot/lib";
175 use CGI 2.42 qw(fatalsToBrowser);
178 # the 0666 must expect an operator
179 use constant MODE => do { 0666 & ( 0777 & ~umask ) };
184 'use2' => <<'----------',
185 # Keep the space before the '()' here:
189 use Foo::Bar qw(baz);
190 use Foo::Bar 1.0 qw(baz);
193 'version1' => <<'----------',
194 # VERSION statement unbroken, no semicolon added;
195 our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }
198 'version2' => <<'----------',
199 # On one line so MakeMaker will see it.
200 require Exporter; our $VERSION = $Exporter::VERSION;
203 'vert' => <<'----------',
204 # if $w->vert is tokenized as type 'U' then the ? will start a quote
205 # and an error will occur.
209 $w->vert ? $w->delta_width(0) : $w->delta_height(0);
213 'vmll' => <<'----------',
214 # perltidy -act=2 -vmll will leave these intact and greater than 80 columns
215 # in length, which is what vmll does
216 BEGIN {is_deeply(\@init_metas_called, [1]) || diag(Dumper(\@init_metas_called))}
218 This has the comma on the next line
219 exception {Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)},
223 ####################################
224 # BEGIN SECTION 3: Expected output #
225 ####################################
231 expect => <<'#1...........',
241 sub doit { print "Hello My\n"; }
244 sub doit { print "Hello Join\n"; }
247 sub doit { print "Hello for\n"; }
250 sub doit { print "Hello package\n"; }
253 sub doit { print "Hello sub\n"; }
256 sub doit { print "Hello __END__\n"; }
259 sub doit { print "Hello __DATA__\n"; }
266 expect => <<'#2...........',
269 # leading atrribute separator:
272 print "Hello, World!\n";
276 # colon as both ?/: and attribute separator
279 print "Hello, World!\n";
291 expect => <<'#3...........',
292 sub classify_digit ($digit) {
294 case 0 { return 'zero' }
295 case [ 2, 4, 6, 8 ]{ return 'even' }
296 case [ 1, 3, 4, 7, 9 ]{ return 'odd' }
297 case /[A-F]/i { return 'hex' }
306 expect => <<'#4...........',
315 expect => <<'#5...........',
316 # ? was taken as pattern
317 my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
322 source => "ternary1",
324 expect => <<'#6...........',
330 : ( $_ & 4 ) ? $THRf_R_DETACHED
336 source => "ternary2",
338 expect => <<'#7...........',
358 expect => <<'#8...........',
359 sub a'this { $p'u'a = "mooo\n"; print $p::u::a; }
360 a::this(); # print "mooo"
361 print $p'u'a; # print "mooo"
365 return sub { print $p't'u}
368 $a'that->(); # print "wwoo"
371 $a'that->(); # print "booo"
375 'trim_quote.def' => {
376 source => "trim_quote",
378 expect => <<'#9...........',
379 # space after quote will get trimmed
381 all :: pure_all manifypods
382 ' . $self->{NOECHO} . '$(NOOP)
384 unless $self->{SKIPHASH}{'all'};
391 expect => <<'#10...........',
392 print 0 + '42 EUR'; # 42
399 expect => <<'#11...........',
400 print 0+ '42 EUR'; # 42
407 expect => <<'#12...........',
410 for $i ( 1 .. 10 ) { $l[$i] = "T"; $w[$i] = 999999; }
418 for ( 1 .. $y ) { $x .= chr( int( rand( 126 - 33 ) + 33 ) ); }
427 $t -= ( $b - $a ) * 2;
432 print "You scored $t points\r\nTopTen\r\n";
441 else { $l[$i] = $q[$z]; $w[$i] = $p[$z]; $z++; }
442 print $l[$i], "\t", $w[$i], "\r\n";
451 expect => <<'#13...........',
452 $rinfo{deleteStyle} = [
454 -stipple => '@' . Tk->findINC('demos/images/grey.25'),
462 expect => <<'#14...........',
463 # previously this caused an incorrect error message after '2.42'
464 use lib "$Common::global::gInstallRoot/lib";
465 use CGI 2.42 qw(fatalsToBrowser);
468 # the 0666 must expect an operator
469 use constant MODE => do { 0666 & ( 0777 & ~umask ) };
478 expect => <<'#15...........',
479 # Keep the space before the '()' here:
483 use Foo::Bar qw(baz);
484 use Foo::Bar 1.0 qw(baz);
489 source => "version1",
491 expect => <<'#16...........',
492 # VERSION statement unbroken, no semicolon added;
493 our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }
498 source => "version2",
500 expect => <<'#17...........',
501 # On one line so MakeMaker will see it.
502 require Exporter; our $VERSION = $Exporter::VERSION;
509 expect => <<'#18...........',
510 # if $w->vert is tokenized as type 'U' then the ? will start a quote
511 # and an error will occur.
516 $w->vert ? $w->delta_width(0) : $w->delta_height(0);
524 expect => <<'#19...........',
525 # perltidy -act=2 -vmll will leave these intact and greater than 80 columns
526 # in length, which is what vmll does
528 is_deeply( \@init_metas_called, [1] )
529 || diag( Dumper( \@init_metas_called ) );
532 This has the comma on the next line exception {
533 Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)
541 expect => <<'#20...........',
542 # perltidy -act=2 -vmll will leave these intact and greater than 80 columns
543 # in length, which is what vmll does
544 BEGIN {is_deeply(\@init_metas_called, [1]) || diag(Dumper(\@init_metas_called))}
546 This has the comma on the next line exception {
547 Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)
553 my $ntests = 0 + keys %{$rtests};
554 plan tests => $ntests;
561 foreach my $key ( sort keys %{$rtests} ) {
563 my $sname = $rtests->{$key}->{source};
564 my $expect = $rtests->{$key}->{expect};
565 my $pname = $rtests->{$key}->{params};
566 my $source = $rsources->{$sname};
567 my $params = defined($pname) ? $rparams->{$pname} : "";
569 my $errorfile_string;
570 my $err = Perl::Tidy::perltidy(
572 destination => \$output,
573 perltidyrc => \$params,
574 argv => '', # for safety; hide any ARGV from perltidy
575 stderr => \$stderr_string,
576 errorfile => \$errorfile_string, # not used when -se flag is set
578 if ( $err || $stderr_string || $errorfile_string ) {
579 print STDERR "Error output received for test '$key'\n";
581 print STDERR "An error flag '$err' was returned\n";
584 if ($stderr_string) {
585 print STDERR "---------------------\n";
586 print STDERR "<<STDERR>>\n$stderr_string\n";
587 print STDERR "---------------------\n";
588 ok( !$stderr_string );
590 if ($errorfile_string) {
591 print STDERR "---------------------\n";
592 print STDERR "<<.ERR file>>\n$errorfile_string\n";
593 print STDERR "---------------------\n";
594 ok( !$errorfile_string );
598 if ( !is( $output, $expect, $key ) ) {
599 my $leno = length($output);
600 my $lene = length($expect);
601 if ( $leno == $lene ) {
603 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
607 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";