t/snippets19.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 misc_tests.misc_tests
   5 #2 outdent.def
   6 #3 outdent.outdent1
   7 #4 sbq.def
   8 #5 sbq.sbq0
   9 #6 sbq.sbq2
  10 #7 tightness.def
  11 #8 tightness.tightness1
  12 #9 tightness.tightness2
  13 #10 tightness.tightness3
  14 #11 braces.braces4
  15 #12 scbb.def
  16 #13 scbb.scbb
  17 #14 space_paren.def
  18 #15 space_paren.space_paren1
  19 #16 space_paren.space_paren2
  20 #17 braces.braces5
  21 #18 braces.braces6
  22 #19 maths.maths3
  23
  24 # To locate test #13 you can search for its name or the string '#13'
  25
  26 use strict;
  27 use Test::More;
  28 use Carp;
  29 use Perl::Tidy;
  30 my $rparams;
  31 my $rsources;
  32 my $rtests;
  33
  34 BEGIN {
  35
  36     ###########################################
  37     # BEGIN SECTION 1: Parameter combinations #
  38     ###########################################
  39     $rparams = {
  40         'braces4' => "-icb",
  41         'braces5' => <<'----------',
  42 -bli -blil='if'
  43 ----------
  44         'braces6' => "-ce",
  45         'def'     => "",
  46         'maths3'  => <<'----------',
  47 # test some bizarre spacing around operators
  48 -nwls="= / *"  -wrs="= / *" -nwrs="+ -" -wls="+ -"
  49 ----------
  50         'misc_tests' => <<'----------',
  51 -sts -ssc -sfs -nsak="my for" -ndsm
  52 ----------
  53         'outdent1' => <<'----------',
  54 # test -nola -okw
  55 -nola -okw
  56 ----------
  57         'sbq0'         => "-sbq=0",
  58         'sbq2'         => "-sbq=2",
  59         'scbb'         => "-scbb",
  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
  65
  66 ----------
  67         'tightness3' => <<'----------',
  68 -pt=2 -sbt=2 -bt=2 -bbt=2
  69
  70 ----------
  71     };
  72
  73     ############################
  74     # BEGIN SECTION 2: Sources #
  75     ############################
  76     $rsources = {
  77
  78         'braces' => <<'----------',
  79 sub message {
  80     if ( !defined( $_[0] ) ) {
  81         print("Hello, World\n");
  82     }
  83     else {
  84         print( $_[0], "\n" );
  85     }
  86 }
  87
  88 $myfun = sub {
  89     print("Hello, World\n");
  90 };
  91
  92 eval {
  93     my $app = App::perlbrew->new( "install-patchperl", "-q" );
  94     $app->run();
  95 } or do {
  96     $error          = $@;
  97     $produced_error = 1;
  98 };
  99
 100 Mojo::IOLoop->next_tick(
 101     sub {
 102         $ua->get(
 103             '/' => sub {
 104                 push @kept_alive, pop->kept_alive;
 105                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 106             }
 107         );
 108     }
 109 );
 110
 111 $r = do {
 112     sswitch( $words[ rand @words ] ) {
 113         case $words[0]:
 114         case $words[1]:
 115         case $words[2]:
 116         case $words[3]: { 'ok' }
 117       default: { 'wtf' }
 118     }
 119 };
 120
 121 try {
 122     die;
 123 }
 124 catch {
 125     die;
 126 };
 127 ----------
 128
 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;
 133
 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 ) )
 136 );
 137
 138 $root=-$b+sqrt($b*$b-4.*$a*$c)/(2.*$a);
 139 ----------
 140
 141         'misc_tests' => <<'----------',
 142 for ( @a = @$ap, $u = shift @a; @a; $u = $v ) { ... } # test -sfs
 143 $i = 1 ;     #  test -sts
 144 $i = 0;    ##  =1;  test -ssc
 145 ;;;; # test -ndsm
 146 my ( $a, $b, $c ) = @_;    # test -nsak="my for"
 147 ----------
 148
 149         'outdent' => <<'----------',
 150         my $i;
 151       LOOP: while ( $i = <FOTOS> ) {
 152             chomp($i);
 153             next unless $i;
 154             fixit($i);
 155         }
 156
 157 ----------
 158
 159         'sbq' => <<'----------',
 160        $str1=\"string1";
 161        $str2=\ 'string2';
 162 ----------
 163
 164         'scbb' => <<'----------',
 165     # test -scbb:
 166     for $w1 (@w1) {
 167         for $w2 (@w2) {
 168             for $w3 (@w3) {
 169                 for $w4 (@w4) {
 170                     push( @lines, "$w1 $w2 $w3 $w4\n" );
 171                 }
 172             }
 173         }
 174     }
 175
 176 ----------
 177
 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 ] );
 185 ----------
 186
 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
 192 ----------
 193     };
 194
 195     ####################################
 196     # BEGIN SECTION 3: Expected output #
 197     ####################################
 198     $rtests = {
 199
 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
 205 $i = 1 ;                                                   #  test -sts
 206 $i = 0 ; ##  =1;  test -ssc
 207 ;
 208 ;
 209 ;
 210 ;                                                          # test -ndsm
 211 my( $a, $b, $c ) = @_ ;                                    # test -nsak="my for"
 212 #1...........
 213         },
 214
 215         'outdent.def' => {
 216             source => "outdent",
 217             params => "def",
 218             expect => <<'#2...........',
 219         my $i;
 220       LOOP: while ( $i = <FOTOS> ) {
 221             chomp($i);
 222             next unless $i;
 223             fixit($i);
 224         }
 225
 226 #2...........
 227         },
 228
 229         'outdent.outdent1' => {
 230             source => "outdent",
 231             params => "outdent1",
 232             expect => <<'#3...........',
 233         my $i;
 234         LOOP: while ( $i = <FOTOS> ) {
 235             chomp($i);
 236           next unless $i;
 237             fixit($i);
 238         }
 239
 240 #3...........
 241         },
 242
 243         'sbq.def' => {
 244             source => "sbq",
 245             params => "def",
 246             expect => <<'#4...........',
 247     $str1 = \"string1";
 248     $str2 = \ 'string2';
 249 #4...........
 250         },
 251
 252         'sbq.sbq0' => {
 253             source => "sbq",
 254             params => "sbq0",
 255             expect => <<'#5...........',
 256     $str1 = \"string1";
 257     $str2 = \'string2';
 258 #5...........
 259         },
 260
 261         'sbq.sbq2' => {
 262             source => "sbq",
 263             params => "sbq2",
 264             expect => <<'#6...........',
 265     $str1 = \ "string1";
 266     $str2 = \ 'string2';
 267 #6...........
 268         },
 269
 270         'tightness.def' => {
 271             source => "tightness",
 272             params => "def",
 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
 278 #7...........
 279         },
 280
 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
 289 #8...........
 290         },
 291
 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
 300 #9...........
 301         },
 302
 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
 311 #10...........
 312         },
 313
 314         'braces.braces4' => {
 315             source => "braces",
 316             params => "braces4",
 317             expect => <<'#11...........',
 318 sub message {
 319     if ( !defined( $_[0] ) ) {
 320         print("Hello, World\n");
 321         }
 322     else {
 323         print( $_[0], "\n" );
 324         }
 325     }
 326
 327 $myfun = sub {
 328     print("Hello, World\n");
 329     };
 330
 331 eval {
 332     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 333     $app->run();
 334     }
 335   or do {
 336     $error          = $@;
 337     $produced_error = 1;
 338     };
 339
 340 Mojo::IOLoop->next_tick(
 341     sub {
 342         $ua->get(
 343             '/' => sub {
 344                 push @kept_alive, pop->kept_alive;
 345                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 346                 }
 347         );
 348         }
 349 );
 350
 351 $r = do {
 352     sswitch( $words[ rand @words ] ) {
 353         case $words[0]:
 354         case $words[1]:
 355         case $words[2]:
 356         case $words[3]: { 'ok' }
 357       default: { 'wtf' }
 358         }
 359     };
 360
 361 try {
 362     die;
 363     }
 364 catch {
 365     die;
 366     };
 367 #11...........
 368         },
 369
 370         'scbb.def' => {
 371             source => "scbb",
 372             params => "def",
 373             expect => <<'#12...........',
 374     # test -scbb:
 375     for $w1 (@w1) {
 376         for $w2 (@w2) {
 377             for $w3 (@w3) {
 378                 for $w4 (@w4) {
 379                     push( @lines, "$w1 $w2 $w3 $w4\n" );
 380                 }
 381             }
 382         }
 383     }
 384
 385 #12...........
 386         },
 387
 388         'scbb.scbb' => {
 389             source => "scbb",
 390             params => "scbb",
 391             expect => <<'#13...........',
 392     # test -scbb:
 393     for $w1 (@w1) {
 394         for $w2 (@w2) {
 395             for $w3 (@w3) {
 396                 for $w4 (@w4) {
 397                     push( @lines, "$w1 $w2 $w3 $w4\n" );
 398                 } } } }
 399
 400 #13...........
 401         },
 402
 403         'space_paren.def' => {
 404             source => "space_paren",
 405             params => "def",
 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 ] );
 413 #14...........
 414         },
 415
 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 ] );
 426 #15...........
 427         },
 428
 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 ] );
 439 #16...........
 440         },
 441
 442         'braces.braces5' => {
 443             source => "braces",
 444             params => "braces5",
 445             expect => <<'#17...........',
 446 sub message {
 447     if ( !defined( $_[0] ) )
 448       {
 449         print("Hello, World\n");
 450       }
 451     else {
 452         print( $_[0], "\n" );
 453     }
 454 }
 455
 456 $myfun = sub {
 457     print("Hello, World\n");
 458 };
 459
 460 eval {
 461     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 462     $app->run();
 463 } or do {
 464     $error          = $@;
 465     $produced_error = 1;
 466 };
 467
 468 Mojo::IOLoop->next_tick(
 469     sub {
 470         $ua->get(
 471             '/' => sub {
 472                 push @kept_alive, pop->kept_alive;
 473                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 474             }
 475         );
 476     }
 477 );
 478
 479 $r = do {
 480     sswitch( $words[ rand @words ] ) {
 481         case $words[0]:
 482         case $words[1]:
 483         case $words[2]:
 484         case $words[3]: { 'ok' }
 485       default: { 'wtf' }
 486     }
 487 };
 488
 489 try {
 490     die;
 491 }
 492 catch {
 493     die;
 494 };
 495 #17...........
 496         },
 497
 498         'braces.braces6' => {
 499             source => "braces",
 500             params => "braces6",
 501             expect => <<'#18...........',
 502 sub message {
 503     if ( !defined( $_[0] ) ) {
 504         print("Hello, World\n");
 505     } else {
 506         print( $_[0], "\n" );
 507     }
 508 }
 509
 510 $myfun = sub {
 511     print("Hello, World\n");
 512 };
 513
 514 eval {
 515     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 516     $app->run();
 517 } or do {
 518     $error          = $@;
 519     $produced_error = 1;
 520 };
 521
 522 Mojo::IOLoop->next_tick(
 523     sub {
 524         $ua->get(
 525             '/' => sub {
 526                 push @kept_alive, pop->kept_alive;
 527                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 528             }
 529         );
 530     }
 531 );
 532
 533 $r = do {
 534     sswitch( $words[ rand @words ] ) {
 535         case $words[0]:
 536         case $words[1]:
 537         case $words[2]:
 538         case $words[3]: { 'ok' }
 539       default: { 'wtf' }
 540     }
 541 };
 542
 543 try {
 544     die;
 545 } catch {
 546     die;
 547 };
 548 #18...........
 549         },
 550
 551         'maths.maths3' => {
 552             source => "maths",
 553             params => "maths3",
 554             expect => <<'#19...........',
 555 $tmp=
 556   $day -32075 +
 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;
 560
 561 return ( $r**$n )*
 562   ( pi**( $n/ 2 ) )/
 563   (
 564     sqrt(pi)* factorial( 2* ( int( $n/ 2 ) ) +2 )/ factorial( int( $n/ 2 ) +1 )
 565       / ( 4**( int( $n/ 2 ) +1 ) ) );
 566
 567 $root= -$b +sqrt( $b* $b -4.* $a* $c )/ ( 2.* $a );
 568 #19...........
 569         },
 570     };
 571
 572     my $ntests = 0 + keys %{$rtests};
 573     plan tests => $ntests;
 574 }
 575
 576 ###############
 577 # EXECUTE TESTS
 578 ###############
 579
 580 foreach my $key ( sort keys %{$rtests} ) {
 581     my $output;
 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} : "";
 587     my $stderr_string;
 588     my $errorfile_string;
 589     my $err = Perl::Tidy::perltidy(
 590         source      => \$source,
 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
 596     );
 597     if ( $err || $stderr_string || $errorfile_string ) {
 598         print STDERR "Error output received for test '$key'\n";
 599         if ($err) {
 600             print STDERR "An error flag '$err' was returned\n";
 601             ok( !$err );
 602         }
 603         if ($stderr_string) {
 604             print STDERR "---------------------\n";
 605             print STDERR "<<STDERR>>\n$stderr_string\n";
 606             print STDERR "---------------------\n";
 607             ok( !$stderr_string );
 608         }
 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 );
 614         }
 615     }
 616     else {
 617         if ( !is( $output, $expect, $key ) ) {
 618             my $leno = length($output);
 619             my $lene = length($expect);
 620             if ( $leno == $lene ) {
 621                 print STDERR
 622 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 623             }
 624             else {
 625                 print STDERR
 626 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 627             }
 628         }
 629     }
 630 }