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 ", $c->br(), "Area "
606 { -valign => 'top' },
609 -name => "discipline",
610 -values => [@discipValues],
611 -labels => \%discipLabels,
612 -default => "$discipline"
620 { -valign => 'top' },
626 { -valign => 'top' },
627 $c->strong(" Relevant Subject Area "),
629 "You may select multiple areas",
632 { -valign => 'top' },
636 -values => [@subjValues],
637 -labels => \%subjLabels,
638 -defaults => [@subject],
647 { -valign => 'top' },
650 $c->strong("Location<BR>"),
651 $c->small("(ie, where to find it)"),
655 -default => "$location",
661 { -valign => 'top' },
667 { -valign => 'top' },
668 "Description", $c->br(),
669 $c->small("Maximum 750 letters.")
672 { -valign => 'top' },
675 -name => "description",
676 -default => "$description",
693 expect => <<'#6...........',
694 # The space after the '?' is essential and must not be deleted
695 print $::opt_m ? " Files: " . my_wrap( "", " ", $v ) : $v;
699 'mangle1.mangle' => {
702 expect => <<'#7...........',
703 # The space after the '?' is essential and must not be deleted
704 print$::opt_m ? " Files: ".my_wrap(""," ",$v):$v;
711 expect => <<'#8...........',
712 # hanging side comments - do not remove leading space with -mangle
713 if ( $size1 == 0 || $size2 == 0 ) { # special handling for zero-length
714 if ( $size2 + $size1 == 0 ) { # files.
717 else { # Can't we say 'differ at byte zero'
718 # and so on here? That might make
719 # more sense than this behavior.
720 # Also, this should be made consistent
721 # with the behavior when skip >=
724 warn "$0: EOF on $file1\n" unless $size1;
725 warn "$0: EOF on $file2\n" unless $size2;
734 'mangle2.mangle' => {
737 expect => <<'#9...........',
738 # hanging side comments - do not remove leading space with -mangle
739 if($size1==0||$size2==0){# special handling for zero-length
740 if($size2+$size1==0){# files.
741 exit 0;}else{# Can't we say 'differ at byte zero'
742 # and so on here? That might make
743 # more sense than this behavior.
744 # Also, this should be made consistent
745 # with the behavior when skip >=
747 if($volume){warn"$0: EOF on $file1\n" unless$size1;
748 warn"$0: EOF on $file2\n" unless$size2;}exit 1;}}
755 expect => <<'#10...........',
757 # Troublesome punctuation variables: $$ and $#
759 # don't delete ws between '$$' and 'if'
760 kill 'ABRT', $$ if $panic++;
762 # Do not remove the space between '$#' and 'eq'
763 $, = "Hello, World!\n";
766 $# eq $, ? print "yes\n" : print "no\n";
768 # The space after the '?' is essential and must not be deleted
769 print $::opt_m ? " Files: " . my_wrap( "", " ", $v ) : $v;
771 # must not remove space before 'CAKE'
772 use constant CAKE => atan2( 1, 1 ) / 2;
773 if ( $arc >= - CAKE && $arc <= CAKE ) {
776 # do not remove the space after 'JUNK':
777 print JUNK ( "<", "&", ">" )[ rand(3) ]; # make these a bit more likely
781 'mangle3.mangle' => {
784 expect => <<'#11...........',
786 # Troublesome punctuation variables: $$ and $#
787 # don't delete ws between '$$' and 'if'
788 kill 'ABRT',$$ if$panic++;
789 # Do not remove the space between '$#' and 'eq'
790 $,="Hello, World!\n";
793 $# eq$,?print"yes\n":print"no\n";
794 # The space after the '?' is essential and must not be deleted
795 print$::opt_m ? " Files: ".my_wrap(""," ",$v):$v;
796 # must not remove space before 'CAKE'
797 use constant CAKE=>atan2(1,1)/2;
798 if($arc>=- CAKE&&$arc<=CAKE){}
799 # do not remove the space after 'JUNK':
800 print JUNK ("<","&",">")[rand(3)];# make these a bit more likely
807 expect => <<'#12...........',
809 [ -0.060, -0.060, 0. ],
810 [ 0.060, -0.060, 0. ],
811 [ 0.060, 0.060, 0. ],
812 [ -0.060, 0.060, 0. ],
813 [ -0.0925, -0.0925, 0.092 ],
814 [ 0.0925, -0.0925, 0.092 ],
815 [ 0.0925, 0.0925, 0.092 ],
816 [ -0.0925, 0.0925, 0.092 ],
824 expect => <<'#13...........',
838 expect => <<'#14...........',
841 $index_x * $xgridwidth * $xm +
842 ( $map_x * $xm * $xgridwidth ) / $detailwidth,
844 $index_y * $ygridwidth * $ym -
845 ( $map_y * $ym * $ygridwidth ) / $detailheight,
853 expect => <<'#15...........',
854 my $u = ( $range * $pratio**( 1. / 3. ) ) / $wratio;
855 my $factor = exp( -( 18 / $u )**4 );
856 my $ovp = ( 1 - $factor ) * ( 70 - 0.655515 * $u ) +
857 ( 1000 / ( $u**1.3 ) + 10000 / ( $u**3.3 ) ) * $factor;
859 ( 1 - $factor ) * ( 170 - $u ) + ( 350 / $u**0.65 + 500 / $u**5 ) * $factor;
860 $ovp = $ovp * $pratio;
861 $impulse = $impulse * $wratio * $pratio**( 2 / 3 );
868 expect => <<'#16...........',
869 # will break and add semicolon unless -nasc is given
871 $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
879 expect => <<'#17...........',
880 # will break and add semicolon unless -nasc is given
882 $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }
890 expect => <<'#18...........',
894 'nothing.nothing' => {
897 expect => <<'#19...........',
904 expect => <<'#20...........',
910 : ref $_ eq "ARRAY" ? join ':', @$_
912 : die "INVALID SLICE DEF $_"
920 my $ntests = 0 + keys %{$rtests};
921 plan tests => $ntests;
928 foreach my $key ( sort keys %{$rtests} ) {
930 my $sname = $rtests->{$key}->{source};
931 my $expect = $rtests->{$key}->{expect};
932 my $pname = $rtests->{$key}->{params};
933 my $source = $rsources->{$sname};
934 my $params = defined($pname) ? $rparams->{$pname} : "";
936 my $errorfile_string;
937 my $err = Perl::Tidy::perltidy(
939 destination => \$output,
940 perltidyrc => \$params,
941 argv => '', # for safety; hide any ARGV from perltidy
942 stderr => \$stderr_string,
943 errorfile => \$errorfile_string, # not used when -se flag is set
945 if ( $err || $stderr_string || $errorfile_string ) {
948 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
951 if ($stderr_string) {
952 print STDERR "---------------------\n";
953 print STDERR "<<STDERR>>\n$stderr_string\n";
954 print STDERR "---------------------\n";
956 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
957 ok( !$stderr_string );
959 if ($errorfile_string) {
960 print STDERR "---------------------\n";
961 print STDERR "<<.ERR file>>\n$errorfile_string\n";
962 print STDERR "---------------------\n";
964 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
965 ok( !$errorfile_string );
969 ok( $output, $expect );