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 ###########################################
42 'vtc' => <<'----------',
50 ############################
51 # BEGIN SECTION 2: Sources #
52 ############################
55 'vtc1' => <<'----------',
57 [ 'Dr. Watson', undef, '221b', 'Baker St.',
58 undef, 'London', 'NW1', undef,
61 [ 'Sam Gamgee', undef, undef, 'Bagshot Row',
62 undef, 'Hobbiton', undef, undef,
67 'vtc2' => <<'----------',
70 SOAP::Data->name('getStateName')
71 ->attr( { xmlns => 'urn:/My/Examples' } ),
73 )->result eq 'Alabama'
77 'vtc3' => <<'----------',
79 "Sunday", "Monday", "Tuesday", "Wednesday",
80 "Thursday", "Friday", "Saturday", "Sunday"
84 'vtc4' => <<'----------',
85 my$bg_color=$im->colorAllocate(unpack('C3',pack('H2H2H2',unpack('a2a2a2',(length($options_r->{'bg_color'})?$options_r->{'bg_color'}:$MIDI::Opus::BG_color)))));
88 'wn1' => <<'----------',
89 my $bg_color = $im->colorAllocate(
97 length( $options_r->{'bg_color'} )
98 ? $options_r->{'bg_color'}
99 : $MIDI::Opus::BG_color
107 'wn2' => <<'----------',
108 if ($PLATFORM eq 'aix') {
118 'wn3' => <<'----------',
119 deferred->resolve->then(
121 push @out, 'Resolve';
132 'wn4' => <<'----------',
134 # Orignal formatting looks nice but would be hard to duplicate
135 return exists $G->{ Attr }->{ E } &&
136 exists $G->{ Attr }->{ E }->{ $u } &&
137 exists $G->{ Attr }->{ E }->{ $u }->{ $v } ?
138 %{ $G->{ Attr }->{ E }->{ $u }->{ $v } } :
143 'wn5' => <<'----------',
159 'wn6' => <<'----------',
160 # illustration of some do-not-weld rules
162 # do not weld a two-line function call
163 $trans->add_transformation( PDL::Graphics::TriD::Scale->new( $sx, $sy, $sz ) );
165 # but weld this more complex statement
166 my $compass = uc( opposite_direction( line_to_canvas_direction(
167 @{ $coords[0] }, @{ $coords[1] } ) ) );
169 # do not weld to a one-line block because the function could get separated
170 # from its opening paren
172 ( sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } );
174 # another example; do not weld because the sub is not broken
175 $wrapped->add_around_modifier(
176 sub { push @tracelog => 'around 1'; $_[0]->(); } );
178 # but okay to weld here because the sub is broken
179 $wrapped->add_around_modifier( sub {
180 push @tracelog => 'around 1'; $_[0]->(); } );
184 ####################################
185 # BEGIN SECTION 3: Expected output #
186 ####################################
192 expect => <<'#1...........',
195 'Dr. Watson', undef, '221b', 'Baker St.',
196 undef, 'London', 'NW1', undef,
200 'Sam Gamgee', undef, undef, 'Bagshot Row',
201 undef, 'Hobbiton', undef, undef,
211 expect => <<'#2...........',
214 'Dr. Watson', undef, '221b', 'Baker St.',
215 undef, 'London', 'NW1', undef,
218 'Sam Gamgee', undef, undef, 'Bagshot Row',
219 undef, 'Hobbiton', undef, undef,
220 'The Shire', undef ], );
227 expect => <<'#3...........',
230 SOAP::Data->name('getStateName')
231 ->attr( { xmlns => 'urn:/My/Examples' } ),
233 )->result eq 'Alabama'
241 expect => <<'#4...........',
244 SOAP::Data->name('getStateName')
245 ->attr( { xmlns => 'urn:/My/Examples' } ),
246 1 )->result eq 'Alabama' );
253 expect => <<'#5...........',
255 "Sunday", "Monday", "Tuesday", "Wednesday",
256 "Thursday", "Friday", "Saturday", "Sunday"
264 expect => <<'#6...........',
266 "Sunday", "Monday", "Tuesday", "Wednesday",
267 "Thursday", "Friday", "Saturday", "Sunday" )[$wday];
274 expect => <<'#7...........',
275 my $bg_color = $im->colorAllocate(
283 length( $options_r->{'bg_color'} )
284 ? $options_r->{'bg_color'}
285 : $MIDI::Opus::BG_color
297 expect => <<'#8...........',
298 my $bg_color = $im->colorAllocate(
306 length( $options_r->{'bg_color'} )
307 ? $options_r->{'bg_color'}
308 : $MIDI::Opus::BG_color ) ) ) ) );
315 expect => <<'#9...........',
316 my $bg_color = $im->colorAllocate(
324 length( $options_r->{'bg_color'} )
325 ? $options_r->{'bg_color'}
326 : $MIDI::Opus::BG_color
338 expect => <<'#10...........',
339 my $bg_color = $im->colorAllocate( unpack(
346 length( $options_r->{'bg_color'} )
347 ? $options_r->{'bg_color'}
348 : $MIDI::Opus::BG_color
359 expect => <<'#11...........',
360 if ( $PLATFORM eq 'aix' ) {
378 expect => <<'#12...........',
379 if ( $PLATFORM eq 'aix' ) {
393 expect => <<'#13...........',
394 deferred->resolve->then(
396 push @out, 'Resolve';
411 expect => <<'#14...........',
412 deferred->resolve->then( sub {
413 push @out, 'Resolve';
425 expect => <<'#15...........',
429 # Orignal formatting looks nice but would be hard to duplicate
431 exists $G->{Attr}->{E}
432 && exists $G->{Attr}->{E}->{$u}
433 && exists $G->{Attr}->{E}->{$u}->{$v}
434 ? %{ $G->{Attr}->{E}->{$u}->{$v} }
445 expect => <<'#16...........',
448 # Orignal formatting looks nice but would be hard to duplicate
450 exists $G->{Attr}->{E}
451 && exists $G->{Attr}->{E}->{$u} && exists $G->{Attr}->{E}->{$u}->{$v}
452 ? %{ $G->{Attr}->{E}->{$u}->{$v} }
461 expect => <<'#17...........',
481 expect => <<'#18...........',
499 expect => <<'#19...........',
500 # illustration of some do-not-weld rules
502 # do not weld a two-line function call
503 $trans->add_transformation(
504 PDL::Graphics::TriD::Scale->new( $sx, $sy, $sz ) );
506 # but weld this more complex statement
509 line_to_canvas_direction(
510 @{ $coords[0] }, @{ $coords[1] }
515 # do not weld to a one-line block because the function could get separated
516 # from its opening paren
518 sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } );
520 # another example; do not weld because the sub is not broken
521 $wrapped->add_around_modifier(
522 sub { push @tracelog => 'around 1'; $_[0]->(); } );
524 # but okay to weld here because the sub is broken
525 $wrapped->add_around_modifier(
527 push @tracelog => 'around 1';
537 expect => <<'#20...........',
538 # illustration of some do-not-weld rules
540 # do not weld a two-line function call
541 $trans->add_transformation(
542 PDL::Graphics::TriD::Scale->new( $sx, $sy, $sz ) );
544 # but weld this more complex statement
545 my $compass = uc( opposite_direction( line_to_canvas_direction(
546 @{ $coords[0] }, @{ $coords[1] }
549 # do not weld to a one-line block because the function could get separated
550 # from its opening paren
552 sub { $morexxxxxxxxxxxxxxxxxx .= $_[1] . ":" . $_[0] . "\n" } );
554 # another example; do not weld because the sub is not broken
555 $wrapped->add_around_modifier(
556 sub { push @tracelog => 'around 1'; $_[0]->(); } );
558 # but okay to weld here because the sub is broken
559 $wrapped->add_around_modifier( sub {
560 push @tracelog => 'around 1';
567 my $ntests = 0 + keys %{$rtests};
568 plan tests => $ntests;
575 foreach my $key ( sort keys %{$rtests} ) {
577 my $sname = $rtests->{$key}->{source};
578 my $expect = $rtests->{$key}->{expect};
579 my $pname = $rtests->{$key}->{params};
580 my $source = $rsources->{$sname};
581 my $params = defined($pname) ? $rparams->{$pname} : "";
583 my $errorfile_string;
584 my $err = Perl::Tidy::perltidy(
586 destination => \$output,
587 perltidyrc => \$params,
588 argv => '', # for safety; hide any ARGV from perltidy
589 stderr => \$stderr_string,
590 errorfile => \$errorfile_string, # not used when -se flag is set
592 if ( $err || $stderr_string || $errorfile_string ) {
595 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
598 if ($stderr_string) {
599 print STDERR "---------------------\n";
600 print STDERR "<<STDERR>>\n$stderr_string\n";
601 print STDERR "---------------------\n";
603 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
604 ok( !$stderr_string );
606 if ($errorfile_string) {
607 print STDERR "---------------------\n";
608 print STDERR "<<.ERR file>>\n$errorfile_string\n";
609 print STDERR "---------------------\n";
611 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
612 ok( !$errorfile_string );
616 ok( $output, $expect );