1 # Created with: ./make_t.pl
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
40 'bbhb2' => "-bbhb=2 -bbp=2",
41 'bbhb3' => "-bbhb=3 -bbp=3",
42 'bbhb4' => "-bbhb=3 -bbp=3 -bbhbi=2 -bbpi=2",
43 'bbhb5' => "-bbhb=3 -bbp=3 -bbhbi=1 -bbpi=1",
44 'boa' => <<'----------',
45 # -boa is default so we test nboa
48 'braces7' => <<'----------',
49 -bli -blil='*' -blixl='eval'
52 'extrude' => "--extrude",
53 'git45' => "-vtc=1 -wn",
54 'here_long' => "-l=33",
55 'kba1' => <<'----------',
58 'mangle' => "--mangle",
60 'xci2' => "-pbp -nst -nse -xci",
63 ############################
64 # BEGIN SECTION 2: Sources #
65 ############################
68 'bbhb' => <<'----------',
78 'boa' => <<'----------',
82 : Get('Name' => 'foo')
86 'braces' => <<'----------',
88 if ( !defined( $_[0] ) ) {
89 print("Hello, World\n");
97 print("Hello, World\n");
101 my $app = App::perlbrew->new( "install-patchperl", "-q" );
108 Mojo::IOLoop->next_tick(
112 push @kept_alive, pop->kept_alive;
113 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
120 sswitch( $words[ rand @words ] ) {
124 case $words[3]: { 'ok' }
137 'extrude5' => <<'----------',
142 'git45' => <<'----------',
143 # git#45 -vtc=n and -wn were not working together
145 $self->_add_fqdn_host(
154 # do not stack )->pack(
155 my $hlist = $control::control->Scrolled(
167 'here_long' => <<'----------',
168 # must not break after here target regardless of maximum-line-length
169 $sth= $dbh->prepare (<<"END_OF_SELECT") or die "Couldn't prepare SQL" ;
170 SELECT COUNT(duration),SUM(duration)
171 FROM logins WHERE username='$user'
176 'kba1' => <<'----------',
177 $this_env = join("", $before, $closures
179 , ($defenv ? '': &balance_tags())
180 , $reopens ); $_ = $after;
185 my ( $self, $x, $y ) = ( shift, @_ );
192 my ( $self, $x, $y ) = ( shift, @_ );
198 'mangle4' => <<'----------',
199 # a useful parsing test from 'signatures.t'
200 use feature "signatures";
201 no warnings "experimental::signatures";
218 'xci' => <<'----------',
221 : $type eq 'item' ? "the $section entry"
222 : "the section on $section"
226 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
227 : ' elsewhere in this document'
242 my @globlist = ( grep { defined } @opt{qw( l q S t )} )
245 opendir DIR, './' or die "can't opendir './': $!";
246 my @a = grep { not /^\.+$/ } readdir DIR;
254 ####################################
255 # BEGIN SECTION 3: Expected output #
256 ####################################
259 'here_long.here_long' => {
260 source => "here_long",
261 params => "here_long",
262 expect => <<'#1...........',
263 # must not break after here target regardless of maximum-line-length
264 $sth = $dbh->prepare(
265 <<"END_OF_SELECT") or die "Couldn't prepare SQL";
266 SELECT COUNT(duration),SUM(duration)
267 FROM logins WHERE username='$user'
276 expect => <<'#2...........',
292 expect => <<'#3...........',
308 expect => <<'#4...........',
322 expect => <<'#5...........',
338 expect => <<'#6...........',
351 'braces.braces7' => {
354 expect => <<'#7...........',
357 if ( !defined( $_[0] ) )
359 print("Hello, World\n");
363 print( $_[0], "\n" );
369 print("Hello, World\n");
373 my $app = App::perlbrew->new( "install-patchperl", "-q" );
381 Mojo::IOLoop->next_tick(
387 push @kept_alive, pop->kept_alive;
388 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
396 sswitch( $words[ rand @words ] )
401 case $words[3]: { 'ok' }
420 expect => <<'#8...........',
423 : $type eq 'item' ? "the $section entry"
424 : "the section on $section"
428 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
429 : ' elsewhere in this document'
444 my @globlist = ( grep { defined } @opt{qw( l q S t )} )
447 opendir DIR, './' or die "can't opendir './': $!";
448 my @a = grep { not /^\.+$/ } readdir DIR;
459 expect => <<'#9...........',
462 : $type eq 'item' ? "the $section entry"
463 : "the section on $section"
467 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
468 : ' elsewhere in this document'
483 my @globlist = ( grep { defined } @opt{qw( l q S t )} )
486 opendir DIR, './' or die "can't opendir './': $!";
487 my @a = grep { not /^\.+$/ } readdir DIR;
498 expect => <<'#10...........',
501 : $type eq 'item' ? "the $section entry"
502 : "the section on $section"
505 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
506 : ' elsewhere in this document'
511 ? { 'a' => 'a value',
520 my @globlist = ( grep {defined} @opt{qw( l q S t )} )
523 opendir DIR, './' or die "can't opendir './': $!";
524 my @a = grep { not /^\.+$/ } readdir DIR;
535 expect => <<'#11...........',
536 # a useful parsing test from 'signatures.t'
537 use feature "signatures";
538 no warnings "experimental::signatures";
556 'mangle4.mangle' => {
559 expect => <<'#12...........',
560 # a useful parsing test from 'signatures.t'
561 use feature "signatures";
562 no warnings "experimental::signatures";
580 source => "extrude5",
582 expect => <<'#13...........',
588 'extrude5.extrude' => {
589 source => "extrude5",
591 expect => <<'#14...........',
605 expect => <<'#15...........',
606 $this_env = join( "",
607 $before, $closures, $contents, ( $defenv ? '' : &balance_tags() ),
611 method 'foo1' => [ Int, Int ] => sub {
612 my ( $self, $x, $y ) = ( shift, @_ );
616 method 'foo2' => [ Int, Int ] => sub {
617 my ( $self, $x, $y ) = ( shift, @_ );
627 expect => <<'#16...........',
629 "", $before, $closures
631 , ( $defenv ? '' : &balance_tags() )
639 my ( $self, $x, $y ) = ( shift, @_ );
646 my ( $self, $x, $y ) = ( shift, @_ );
656 expect => <<'#17...........',
657 # git#45 -vtc=n and -wn were not working together
659 $self->_add_fqdn_host(
668 # do not stack )->pack(
669 my $hlist = $control::control->Scrolled(
685 expect => <<'#18...........',
686 # git#45 -vtc=n and -wn were not working together
687 if ( $self->_add_fqdn_host(
694 # do not stack )->pack(
695 my $hlist = $control::control->Scrolled(
710 expect => <<'#19...........',
711 my @field : field : Default(1) : Get('Name' => 'foo') : Set('Name');
716 my $ntests = 0 + keys %{$rtests};
717 plan tests => $ntests;
724 foreach my $key ( sort keys %{$rtests} ) {
726 my $sname = $rtests->{$key}->{source};
727 my $expect = $rtests->{$key}->{expect};
728 my $pname = $rtests->{$key}->{params};
729 my $source = $rsources->{$sname};
730 my $params = defined($pname) ? $rparams->{$pname} : "";
732 my $errorfile_string;
733 my $err = Perl::Tidy::perltidy(
735 destination => \$output,
736 perltidyrc => \$params,
737 argv => '', # for safety; hide any ARGV from perltidy
738 stderr => \$stderr_string,
739 errorfile => \$errorfile_string, # not used when -se flag is set
741 if ( $err || $stderr_string || $errorfile_string ) {
742 print STDERR "Error output received for test '$key'\n";
744 print STDERR "An error flag '$err' was returned\n";
747 if ($stderr_string) {
748 print STDERR "---------------------\n";
749 print STDERR "<<STDERR>>\n$stderr_string\n";
750 print STDERR "---------------------\n";
751 ok( !$stderr_string );
753 if ($errorfile_string) {
754 print STDERR "---------------------\n";
755 print STDERR "<<.ERR file>>\n$errorfile_string\n";
756 print STDERR "---------------------\n";
757 ok( !$errorfile_string );
761 if ( !is( $output, $expect, $key ) ) {
762 my $leno = length($output);
763 my $lene = length($expect);
764 if ( $leno == $lene ) {
766 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
770 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";