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' => <<'----------',
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");
374 my $app = App::perlbrew->new( "install-patchperl", "-q" );
382 Mojo::IOLoop->next_tick(
388 push @kept_alive, pop->kept_alive;
389 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
397 sswitch( $words[ rand @words ] )
402 case $words[3]: { 'ok' }
421 expect => <<'#8...........',
424 : $type eq 'item' ? "the $section entry"
425 : "the section on $section"
429 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
430 : ' elsewhere in this document'
445 my @globlist = ( grep { defined } @opt{qw( l q S t )} )
448 opendir DIR, './' or die "can't opendir './': $!";
449 my @a = grep { not /^\.+$/ } readdir DIR;
460 expect => <<'#9...........',
463 : $type eq 'item' ? "the $section entry"
464 : "the section on $section"
468 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
469 : ' elsewhere in this document'
484 my @globlist = ( grep { defined } @opt{qw( l q S t )} )
487 opendir DIR, './' or die "can't opendir './': $!";
488 my @a = grep { not /^\.+$/ } readdir DIR;
499 expect => <<'#10...........',
502 : $type eq 'item' ? "the $section entry"
503 : "the section on $section"
506 ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
507 : ' elsewhere in this document'
512 ? { 'a' => 'a value',
521 my @globlist = ( grep {defined} @opt{qw( l q S t )} )
524 opendir DIR, './' or die "can't opendir './': $!";
525 my @a = grep { not /^\.+$/ } readdir DIR;
536 expect => <<'#11...........',
537 # a useful parsing test from 'signatures.t'
538 use feature "signatures";
539 no warnings "experimental::signatures";
557 'mangle4.mangle' => {
560 expect => <<'#12...........',
561 # a useful parsing test from 'signatures.t'
562 use feature "signatures";
563 no warnings "experimental::signatures";
581 source => "extrude5",
583 expect => <<'#13...........',
589 'extrude5.extrude' => {
590 source => "extrude5",
592 expect => <<'#14...........',
606 expect => <<'#15...........',
607 $this_env = join( "",
608 $before, $closures, $contents, ( $defenv ? '' : &balance_tags() ),
612 method 'foo1' => [ Int, Int ] => sub {
613 my ( $self, $x, $y ) = ( shift, @_ );
617 method 'foo2' => [ Int, Int ] => sub {
618 my ( $self, $x, $y ) = ( shift, @_ );
628 expect => <<'#16...........',
630 "", $before, $closures
632 , ( $defenv ? '' : &balance_tags() )
640 my ( $self, $x, $y ) = ( shift, @_ );
647 my ( $self, $x, $y ) = ( shift, @_ );
657 expect => <<'#17...........',
658 # git#45 -vtc=n and -wn were not working together
660 $self->_add_fqdn_host(
669 # do not stack )->pack(
670 my $hlist = $control::control->Scrolled(
686 expect => <<'#18...........',
687 # git#45 -vtc=n and -wn were not working together
688 if ( $self->_add_fqdn_host(
695 # do not stack )->pack(
696 my $hlist = $control::control->Scrolled(
711 expect => <<'#19...........',
712 my @field : field : Default(1) : Get('Name' => 'foo') : Set('Name');
717 my $ntests = 0 + keys %{$rtests};
718 plan tests => $ntests;
725 foreach my $key ( sort keys %{$rtests} ) {
727 my $sname = $rtests->{$key}->{source};
728 my $expect = $rtests->{$key}->{expect};
729 my $pname = $rtests->{$key}->{params};
730 my $source = $rsources->{$sname};
731 my $params = defined($pname) ? $rparams->{$pname} : "";
733 my $errorfile_string;
734 my $err = Perl::Tidy::perltidy(
736 destination => \$output,
737 perltidyrc => \$params,
738 argv => '', # for safety; hide any ARGV from perltidy
739 stderr => \$stderr_string,
740 errorfile => \$errorfile_string, # not used when -se flag is set
742 if ( $err || $stderr_string || $errorfile_string ) {
743 print STDERR "Error output received for test '$key'\n";
745 print STDERR "An error flag '$err' was returned\n";
748 if ($stderr_string) {
749 print STDERR "---------------------\n";
750 print STDERR "<<STDERR>>\n$stderr_string\n";
751 print STDERR "---------------------\n";
752 ok( !$stderr_string );
754 if ($errorfile_string) {
755 print STDERR "---------------------\n";
756 print STDERR "<<.ERR file>>\n$errorfile_string\n";
757 print STDERR "---------------------\n";
758 ok( !$errorfile_string );
762 if ( !is( $output, $expect, $key ) ) {
763 my $leno = length($output);
764 my $lene = length($expect);
765 if ( $leno == $lene ) {
767 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
771 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";