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 'mangle' => "--mangle",
48 ############################
49 # BEGIN SECTION 2: Sources #
50 ############################
53 'list1' => <<'----------',
54 %height=("letter",27.9, "legal",35.6, "arche",121.9, "archd",91.4, "archc",61,
55 "archb",45.7, "archa",30.5, "flsa",33, "flse",33, "halfletter",21.6,
56 "11x17",43.2, "ledger",27.9);
57 %width=("letter",21.6, "legal",21.6, "arche",91.4, "archd",61, "archc",45.7,
58 "archb",30.5, "archa",22.9, "flsa",21.6, "flse",21.6, "halfletter",14,
59 "11x17",27.9, "ledger",43.2);
62 'listop1' => <<'----------',
63 my @sorted = map { $_->[0] }
64 sort { $a->[1] <=> $b->[1] }
65 map { [ $_, rand ] } @list;
68 'listop2' => <<'----------',
70 map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, rand ] } @list;
73 'lp1' => <<'----------',
74 # a good test problem for -lp; thanks to Ian Stuart
85 -default => "$author",
90 $c->strong(" Publication Date "),
94 -default => "$pub_date",
100 { -valign => 'top' },
107 -default => "$title",
114 { -valign => 'top' },
118 $c->td( { -valign => 'top' }, $c->strong(" Document Type ") ),
120 { -valign => 'top' },
124 -values => [@docCodeValues],
125 -labels => \%docCodeLabels,
126 -default => "$doc_type"
136 { -valign => 'top' },
137 $c->strong( " Relevant Discipline ", $c->br(), "Area " )
140 { -valign => 'top' },
143 -name => "discipline",
144 -values => [@discipValues],
145 -labels => \%discipLabels,
146 -default => "$discipline"
154 { -valign => 'top' },
160 { -valign => 'top' }, $c->strong(" Relevant Subject Area "),
161 $c->br(), "You may select multiple areas",
164 { -valign => 'top' },
168 -values => [@subjValues],
169 -labels => \%subjLabels,
170 -defaults => [@subject],
179 { -valign => 'top' },
182 $c->strong("Location<BR>"),
183 $c->small("(ie, where to find it)"),
187 -default => "$location",
193 { -valign => 'top' },
199 { -valign => 'top' }, "Description",
200 $c->br(), $c->small("Maximum 750 letters.")
203 { -valign => 'top' },
206 -name => "description",
207 -default => "$description",
220 'mangle1' => <<'----------',
221 # The space after the '?' is essential and must not be deleted
222 print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
225 'mangle2' => <<'----------',
226 # hanging side comments - do not remove leading space with -mangle
227 if ( $size1 == 0 || $size2 == 0 ) { # special handling for zero-length
228 if ( $size2 + $size1 == 0 ) { # files.
231 else { # Can't we say 'differ at byte zero'
232 # and so on here? That might make
233 # more sense than this behavior.
234 # Also, this should be made consistent
235 # with the behavior when skip >=
238 warn "$0: EOF on $file1\n" unless $size1;
239 warn "$0: EOF on $file2\n" unless $size2;
247 'mangle3' => <<'----------',
249 # Troublesome punctuation variables: $$ and $#
251 # don't delete ws between '$$' and 'if'
252 kill 'ABRT', $$ if $panic++;
254 # Do not remove the space between '$#' and 'eq'
255 $, = "Hello, World!\n";
258 $# eq $,? print "yes\n" : print "no\n";
260 # The space after the '?' is essential and must not be deleted
261 print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
263 # must not remove space before 'CAKE'
264 use constant CAKE => atan2(1,1)/2;
265 if ($arc >= - CAKE && $arc <= CAKE) {
268 # do not remove the space after 'JUNK':
269 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
272 'math1' => <<'----------',
273 my $xyz_shield = [ [ -0.060, -0.060, 0. ],
274 [ 0.060, -0.060, 0. ],
275 [ 0.060, 0.060, 0. ],
276 [ -0.060, 0.060, 0. ],
277 [ -0.0925, -0.0925, 0.092 ],
278 [ 0.0925, -0.0925, 0.092 ],
279 [ 0.0925, 0.0925, 0.092 ],
280 [ -0.0925, 0.0925, 0.092 ], ];
283 'math2' => <<'----------',
293 'math3' => <<'----------',
294 my ( $x, $y ) = ( $x0 + $index_x * $xgridwidth * $xm + ( $map_x * $xm * $xgridwidth ) / $detailwidth, $y0 - $index_y * $ygridwidth * $ym - ( $map_y * $ym * $ygridwidth ) / $detailheight,);
297 'math4' => <<'----------',
298 my$u=($range*$pratio**(1./3.))/$wratio;
299 my$factor=exp(-(18/$u)**4);
300 my$ovp=(1-$factor)*(70-0.655515*$u)+(1000/($u**1.3)+10000/($u**3.3))*$factor;
301 my$impulse=(1-$factor)*(170-$u)+(350/$u**0.65+500/$u**5)*$factor;
303 $impulse=$impulse*$wratio*$pratio**(2/3);
306 'nasc' => <<'----------',
307 # will break and add semicolon unless -nasc is given
308 eval { $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } };
311 'nothing' => <<'----------',
314 'otr1' => <<'----------',
320 : ref $_ eq "ARRAY" ? join ':', @$_
322 : die "INVALID SLICE DEF $_"
329 ####################################
330 # BEGIN SECTION 3: Expected output #
331 ####################################
337 expect => <<'#1...........',
339 "letter", 27.9, "legal", 35.6, "arche", 121.9,
340 "archd", 91.4, "archc", 61, "archb", 45.7,
341 "archa", 30.5, "flsa", 33, "flse", 33,
342 "halfletter", 21.6, "11x17", 43.2, "ledger", 27.9
345 "letter", 21.6, "legal", 21.6, "arche", 91.4,
346 "archd", 61, "archc", 45.7, "archb", 30.5,
347 "archa", 22.9, "flsa", 21.6, "flse", 21.6,
348 "halfletter", 14, "11x17", 27.9, "ledger", 43.2
356 expect => <<'#2...........',
357 my @sorted = map { $_->[0] }
358 sort { $a->[1] <=> $b->[1] }
359 map { [ $_, rand ] } @list;
366 expect => <<'#3...........',
368 map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, rand ] } @list;
375 expect => <<'#4...........',
376 # a good test problem for -lp; thanks to Ian Stuart
381 { -valign => 'top' },
387 -default => "$author",
392 $c->strong(" Publication Date "),
396 -default => "$pub_date",
402 { -valign => 'top' },
409 -default => "$title",
416 { -valign => 'top' },
421 { -valign => 'top' },
422 $c->strong(" Document Type ")
425 { -valign => 'top' },
429 -values => [@docCodeValues],
430 -labels => \%docCodeLabels,
431 -default => "$doc_type"
441 { -valign => 'top' },
443 " Relevant Discipline ", $c->br(), "Area "
447 { -valign => 'top' },
450 -name => "discipline",
451 -values => [@discipValues],
452 -labels => \%discipLabels,
453 -default => "$discipline"
461 { -valign => 'top' },
467 { -valign => 'top' },
468 $c->strong(" Relevant Subject Area "),
470 "You may select multiple areas",
473 { -valign => 'top' },
477 -values => [@subjValues],
478 -labels => \%subjLabels,
479 -defaults => [@subject],
488 { -valign => 'top' },
491 $c->strong("Location<BR>"),
492 $c->small("(ie, where to find it)"),
496 -default => "$location",
502 { -valign => 'top' },
508 { -valign => 'top' },
509 "Description", $c->br(),
510 $c->small("Maximum 750 letters.")
513 { -valign => 'top' },
516 -name => "description",
517 -default => "$description",
534 expect => <<'#5...........',
535 # a good test problem for -lp; thanks to Ian Stuart
540 { -valign => 'top' },
546 -default => "$author",
551 $c->strong(" Publication Date "),
555 -default => "$pub_date",
561 { -valign => 'top' },
568 -default => "$title",
575 { -valign => 'top' },
580 { -valign => 'top' },
581 $c->strong(" Document Type ")
584 { -valign => 'top' },
588 -values => [@docCodeValues],
589 -labels => \%docCodeLabels,
590 -default => "$doc_type"
600 { -valign => 'top' },
602 " Relevant Discipline ",
608 { -valign => 'top' },
611 -name => "discipline",
612 -values => [@discipValues],
613 -labels => \%discipLabels,
614 -default => "$discipline"
622 { -valign => 'top' },
628 { -valign => 'top' },
629 $c->strong(" Relevant Subject Area "),
631 "You may select multiple areas",
634 { -valign => 'top' },
638 -values => [@subjValues],
639 -labels => \%subjLabels,
640 -defaults => [@subject],
649 { -valign => 'top' },
652 $c->strong("Location<BR>"),
653 $c->small("(ie, where to find it)"),
657 -default => "$location",
663 { -valign => 'top' },
669 { -valign => 'top' },
672 $c->small("Maximum 750 letters.")
675 { -valign => 'top' },
678 -name => "description",
679 -default => "$description",
696 expect => <<'#6...........',
697 # The space after the '?' is essential and must not be deleted
698 print $::opt_m ? " Files: " . my_wrap( "", " ", $v ) : $v;
702 'mangle1.mangle' => {
705 expect => <<'#7...........',
706 # The space after the '?' is essential and must not be deleted
707 print$::opt_m ? " Files: ".my_wrap(""," ",$v):$v;
714 expect => <<'#8...........',
715 # hanging side comments - do not remove leading space with -mangle
716 if ( $size1 == 0 || $size2 == 0 ) { # special handling for zero-length
717 if ( $size2 + $size1 == 0 ) { # files.
720 else { # Can't we say 'differ at byte zero'
721 # and so on here? That might make
722 # more sense than this behavior.
723 # Also, this should be made consistent
724 # with the behavior when skip >=
727 warn "$0: EOF on $file1\n" unless $size1;
728 warn "$0: EOF on $file2\n" unless $size2;
737 'mangle2.mangle' => {
740 expect => <<'#9...........',
741 # hanging side comments - do not remove leading space with -mangle
742 if($size1==0||$size2==0){# special handling for zero-length
743 if($size2+$size1==0){# files.
744 exit 0;}else{# Can't we say 'differ at byte zero'
745 # and so on here? That might make
746 # more sense than this behavior.
747 # Also, this should be made consistent
748 # with the behavior when skip >=
750 if($volume){warn"$0: EOF on $file1\n" unless$size1;
751 warn"$0: EOF on $file2\n" unless$size2;}exit 1;}}
758 expect => <<'#10...........',
760 # Troublesome punctuation variables: $$ and $#
762 # don't delete ws between '$$' and 'if'
763 kill 'ABRT', $$ if $panic++;
765 # Do not remove the space between '$#' and 'eq'
766 $, = "Hello, World!\n";
769 $# eq $, ? print "yes\n" : print "no\n";
771 # The space after the '?' is essential and must not be deleted
772 print $::opt_m ? " Files: " . my_wrap( "", " ", $v ) : $v;
774 # must not remove space before 'CAKE'
775 use constant CAKE => atan2( 1, 1 ) / 2;
776 if ( $arc >= - CAKE && $arc <= CAKE ) {
779 # do not remove the space after 'JUNK':
780 print JUNK ( "<", "&", ">" )[ rand(3) ]; # make these a bit more likely
784 'mangle3.mangle' => {
787 expect => <<'#11...........',
789 # Troublesome punctuation variables: $$ and $#
790 # don't delete ws between '$$' and 'if'
791 kill 'ABRT',$$ if$panic++;
792 # Do not remove the space between '$#' and 'eq'
793 $,="Hello, World!\n";
796 $# eq$,?print"yes\n":print"no\n";
797 # The space after the '?' is essential and must not be deleted
798 print$::opt_m ? " Files: ".my_wrap(""," ",$v):$v;
799 # must not remove space before 'CAKE'
800 use constant CAKE=>atan2(1,1)/2;
801 if($arc>=- CAKE&&$arc<=CAKE){}
802 # do not remove the space after 'JUNK':
803 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
810 expect => <<'#12...........',
812 [ -0.060, -0.060, 0. ],
813 [ 0.060, -0.060, 0. ],
814 [ 0.060, 0.060, 0. ],
815 [ -0.060, 0.060, 0. ],
816 [ -0.0925, -0.0925, 0.092 ],
817 [ 0.0925, -0.0925, 0.092 ],
818 [ 0.0925, 0.0925, 0.092 ],
819 [ -0.0925, 0.0925, 0.092 ],
827 expect => <<'#13...........',
841 expect => <<'#14...........',
844 $index_x * $xgridwidth * $xm +
845 ( $map_x * $xm * $xgridwidth ) / $detailwidth,
847 $index_y * $ygridwidth * $ym -
848 ( $map_y * $ym * $ygridwidth ) / $detailheight,
856 expect => <<'#15...........',
857 my $u = ( $range * $pratio**( 1. / 3. ) ) / $wratio;
858 my $factor = exp( -( 18 / $u )**4 );
859 my $ovp = ( 1 - $factor ) * ( 70 - 0.655515 * $u ) +
860 ( 1000 / ( $u**1.3 ) + 10000 / ( $u**3.3 ) ) * $factor;
862 ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
863 $ovp = $ovp * $pratio;
864 $impulse = $impulse * $wratio * $pratio**( 2 / 3 );
871 expect => <<'#16...........',
872 # will break and add semicolon unless -nasc is given
874 $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
882 expect => <<'#17...........',
883 # will break and add semicolon unless -nasc is given
885 $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }
893 expect => <<'#18...........',
897 'nothing.nothing' => {
900 expect => <<'#19...........',
907 expect => <<'#20...........',
913 : ref $_ eq "ARRAY" ? join ':', @$_
915 : die "INVALID SLICE DEF $_"
923 my $ntests = 0 + keys %{$rtests};
924 plan tests => $ntests;
931 foreach my $key ( sort keys %{$rtests} ) {
933 my $sname = $rtests->{$key}->{source};
934 my $expect = $rtests->{$key}->{expect};
935 my $pname = $rtests->{$key}->{params};
936 my $source = $rsources->{$sname};
937 my $params = defined($pname) ? $rparams->{$pname} : "";
939 my $errorfile_string;
940 my $err = Perl::Tidy::perltidy(
942 destination => \$output,
943 perltidyrc => \$params,
944 argv => '', # for safety; hide any ARGV from perltidy
945 stderr => \$stderr_string,
946 errorfile => \$errorfile_string, # not used when -se flag is set
948 if ( $err || $stderr_string || $errorfile_string ) {
949 print STDERR "Error output received for test '$key'\n";
951 print STDERR "An error flag '$err' was returned\n";
954 if ($stderr_string) {
955 print STDERR "---------------------\n";
956 print STDERR "<<STDERR>>\n$stderr_string\n";
957 print STDERR "---------------------\n";
958 ok( !$stderr_string );
960 if ($errorfile_string) {
961 print STDERR "---------------------\n";
962 print STDERR "<<.ERR file>>\n$errorfile_string\n";
963 print STDERR "---------------------\n";
964 ok( !$errorfile_string );
968 if ( !is( $output, $expect, $key ) ) {
969 my $leno = length($output);
970 my $lene = length($expect);
971 if ( $leno == $lene ) {
973 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
977 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";