1 # Created with: ./make_t.pl
4 #1 misc_tests.misc_tests
11 #8 tightness.tightness1
12 #9 tightness.tightness2
13 #10 tightness.tightness3
18 #15 space_paren.space_paren1
19 #16 space_paren.space_paren2
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
41 'braces5' => <<'----------',
46 'maths3' => <<'----------',
47 # test some bizarre spacing around operators
48 -nwls="= / *" -wrs="= / *" -nwrs="+ -" -wls="+ -"
50 'misc_tests' => <<'----------',
51 -sts -ssc -sfs -nsak="my for" -ndsm
53 'outdent1' => <<'----------',
60 'space_paren1' => "-sfp -skp",
61 'space_paren2' => "-sak=push",
62 'tightness1' => "-pt=0 -sbt=0 -bt=0 -bbt=0",
63 'tightness2' => <<'----------',
64 -pt=1 -sbt=1 -bt=1 -bbt=1
67 'tightness3' => <<'----------',
68 -pt=2 -sbt=2 -bt=2 -bbt=2
73 ############################
74 # BEGIN SECTION 2: Sources #
75 ############################
78 'braces' => <<'----------',
80 if ( !defined( $_[0] ) ) {
81 print("Hello, World\n");
89 print("Hello, World\n");
93 my $app = App::perlbrew->new( "install-patchperl", "-q" );
100 Mojo::IOLoop->next_tick(
104 push @kept_alive, pop->kept_alive;
105 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
112 sswitch( $words[ rand @words ] ) {
116 case $words[3]: { 'ok' }
129 'maths' => <<'----------',
130 $tmp = $day - 32075 + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4 + 367
131 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 - 3 * ( ( $year + 4900 -
132 ( 14 - $month ) / 12 ) / 100 ) / 4;
134 return ( $r**$n ) * ( pi**( $n / 2 ) ) / ( sqrt(pi) * factorial( 2 * ( int( $n
135 / 2 ) ) + 2 ) / factorial( int( $n / 2 ) + 1 ) / ( 4**( int( $n / 2 ) + 1 ) )
138 $root=-$b+sqrt($b*$b-4.*$a*$c)/(2.*$a);
141 'misc_tests' => <<'----------',
142 for ( @a = @$ap, $u = shift @a; @a; $u = $v ) { ... } # test -sfs
144 $i = 0; ## =1; test -ssc
146 my ( $a, $b, $c ) = @_; # test -nsak="my for"
149 'outdent' => <<'----------',
151 LOOP: while ( $i = <FOTOS> ) {
159 'sbq' => <<'----------',
164 'scbb' => <<'----------',
170 push( @lines, "$w1 $w2 $w3 $w4\n" );
178 'space_paren' => <<'----------',
179 myfunc ( $a, $b, $c ); # test -sfp
180 push ( @array, $val ); # test -skp and also -sak='push'
181 split( /\|/, $txt ); # test -skp and also -sak='push'
182 my ( $v1, $v2 ) = @_; # test -sak='push'
183 $c-> #sub set_whitespace_flags must look back past side comment
184 bind( $o, $n, [ \&$q, \%m ] );
187 'tightness' => <<'----------',
188 if (( my $len_tab = length( $tabstr ) ) > 0) { } # test -pt
189 $width = $col[ $j + $k ] - $col[ $j ]; # test -sbt
190 $obj->{ $parsed_sql->{ 'table' }[0] }; # test -bt
191 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.'; # test -bbt
195 ####################################
196 # BEGIN SECTION 3: Expected output #
197 ####################################
200 'misc_tests.misc_tests' => {
201 source => "misc_tests",
202 params => "misc_tests",
203 expect => <<'#1...........',
204 for( @a = @$ap, $u = shift @a ; @a ; $u = $v ) { ... } # test -sfs
206 $i = 0 ; ## =1; test -ssc
211 my( $a, $b, $c ) = @_ ; # test -nsak="my for"
218 expect => <<'#2...........',
220 LOOP: while ( $i = <FOTOS> ) {
229 'outdent.outdent1' => {
231 params => "outdent1",
232 expect => <<'#3...........',
234 LOOP: while ( $i = <FOTOS> ) {
246 expect => <<'#4...........',
255 expect => <<'#5...........',
264 expect => <<'#6...........',
271 source => "tightness",
273 expect => <<'#7...........',
274 if ( ( my $len_tab = length($tabstr) ) > 0 ) { } # test -pt
275 $width = $col[ $j + $k ] - $col[$j]; # test -sbt
276 $obj->{ $parsed_sql->{'table'}[0] }; # test -bt
277 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.'; # test -bbt
281 'tightness.tightness1' => {
282 source => "tightness",
283 params => "tightness1",
284 expect => <<'#8...........',
285 if ( ( my $len_tab = length( $tabstr ) ) > 0 ) { } # test -pt
286 $width = $col[ $j + $k ] - $col[ $j ]; # test -sbt
287 $obj->{ $parsed_sql->{ 'table' }[ 0 ] }; # test -bt
288 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.'; # test -bbt
292 'tightness.tightness2' => {
293 source => "tightness",
294 params => "tightness2",
295 expect => <<'#9...........',
296 if ( ( my $len_tab = length($tabstr) ) > 0 ) { } # test -pt
297 $width = $col[ $j + $k ] - $col[$j]; # test -sbt
298 $obj->{ $parsed_sql->{'table'}[0] }; # test -bt
299 %bf = map { $_ => -M $_ } grep {/\.deb$/} dirents '.'; # test -bbt
303 'tightness.tightness3' => {
304 source => "tightness",
305 params => "tightness3",
306 expect => <<'#10...........',
307 if ((my $len_tab = length($tabstr)) > 0) { } # test -pt
308 $width = $col[$j + $k] - $col[$j]; # test -sbt
309 $obj->{$parsed_sql->{'table'}[0]}; # test -bt
310 %bf = map {$_ => -M $_} grep {/\.deb$/} dirents '.'; # test -bbt
314 'braces.braces4' => {
317 expect => <<'#11...........',
319 if ( !defined( $_[0] ) ) {
320 print("Hello, World\n");
323 print( $_[0], "\n" );
328 print("Hello, World\n");
332 my $app = App::perlbrew->new( "install-patchperl", "-q" );
340 Mojo::IOLoop->next_tick(
344 push @kept_alive, pop->kept_alive;
345 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
352 sswitch( $words[ rand @words ] ) {
356 case $words[3]: { 'ok' }
373 expect => <<'#12...........',
379 push( @lines, "$w1 $w2 $w3 $w4\n" );
391 expect => <<'#13...........',
397 push( @lines, "$w1 $w2 $w3 $w4\n" );
403 'space_paren.def' => {
404 source => "space_paren",
406 expect => <<'#14...........',
407 myfunc( $a, $b, $c ); # test -sfp
408 push( @array, $val ); # test -skp and also -sak='push'
409 split( /\|/, $txt ); # test -skp and also -sak='push'
410 my ( $v1, $v2 ) = @_; # test -sak='push'
411 $c-> #sub set_whitespace_flags must look back past side comment
412 bind( $o, $n, [ \&$q, \%m ] );
416 'space_paren.space_paren1' => {
417 source => "space_paren",
418 params => "space_paren1",
419 expect => <<'#15...........',
420 myfunc ( $a, $b, $c ); # test -sfp
421 push ( @array, $val ); # test -skp and also -sak='push'
422 split ( /\|/, $txt ); # test -skp and also -sak='push'
423 my ( $v1, $v2 ) = @_; # test -sak='push'
424 $c-> #sub set_whitespace_flags must look back past side comment
425 bind ( $o, $n, [ \&$q, \%m ] );
429 'space_paren.space_paren2' => {
430 source => "space_paren",
431 params => "space_paren2",
432 expect => <<'#16...........',
433 myfunc( $a, $b, $c ); # test -sfp
434 push ( @array, $val ); # test -skp and also -sak='push'
435 split( /\|/, $txt ); # test -skp and also -sak='push'
436 my ( $v1, $v2 ) = @_; # test -sak='push'
437 $c-> #sub set_whitespace_flags must look back past side comment
438 bind( $o, $n, [ \&$q, \%m ] );
442 'braces.braces5' => {
445 expect => <<'#17...........',
447 if ( !defined( $_[0] ) )
449 print("Hello, World\n");
452 print( $_[0], "\n" );
457 print("Hello, World\n");
461 my $app = App::perlbrew->new( "install-patchperl", "-q" );
468 Mojo::IOLoop->next_tick(
472 push @kept_alive, pop->kept_alive;
473 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
480 sswitch( $words[ rand @words ] ) {
484 case $words[3]: { 'ok' }
498 'braces.braces6' => {
501 expect => <<'#18...........',
503 if ( !defined( $_[0] ) ) {
504 print("Hello, World\n");
506 print( $_[0], "\n" );
511 print("Hello, World\n");
515 my $app = App::perlbrew->new( "install-patchperl", "-q" );
522 Mojo::IOLoop->next_tick(
526 push @kept_alive, pop->kept_alive;
527 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
534 sswitch( $words[ rand @words ] ) {
538 case $words[3]: { 'ok' }
554 expect => <<'#19...........',
557 1461* ( $year +4800 -( 14 -$month )/ 12 )/ 4 +
558 367* ( $month -2 +( ( 14 -$month )/ 12 )* 12 )/ 12 -
559 3* ( ( $year +4900 -( 14 -$month )/ 12 )/ 100 )/ 4;
564 sqrt(pi)* factorial( 2* ( int( $n/ 2 ) ) +2 )/ factorial( int( $n/ 2 ) +1 )
565 / ( 4**( int( $n/ 2 ) +1 ) ) );
567 $root= -$b +sqrt( $b* $b -4.* $a* $c )/ ( 2.* $a );
572 my $ntests = 0 + keys %{$rtests};
573 plan tests => $ntests;
580 foreach my $key ( sort keys %{$rtests} ) {
582 my $sname = $rtests->{$key}->{source};
583 my $expect = $rtests->{$key}->{expect};
584 my $pname = $rtests->{$key}->{params};
585 my $source = $rsources->{$sname};
586 my $params = defined($pname) ? $rparams->{$pname} : "";
588 my $errorfile_string;
589 my $err = Perl::Tidy::perltidy(
591 destination => \$output,
592 perltidyrc => \$params,
593 argv => '', # for safety; hide any ARGV from perltidy
594 stderr => \$stderr_string,
595 errorfile => \$errorfile_string, # not used when -se flag is set
597 if ( $err || $stderr_string || $errorfile_string ) {
598 print STDERR "Error output received for test '$key'\n";
600 print STDERR "An error flag '$err' was returned\n";
603 if ($stderr_string) {
604 print STDERR "---------------------\n";
605 print STDERR "<<STDERR>>\n$stderr_string\n";
606 print STDERR "---------------------\n";
607 ok( !$stderr_string );
609 if ($errorfile_string) {
610 print STDERR "---------------------\n";
611 print STDERR "<<.ERR file>>\n$errorfile_string\n";
612 print STDERR "---------------------\n";
613 ok( !$errorfile_string );
617 if ( !is( $output, $expect, $key ) ) {
618 my $leno = length($output);
619 my $lene = length($expect);
620 if ( $leno == $lene ) {
622 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
626 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";