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 ----------
 184
 185         'tightness' => <<'----------',
 186 if (( my $len_tab = length( $tabstr )  ) > 0) {  }  # test -pt
 187 $width = $col[ $j + $k ] - $col[ $j ]; # test -sbt
 188 $obj->{ $parsed_sql->{ 'table' }[0] };  # test -bt
 189 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.';  # test -bbt
 190 ----------
 191     };
 192
 193     ####################################
 194     # BEGIN SECTION 3: Expected output #
 195     ####################################
 196     $rtests = {
 197
 198         'misc_tests.misc_tests' => {
 199             source => "misc_tests",
 200             params => "misc_tests",
 201             expect => <<'#1...........',
 202 for( @a = @$ap, $u = shift @a ; @a ; $u = $v ) { ...  }    # test -sfs
 203 $i = 1 ;                                                   #  test -sts
 204 $i = 0 ; ##  =1;  test -ssc
 205 ;
 206 ;
 207 ;
 208 ;                                                          # test -ndsm
 209 my( $a, $b, $c ) = @_ ;                                    # test -nsak="my for"
 210 #1...........
 211         },
 212
 213         'outdent.def' => {
 214             source => "outdent",
 215             params => "def",
 216             expect => <<'#2...........',
 217         my $i;
 218       LOOP: while ( $i = <FOTOS> ) {
 219             chomp($i);
 220             next unless $i;
 221             fixit($i);
 222         }
 223
 224 #2...........
 225         },
 226
 227         'outdent.outdent1' => {
 228             source => "outdent",
 229             params => "outdent1",
 230             expect => <<'#3...........',
 231         my $i;
 232         LOOP: while ( $i = <FOTOS> ) {
 233             chomp($i);
 234           next unless $i;
 235             fixit($i);
 236         }
 237
 238 #3...........
 239         },
 240
 241         'sbq.def' => {
 242             source => "sbq",
 243             params => "def",
 244             expect => <<'#4...........',
 245     $str1 = \"string1";
 246     $str2 = \ 'string2';
 247 #4...........
 248         },
 249
 250         'sbq.sbq0' => {
 251             source => "sbq",
 252             params => "sbq0",
 253             expect => <<'#5...........',
 254     $str1 = \"string1";
 255     $str2 = \'string2';
 256 #5...........
 257         },
 258
 259         'sbq.sbq2' => {
 260             source => "sbq",
 261             params => "sbq2",
 262             expect => <<'#6...........',
 263     $str1 = \ "string1";
 264     $str2 = \ 'string2';
 265 #6...........
 266         },
 267
 268         'tightness.def' => {
 269             source => "tightness",
 270             params => "def",
 271             expect => <<'#7...........',
 272 if ( ( my $len_tab = length($tabstr) ) > 0 ) { }            # test -pt
 273 $width = $col[ $j + $k ] - $col[$j];                        # test -sbt
 274 $obj->{ $parsed_sql->{'table'}[0] };                        # test -bt
 275 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.';    # test -bbt
 276 #7...........
 277         },
 278
 279         'tightness.tightness1' => {
 280             source => "tightness",
 281             params => "tightness1",
 282             expect => <<'#8...........',
 283 if ( ( my $len_tab = length( $tabstr ) ) > 0 ) { }          # test -pt
 284 $width = $col[ $j + $k ] - $col[ $j ];                      # test -sbt
 285 $obj->{ $parsed_sql->{ 'table' }[ 0 ] };                    # test -bt
 286 %bf = map { $_ => -M $_ } grep { /\.deb$/ } dirents '.';    # test -bbt
 287 #8...........
 288         },
 289
 290         'tightness.tightness2' => {
 291             source => "tightness",
 292             params => "tightness2",
 293             expect => <<'#9...........',
 294 if ( ( my $len_tab = length($tabstr) ) > 0 ) { }          # test -pt
 295 $width = $col[ $j + $k ] - $col[$j];                      # test -sbt
 296 $obj->{ $parsed_sql->{'table'}[0] };                      # test -bt
 297 %bf = map { $_ => -M $_ } grep {/\.deb$/} dirents '.';    # test -bbt
 298 #9...........
 299         },
 300
 301         'tightness.tightness3' => {
 302             source => "tightness",
 303             params => "tightness3",
 304             expect => <<'#10...........',
 305 if ((my $len_tab = length($tabstr)) > 0) { }            # test -pt
 306 $width = $col[$j + $k] - $col[$j];                      # test -sbt
 307 $obj->{$parsed_sql->{'table'}[0]};                      # test -bt
 308 %bf = map {$_ => -M $_} grep {/\.deb$/} dirents '.';    # test -bbt
 309 #10...........
 310         },
 311
 312         'braces.braces4' => {
 313             source => "braces",
 314             params => "braces4",
 315             expect => <<'#11...........',
 316 sub message {
 317     if ( !defined( $_[0] ) ) {
 318         print("Hello, World\n");
 319         }
 320     else {
 321         print( $_[0], "\n" );
 322         }
 323     }
 324
 325 $myfun = sub {
 326     print("Hello, World\n");
 327     };
 328
 329 eval {
 330     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 331     $app->run();
 332     }
 333   or do {
 334     $error          = $@;
 335     $produced_error = 1;
 336     };
 337
 338 Mojo::IOLoop->next_tick(
 339     sub {
 340         $ua->get(
 341             '/' => sub {
 342                 push @kept_alive, pop->kept_alive;
 343                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 344                 }
 345         );
 346         }
 347 );
 348
 349 $r = do {
 350     sswitch( $words[ rand @words ] ) {
 351         case $words[0]:
 352         case $words[1]:
 353         case $words[2]:
 354         case $words[3]: { 'ok' }
 355       default: { 'wtf' }
 356         }
 357     };
 358
 359 try {
 360     die;
 361     }
 362 catch {
 363     die;
 364     };
 365 #11...........
 366         },
 367
 368         'scbb.def' => {
 369             source => "scbb",
 370             params => "def",
 371             expect => <<'#12...........',
 372     # test -scbb:
 373     for $w1 (@w1) {
 374         for $w2 (@w2) {
 375             for $w3 (@w3) {
 376                 for $w4 (@w4) {
 377                     push( @lines, "$w1 $w2 $w3 $w4\n" );
 378                 }
 379             }
 380         }
 381     }
 382
 383 #12...........
 384         },
 385
 386         'scbb.scbb' => {
 387             source => "scbb",
 388             params => "scbb",
 389             expect => <<'#13...........',
 390     # test -scbb:
 391     for $w1 (@w1) {
 392         for $w2 (@w2) {
 393             for $w3 (@w3) {
 394                 for $w4 (@w4) {
 395                     push( @lines, "$w1 $w2 $w3 $w4\n" );
 396                 } } } }
 397
 398 #13...........
 399         },
 400
 401         'space_paren.def' => {
 402             source => "space_paren",
 403             params => "def",
 404             expect => <<'#14...........',
 405 myfunc( $a, $b, $c );    # test -sfp
 406 push( @array, $val );    # test -skp and also -sak='push'
 407 split( /\|/, $txt );     # test -skp and also -sak='push'
 408 my ( $v1, $v2 ) = @_;    # test -sak='push'
 409 #14...........
 410         },
 411
 412         'space_paren.space_paren1' => {
 413             source => "space_paren",
 414             params => "space_paren1",
 415             expect => <<'#15...........',
 416 myfunc ( $a, $b, $c );    # test -sfp
 417 push ( @array, $val );    # test -skp and also -sak='push'
 418 split ( /\|/, $txt );     # test -skp and also -sak='push'
 419 my ( $v1, $v2 ) = @_;     # test -sak='push'
 420 #15...........
 421         },
 422
 423         'space_paren.space_paren2' => {
 424             source => "space_paren",
 425             params => "space_paren2",
 426             expect => <<'#16...........',
 427 myfunc( $a, $b, $c );     # test -sfp
 428 push ( @array, $val );    # test -skp and also -sak='push'
 429 split( /\|/, $txt );      # test -skp and also -sak='push'
 430 my ( $v1, $v2 ) = @_;     # test -sak='push'
 431 #16...........
 432         },
 433
 434         'braces.braces5' => {
 435             source => "braces",
 436             params => "braces5",
 437             expect => <<'#17...........',
 438 sub message
 439 {
 440     if ( !defined( $_[0] ) )
 441       {
 442         print("Hello, World\n");
 443       }
 444     else
 445     {
 446         print( $_[0], "\n" );
 447     }
 448 }
 449
 450 $myfun = sub {
 451     print("Hello, World\n");
 452 };
 453
 454 eval {
 455     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 456     $app->run();
 457 } or do
 458 {
 459     $error          = $@;
 460     $produced_error = 1;
 461 };
 462
 463 Mojo::IOLoop->next_tick(
 464     sub {
 465         $ua->get(
 466             '/' => sub {
 467                 push @kept_alive, pop->kept_alive;
 468                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 469             }
 470         );
 471     }
 472 );
 473
 474 $r = do
 475 {
 476     sswitch( $words[ rand @words ] )
 477     {
 478         case $words[0]:
 479         case $words[1]:
 480         case $words[2]:
 481         case $words[3]: { 'ok' }
 482       default: { 'wtf' }
 483     }
 484 };
 485
 486 try
 487 {
 488     die;
 489 }
 490 catch
 491 {
 492     die;
 493 };
 494 #17...........
 495         },
 496
 497         'braces.braces6' => {
 498             source => "braces",
 499             params => "braces6",
 500             expect => <<'#18...........',
 501 sub message {
 502     if ( !defined( $_[0] ) ) {
 503         print("Hello, World\n");
 504     } else {
 505         print( $_[0], "\n" );
 506     }
 507 }
 508
 509 $myfun = sub {
 510     print("Hello, World\n");
 511 };
 512
 513 eval {
 514     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 515     $app->run();
 516 } or do {
 517     $error          = $@;
 518     $produced_error = 1;
 519 };
 520
 521 Mojo::IOLoop->next_tick(
 522     sub {
 523         $ua->get(
 524             '/' => sub {
 525                 push @kept_alive, pop->kept_alive;
 526                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 527             }
 528         );
 529     }
 530 );
 531
 532 $r = do {
 533     sswitch( $words[ rand @words ] ) {
 534         case $words[0]:
 535         case $words[1]:
 536         case $words[2]:
 537         case $words[3]: { 'ok' }
 538       default: { 'wtf' }
 539     }
 540 };
 541
 542 try {
 543     die;
 544 } catch {
 545     die;
 546 };
 547 #18...........
 548         },
 549
 550         'maths.maths3' => {
 551             source => "maths",
 552             params => "maths3",
 553             expect => <<'#19...........',
 554 $tmp=
 555   $day -32075 +
 556   1461* ( $year +4800 -( 14 -$month )/ 12 )/ 4 +
 557   367* ( $month -2 +( ( 14 -$month )/ 12 )* 12 )/ 12 -
 558   3* ( ( $year +4900 -( 14 -$month )/ 12 )/ 100 )/ 4;
 559
 560 return ( $r**$n )*
 561   ( pi**( $n/ 2 ) )/
 562   (
 563     sqrt(pi)* factorial( 2* ( int( $n/ 2 ) ) +2 )/ factorial( int( $n/ 2 ) +1 )
 564       / ( 4**( int( $n/ 2 ) +1 ) ) );
 565
 566 $root= -$b +sqrt( $b* $b -4.* $a* $c )/ ( 2.* $a );
 567 #19...........
 568         },
 569     };
 570
 571     my $ntests = 0 + keys %{$rtests};
 572     plan tests => $ntests;
 573 }
 574
 575 ###############
 576 # EXECUTE TESTS
 577 ###############
 578
 579 foreach my $key ( sort keys %{$rtests} ) {
 580     my $output;
 581     my $sname  = $rtests->{$key}->{source};
 582     my $expect = $rtests->{$key}->{expect};
 583     my $pname  = $rtests->{$key}->{params};
 584     my $source = $rsources->{$sname};
 585     my $params = defined($pname) ? $rparams->{$pname} : "";
 586     my $stderr_string;
 587     my $errorfile_string;
 588     my $err = Perl::Tidy::perltidy(
 589         source      => \$source,
 590         destination => \$output,
 591         perltidyrc  => \$params,
 592         argv        => '',             # for safety; hide any ARGV from perltidy
 593         stderr      => \$stderr_string,
 594         errorfile   => \$errorfile_string,    # not used when -se flag is set
 595     );
 596     if ( $err || $stderr_string || $errorfile_string ) {
 597         print STDERR "Error output received for test '$key'\n";
 598         if ($err) {
 599             print STDERR "An error flag '$err' was returned\n";
 600             ok( !$err );
 601         }
 602         if ($stderr_string) {
 603             print STDERR "---------------------\n";
 604             print STDERR "<<STDERR>>\n$stderr_string\n";
 605             print STDERR "---------------------\n";
 606             ok( !$stderr_string );
 607         }
 608         if ($errorfile_string) {
 609             print STDERR "---------------------\n";
 610             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 611             print STDERR "---------------------\n";
 612             ok( !$errorfile_string );
 613         }
 614     }
 615     else {
 616         if ( !is( $output, $expect, $key ) ) {
 617             my $leno = length($output);
 618             my $lene = length($expect);
 619             if ( $leno == $lene ) {
 620                 print STDERR
 621 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 622             }
 623             else {
 624                 print STDERR
 625 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 626             }
 627         }
 628     }
 629 }