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 ###########################################
41 'braces8' => <<'----------',
42 -bl -bbvt=1 -blxl=' ' -bll='sub do asub'
45 'git74' => <<'----------',
48 --maximum-line-length=120
50 --continuation-indentation=4
51 --closing-token-indentation=1
52 --want-left-space="= -> ( )"
53 --want-right-space="= -> ( )"
54 --space-function-paren
56 --space-terminal-semicolon
57 --opening-brace-on-new-line
58 --opening-sub-brace-on-new-line
59 --opening-anonymous-sub-brace-on-new-line
60 --brace-left-and-indent
61 --brace-left-and-indent-list="*"
62 --break-before-hash-brace=3
64 'git77' => <<'----------',
68 'novalign1' => "-novalign",
69 'novalign2' => "-nvsc -nvbc -msc=2",
70 'novalign3' => "-nvc",
71 'rt140025' => "-lp -xci -ci=4 -ce",
72 'vxl1' => <<'----------',
75 'vxl2' => <<'----------',
81 ############################
82 # BEGIN SECTION 2: Sources #
83 ############################
86 'bal' => <<'----------',
94 'braces' => <<'----------',
96 if ( !defined( $_[0] ) ) {
97 print("Hello, World\n");
100 print( $_[0], "\n" );
105 print("Hello, World\n");
109 my $app = App::perlbrew->new( "install-patchperl", "-q" );
116 Mojo::IOLoop->next_tick(
120 push @kept_alive, pop->kept_alive;
121 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
128 sswitch( $words[ rand @words ] ) {
132 case $words[3]: { 'ok' }
145 'git74' => <<'----------',
148 command => [ 'command', 'argument1', 'argument2' ],
156 my $test_var = $self->test_call( #
161 my $test_var = $self->test_call(
166 my $test_var = $self->test_call(
172 my $test_var = $self->test_call(
178 my $test_var = $self->test_call(
184 my $test_var = $self->test_call(
201 'git77' => <<'----------',
202 # These should format about the same with -gal='Map Grep'.
203 # NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
206 $_->init_arg => $_->get_value($instance) }
207 Grep { $_->has_value($instance) }
209 defined( $_->init_arg ) }
210 $class->get_all_attributes
215 $_->init_arg => $_->get_value($instance) }
216 grep { $_->has_value($instance) }
218 defined( $_->init_arg ) }
219 $class->get_all_attributes
223 'lp2' => <<'----------',
224 # test issue git #74, lost -lp when final anon sub brace followed by '}'
227 Init => sub { $self->init(@_) },
228 Mid => { sub { shift; $self->mid(@_) } },
229 Final => sub { shift; $self->final(@_) }
234 'novalign' => <<'----------',
236 # simple vertical alignment of '=' and '#'
237 # A long line to test -nvbc ... normally this will cause the previous line to move left
238 my $lines = 0; # checksum: #lines
239 my $bytes = 0; # checksum: #bytes
240 my $sum = 0; # checksum: system V sum
241 my $patchdata = 0; # saw patch data
242 my $pos = 0; # start of patch data
243 # a hanging side comment
244 my $endkit = 0; # saw end of kit
245 my $fail = 0; # failed
250 'rt140025' => <<'----------',
259 } elsif( defined $cpid ) {
261 open( STDIN, '<', '/dev/null' ) or die( "open3: $!\n" );
262 exec $cmd or die( "exec: $!\n" );
263 } elsif( $! == EAGAIN ) {
267 die( "Can't fork: $!\n" );
273 'vxl' => <<'----------',
274 # if equals is excluded then ternary is automatically excluded
275 # side comment alignments always remain
276 $co_description = ($color) ? 'bold cyan' : ''; # description
277 $co_prompt = ($color) ? 'bold green' : ''; # prompt
278 $co_unused = ($color) ? 'on_green' : 'reverse'; # unused
281 'xlp1' => <<'----------',
282 # test -xlp with comments, broken sub blocks, blank line, line length limit
283 $cb1 = $act_page->Checkbutton(
284 -text => M "Verwenden",
285 -variable => \$qualitaet_s_optimierung,
287 change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
300 ####################################
301 # BEGIN SECTION 3: Expected output #
302 ####################################
306 source => "novalign",
308 expect => <<'#1...........',
310 # simple vertical alignment of '=' and '#'
311 # A long line to test -nvbc ... normally this will cause the previous line to move left
312 my $lines = 0; # checksum: #lines
313 my $bytes = 0; # checksum: #bytes
314 my $sum = 0; # checksum: system V sum
315 my $patchdata = 0; # saw patch data
316 my $pos = 0; # start of patch data
317 # a hanging side comment
318 my $endkit = 0; # saw end of kit
319 my $fail = 0; # failed
325 'novalign.novalign1' => {
326 source => "novalign",
327 params => "novalign1",
328 expect => <<'#2...........',
330 # simple vertical alignment of '=' and '#'
331 # A long line to test -nvbc ... normally this will cause the previous line to move left
332 my $lines = 0; # checksum: #lines
333 my $bytes = 0; # checksum: #bytes
334 my $sum = 0; # checksum: system V sum
335 my $patchdata = 0; # saw patch data
336 my $pos = 0; # start of patch data
337 # a hanging side comment
338 my $endkit = 0; # saw end of kit
339 my $fail = 0; # failed
345 'novalign.novalign2' => {
346 source => "novalign",
347 params => "novalign2",
348 expect => <<'#3...........',
350 # simple vertical alignment of '=' and '#'
351 # A long line to test -nvbc ... normally this will cause the previous line to move left
352 my $lines = 0; # checksum: #lines
353 my $bytes = 0; # checksum: #bytes
354 my $sum = 0; # checksum: system V sum
355 my $patchdata = 0; # saw patch data
356 my $pos = 0; # start of patch data
357 # a hanging side comment
358 my $endkit = 0; # saw end of kit
359 my $fail = 0; # failed
365 'novalign.novalign3' => {
366 source => "novalign",
367 params => "novalign3",
368 expect => <<'#4...........',
370 # simple vertical alignment of '=' and '#'
371 # A long line to test -nvbc ... normally this will cause the previous line to move left
372 my $lines = 0; # checksum: #lines
373 my $bytes = 0; # checksum: #bytes
374 my $sum = 0; # checksum: system V sum
375 my $patchdata = 0; # saw patch data
376 my $pos = 0; # start of patch data
377 # a hanging side comment
378 my $endkit = 0; # saw end of kit
379 my $fail = 0; # failed
388 expect => <<'#5...........',
389 # test issue git #74, lost -lp when final anon sub brace followed by '}'
392 Init => sub { $self->init(@_) },
393 Mid => { sub { shift; $self->mid(@_) } },
394 Final => sub { shift; $self->final(@_) }
403 expect => <<'#6...........',
404 # test issue git #74, lost -lp when final anon sub brace followed by '}'
407 Init => sub { $self->init(@_) },
408 Mid => { sub { shift; $self->mid(@_) } },
409 Final => sub { shift; $self->final(@_) }
415 'braces.braces8' => {
418 expect => <<'#7...........',
420 { if ( !defined( $_[0] ) ) {
421 print("Hello, World\n");
424 print( $_[0], "\n" );
429 { print("Hello, World\n");
433 my $app = App::perlbrew->new( "install-patchperl", "-q" );
440 Mojo::IOLoop->next_tick(
444 { push @kept_alive, pop->kept_alive;
445 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
452 { sswitch( $words[ rand @words ] ) {
456 case $words[3]: { 'ok' }
471 source => "rt140025",
473 expect => <<'#8...........',
479 if ( $cpid = fork ) {
483 elsif ( defined $cpid ) {
485 open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
486 exec $cmd or die("exec: $!\n");
488 elsif ( $! == EAGAIN ) {
493 die("Can't fork: $!\n");
500 'rt140025.rt140025' => {
501 source => "rt140025",
502 params => "rt140025",
503 expect => <<'#9...........',
509 if ( $cpid = fork ) {
512 } elsif ( defined $cpid ) {
514 open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
515 exec $cmd or die("exec: $!\n");
516 } elsif ( $! == EAGAIN ) {
520 die("Can't fork: $!\n");
530 expect => <<'#10...........',
531 # test -xlp with comments, broken sub blocks, blank line, line length limit
532 $cb1 = $act_page->Checkbutton(
533 -text => M "Verwenden",
534 -variable => \$qualitaet_s_optimierung,
536 change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
552 expect => <<'#11...........',
553 # test -xlp with comments, broken sub blocks, blank line, line length limit
554 $cb1 = $act_page->Checkbutton(
555 -text => M "Verwenden",
556 -variable => \$qualitaet_s_optimierung,
558 change_state_all( $act_page1,
559 $qualitaet_s_optimierung, { $cb1 => 1 } )
575 expect => <<'#12...........',
578 command => [ 'command', 'argument1', 'argument2' ],
586 my $test_var = $self->test_call( #
591 my $test_var = $self->test_call(
596 my $test_var = $self->test_call(
602 my $test_var = $self->test_call(
608 my $test_var = $self->test_call(
614 my $test_var = $self->test_call(
635 expect => <<'#13...........',
638 command => [ 'command', 'argument1', 'argument2' ],
647 my $test_var = $self -> test_call ( #
652 my $test_var = $self -> test_call (
657 my $test_var = $self -> test_call (
663 my $test_var = $self -> test_call (
669 my $test_var = $self -> test_call (
675 my $test_var = $self -> test_call (
696 expect => <<'#14...........',
697 # These should format about the same with -gal='Map Grep'.
698 # NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
701 $_->init_arg => $_->get_value($instance)
702 } Grep { $_->has_value($instance) }
704 defined( $_->init_arg )
706 $class->get_all_attributes
710 map { $_->init_arg => $_->get_value($instance) }
711 grep { $_->has_value($instance) }
712 grep { defined( $_->init_arg ) } $class->get_all_attributes
720 expect => <<'#15...........',
721 # These should format about the same with -gal='Map Grep'.
722 # NOTE: The braces only align if the internal code flag ALIGN_GREP_ALIASES is set
724 Map { $_->init_arg => $_->get_value($instance) }
725 Grep { $_->has_value($instance) }
726 Grep { defined( $_->init_arg ) } $class->get_all_attributes
730 map { $_->init_arg => $_->get_value($instance) }
731 grep { $_->has_value($instance) }
732 grep { defined( $_->init_arg ) } $class->get_all_attributes
740 expect => <<'#16...........',
741 # if equals is excluded then ternary is automatically excluded
742 # side comment alignments always remain
743 $co_description = ($color) ? 'bold cyan' : ''; # description
744 $co_prompt = ($color) ? 'bold green' : ''; # prompt
745 $co_unused = ($color) ? 'on_green' : 'reverse'; # unused
752 expect => <<'#17...........',
753 # if equals is excluded then ternary is automatically excluded
754 # side comment alignments always remain
755 $co_description = ($color) ? 'bold cyan' : ''; # description
756 $co_prompt = ($color) ? 'bold green' : ''; # prompt
757 $co_unused = ($color) ? 'on_green' : 'reverse'; # unused
764 expect => <<'#18...........',
765 # if equals is excluded then ternary is automatically excluded
766 # side comment alignments always remain
767 $co_description = ($color) ? 'bold cyan' : ''; # description
768 $co_prompt = ($color) ? 'bold green' : ''; # prompt
769 $co_unused = ($color) ? 'on_green' : 'reverse'; # unused
776 expect => <<'#19...........',
787 my $ntests = 0 + keys %{$rtests};
788 plan tests => $ntests;
795 foreach my $key ( sort keys %{$rtests} ) {
797 my $sname = $rtests->{$key}->{source};
798 my $expect = $rtests->{$key}->{expect};
799 my $pname = $rtests->{$key}->{params};
800 my $source = $rsources->{$sname};
801 my $params = defined($pname) ? $rparams->{$pname} : "";
803 my $errorfile_string;
804 my $err = Perl::Tidy::perltidy(
806 destination => \$output,
807 perltidyrc => \$params,
808 argv => '', # for safety; hide any ARGV from perltidy
809 stderr => \$stderr_string,
810 errorfile => \$errorfile_string, # not used when -se flag is set
812 if ( $err || $stderr_string || $errorfile_string ) {
813 print STDERR "Error output received for test '$key'\n";
815 print STDERR "An error flag '$err' was returned\n";
818 if ($stderr_string) {
819 print STDERR "---------------------\n";
820 print STDERR "<<STDERR>>\n$stderr_string\n";
821 print STDERR "---------------------\n";
822 ok( !$stderr_string );
824 if ($errorfile_string) {
825 print STDERR "---------------------\n";
826 print STDERR "<<.ERR file>>\n$errorfile_string\n";
827 print STDERR "---------------------\n";
828 ok( !$errorfile_string );
832 if ( !is( $output, $expect, $key ) ) {
833 my $leno = length($output);
834 my $lene = length($expect);
835 if ( $leno == $lene ) {
837 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
841 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";