1 # Created with: ./make_t.pl
10 #7 hash_bang.hash_bang
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
40 'bol' => <<'----------',
41 # -bol is default, so test -nbol
44 'bot' => <<'----------',
45 # -bot is default so we test -nbot
49 'git47' => <<'----------',
50 # perltidyrc from git #47
51 -pbp # Start with Perl Best Practices
52 -w # Show all warnings
53 -iob # Ignore old breakpoints
54 -l=120 # 120 characters per line
55 -mbl=2 # No more than 2 blank lines
56 -i=2 # Indentation is 2 columns
57 -ci=2 # Continuation indentation is 2 columns
58 -vt=0 # Less vertical tightness
59 -pt=2 # High parenthesis tightness
60 -bt=2 # High brace tightness
61 -sbt=2 # High square bracket tightness
62 -wn # Weld nested containers
63 -isbc # Don't indent comments without leading space
64 -nst # Don't output to STDOUT
67 'listop1' => <<'----------',
68 # -bok is default so we test nbok
71 'sbcp1' => <<'----------',
74 'wnxl1' => <<'----------',
75 # only weld parens, and only if leading keyword
78 'wnxl2' => <<'----------',
79 # do not weld leading '['
82 'wnxl3' => <<'----------',
83 # do not weld interior or ending '{' without a keyword
87 'wnxl4' => <<'----------',
88 # do not weld except parens or trailing brace with keyword
93 ############################
94 # BEGIN SECTION 2: Sources #
95 ############################
98 'align34' => <<'----------',
99 # align all '{' and runs of '='
100 if ( $line =~ /^NAME>(.*)/i ) { $Cookies{'name'} = $1; }
101 elsif ( $line =~ /^EMAIL>(.*)/i ) { $email = $1; }
102 elsif ( $line =~ /^IP_ADDRESS>(.*)/i ) { $ipaddress = $1; }
103 elsif ( $line =~ /^<!--(.*)-->/i ) { $remoteuser = $1; }
104 elsif ( $line =~ /^PASSWORD>(.*)/i ) { next; }
105 elsif ( $line =~ /^IMAGE>(.*)/i ) { $image_url = $1; }
106 elsif ( $line =~ /^LINKNAME>(.*)/i ) { $linkname = $1; }
107 elsif ( $line =~ /^LINKURL>(.*)/i ) { $linkurl = $1; }
108 else { $body .= $line; }
111 'boa' => <<'----------',
115 : Get('Name' => 'foo')
119 'bol' => <<'----------',
120 return unless $cmd = $cmd || ($dot
121 && $Last_Shell) || &prompt('|');
124 'bot' => <<'----------',
131 'git47' => <<'----------',
134 sub { $all->resolve(@_); () },
136 $results->[$i] = [@_];
137 $all->reject(@$results) if --$remaining <= 0;
143 map { _is_scoped($_) ? $_ : [ [ [ 'pc', 'scope' ] ], ' ', @$_ ] }
146 $c->helpers->log->debug( sub {
148 my $method = $req->method;
149 my $path = $req->url->path->to_abs_string;
150 $c->helpers->timing->begin('mojo.timer');
151 return qq{$method "$path"};
152 } ) unless $stash->{'mojo.static'};
154 # A single signature var can weld
155 return Mojo::Promise->resolve($query_params)->then(&_reveal_event)->then(
157 return $c->render( text => '', status => $code );
162 'hash_bang' => <<'----------',
167 # above spaces will be retained with -x but not by default
169 my $date = localtime();
172 'listop1' => <<'----------',
173 my @sorted = map { $_->[0] }
174 sort { $a->[1] <=> $b->[1] }
175 map { [ $_, rand ] } @list;
178 'qw' => <<'----------',
179 # do not outdent ending ) more than initial qw line
181 @return = grep( /^$word/,
183 ! a b d h i m o q r u autobundle clean
184 make test install force reload look
188 # outdent ')' even if opening is not '('
191 i Re Im rho theta arg
199 # outdent '>' like ')'
202 i Re Im rho theta arg
210 # but ';' not outdented
213 i Re Im rho theta arg
222 'sbcp' => <<'----------',
224 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
231 'wnxl' => <<'----------',
232 if ( $PLATFORM eq 'aix' ) {
254 }} while ($n++ < 10);
256 threads->create( sub {
259 $hash2{hash} = \%hash3;
260 $hash3{"thread"} = "yes";
265 ####################################
266 # BEGIN SECTION 3: Expected output #
267 ####################################
273 expect => <<'#1...........',
277 : Get('Name' => 'foo')
285 expect => <<'#2...........',
286 return unless $cmd = $cmd || ( $dot && $Last_Shell ) || &prompt('|');
293 expect => <<'#3...........',
305 expect => <<'#4...........',
306 $foo = $condition ? undef : 1;
313 expect => <<'#5...........',
322 source => "hash_bang",
324 expect => <<'#6...........',
326 # above spaces will be retained with -x but not by default
328 my $date = localtime();
332 'hash_bang.hash_bang' => {
333 source => "hash_bang",
334 params => "hash_bang",
335 expect => <<'#7...........',
340 # above spaces will be retained with -x but not by default
342 my $date = localtime();
346 'listop1.listop1' => {
349 expect => <<'#8...........',
351 map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, rand ] } @list;
358 expect => <<'#9...........',
360 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
372 expect => <<'#10...........',
374 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
385 expect => <<'#11...........',
386 if ( $PLATFORM eq 'aix' ) {
414 } while ( $n++ < 10 );
420 $hash2{hash} = \%hash3;
421 $hash3{"thread"} = "yes";
430 expect => <<'#12...........',
431 if ( $PLATFORM eq 'aix' ) {
457 } while ( $n++ < 10 );
463 $hash2{hash} = \%hash3;
464 $hash3{"thread"} = "yes";
473 expect => <<'#13...........',
474 if ( $PLATFORM eq 'aix' ) {
494 } } while ( $n++ < 10 );
496 threads->create( sub {
499 $hash2{hash} = \%hash3;
500 $hash3{"thread"} = "yes";
508 expect => <<'#14...........',
509 if ( $PLATFORM eq 'aix' ) {
531 } while ( $n++ < 10 );
533 threads->create( sub {
536 $hash2{hash} = \%hash3;
537 $hash3{"thread"} = "yes";
545 expect => <<'#15...........',
546 if ( $PLATFORM eq 'aix' ) {
572 } while ( $n++ < 10 );
574 threads->create( sub {
577 $hash2{hash} = \%hash3;
578 $hash3{"thread"} = "yes";
586 expect => <<'#16...........',
587 # align all '{' and runs of '='
588 if ( $line =~ /^NAME>(.*)/i ) { $Cookies{'name'} = $1; }
589 elsif ( $line =~ /^EMAIL>(.*)/i ) { $email = $1; }
590 elsif ( $line =~ /^IP_ADDRESS>(.*)/i ) { $ipaddress = $1; }
591 elsif ( $line =~ /^<!--(.*)-->/i ) { $remoteuser = $1; }
592 elsif ( $line =~ /^PASSWORD>(.*)/i ) { next; }
593 elsif ( $line =~ /^IMAGE>(.*)/i ) { $image_url = $1; }
594 elsif ( $line =~ /^LINKNAME>(.*)/i ) { $linkname = $1; }
595 elsif ( $line =~ /^LINKURL>(.*)/i ) { $linkurl = $1; }
596 else { $body .= $line; }
603 expect => <<'#17...........',
606 sub { $all->resolve(@_); () },
608 $results->[$i] = [@_];
609 $all->reject(@$results) if --$remaining <= 0;
615 [ map { _is_scoped($_) ? $_ : [ [ [ 'pc', 'scope' ] ], ' ', @$_ ] }
619 $c->helpers->log->debug(
622 my $method = $req->method;
623 my $path = $req->url->path->to_abs_string;
624 $c->helpers->timing->begin('mojo.timer');
625 return qq{$method "$path"};
627 ) unless $stash->{'mojo.static'};
629 # A single signature var can weld
630 return Mojo::Promise->resolve($query_params)->then(&_reveal_event)->then(
632 return $c->render( text => '', status => $code );
641 expect => <<'#18...........',
644 sub { $all->resolve(@_); () },
646 $results->[$i] = [@_];
647 $all->reject(@$results) if --$remaining <= 0;
652 sub _absolutize { [map { _is_scoped($_) ? $_ : [[['pc', 'scope']], ' ', @$_] } @{shift()}] }
654 $c->helpers->log->debug(sub {
656 my $method = $req->method;
657 my $path = $req->url->path->to_abs_string;
658 $c->helpers->timing->begin('mojo.timer');
659 return qq{$method "$path"};
660 }) unless $stash->{'mojo.static'};
662 # A single signature var can weld
663 return Mojo::Promise->resolve($query_params)->then(&_reveal_event)->then(sub ($code) {
664 return $c->render(text => '', status => $code);
672 expect => <<'#19...........',
673 # do not outdent ending ) more than initial qw line
675 @return = grep( /^$word/,
677 ! a b d h i m o q r u autobundle clean
678 make test install force reload look
682 # outdent ')' even if opening is not '('
685 i Re Im rho theta arg
693 # outdent '>' like ')'
696 i Re Im rho theta arg
704 # but ';' not outdented
707 i Re Im rho theta arg
718 my $ntests = 0 + keys %{$rtests};
719 plan tests => $ntests;
726 foreach my $key ( sort keys %{$rtests} ) {
728 my $sname = $rtests->{$key}->{source};
729 my $expect = $rtests->{$key}->{expect};
730 my $pname = $rtests->{$key}->{params};
731 my $source = $rsources->{$sname};
732 my $params = defined($pname) ? $rparams->{$pname} : "";
734 my $errorfile_string;
735 my $err = Perl::Tidy::perltidy(
737 destination => \$output,
738 perltidyrc => \$params,
739 argv => '', # for safety; hide any ARGV from perltidy
740 stderr => \$stderr_string,
741 errorfile => \$errorfile_string, # not used when -se flag is set
743 if ( $err || $stderr_string || $errorfile_string ) {
744 print STDERR "Error output received for test '$key'\n";
746 print STDERR "An error flag '$err' was returned\n";
749 if ($stderr_string) {
750 print STDERR "---------------------\n";
751 print STDERR "<<STDERR>>\n$stderr_string\n";
752 print STDERR "---------------------\n";
753 ok( !$stderr_string );
755 if ($errorfile_string) {
756 print STDERR "---------------------\n";
757 print STDERR "<<.ERR file>>\n$errorfile_string\n";
758 print STDERR "---------------------\n";
759 ok( !$errorfile_string );
763 if ( !is( $output, $expect, $key ) ) {
764 my $leno = length($output);
765 my $lene = length($expect);
766 if ( $leno == $lene ) {
768 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
772 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";