t/snippets25.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 novalign.def
   5 #2 novalign.novalign1
   6 #3 novalign.novalign2
   7 #4 novalign.novalign3
   8 #5 lp2.def
   9 #6 lp2.lp
  10 #7 braces.braces8
  11 #8 rt140025.def
  12 #9 rt140025.rt140025
  13 #10 xlp1.def
  14 #11 xlp1.xlp1
  15 #12 git74.def
  16 #13 git74.git74
  17 #14 git77.def
  18 #15 git77.git77
  19 #16 vxl.def
  20 #17 vxl.vxl1
  21 #18 vxl.vxl2
  22 #19 bal.bal1
  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         'bal1'    => "-bal=1",
  41         'braces8' => <<'----------',
  42 -bl -bbvt=1 -blxl=' ' -bll='sub do asub'
  43 ----------
  44         'def'   => "",
  45         'git74' => <<'----------',
  46 -xlp
  47 --iterations=2
  48 --maximum-line-length=120
  49 --line-up-parentheses
  50 --continuation-indentation=4
  51 --closing-token-indentation=1
  52 --want-left-space="= -> ( )"
  53 --want-right-space="= -> ( )"
  54 --space-function-paren
  55 --space-keyword-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
  63 ----------
  64         'git77' => <<'----------',
  65 -gal='Grep Map'
  66 ----------
  67         'lp'        => "-lp",
  68         'novalign1' => "-novalign",
  69         'novalign2' => "-nvsc -nvbc -msc=2",
  70         'novalign3' => "-nvc",
  71         'rt140025'  => "-lp -xci -ci=4 -ce",
  72         'vxl1'      => <<'----------',
  73 -vxl='='
  74 ----------
  75         'vxl2' => <<'----------',
  76 -vxl='*' -vil='='
  77 ----------
  78         'xlp1' => "-xlp",
  79     };
  80
  81     ############################
  82     # BEGIN SECTION 2: Sources #
  83     ############################
  84     $rsources = {
  85
  86         'bal' => <<'----------',
  87 {
  88   L1:
  89   L2:
  90   L3: return;
  91 };
  92 ----------
  93
  94         'braces' => <<'----------',
  95 sub message {
  96     if ( !defined( $_[0] ) ) {
  97         print("Hello, World\n");
  98     }
  99     else {
 100         print( $_[0], "\n" );
 101     }
 102 }
 103
 104 $myfun = sub {
 105     print("Hello, World\n");
 106 };
 107
 108 eval {
 109     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 110     $app->run();
 111 } or do {
 112     $error          = $@;
 113     $produced_error = 1;
 114 };
 115
 116 Mojo::IOLoop->next_tick(
 117     sub {
 118         $ua->get(
 119             '/' => sub {
 120                 push @kept_alive, pop->kept_alive;
 121                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 122             }
 123         );
 124     }
 125 );
 126
 127 $r = do {
 128     sswitch( $words[ rand @words ] ) {
 129         case $words[0]:
 130         case $words[1]:
 131         case $words[2]:
 132         case $words[3]: { 'ok' }
 133       default: { 'wtf' }
 134     }
 135 };
 136
 137 try {
 138     die;
 139 }
 140 catch {
 141     die;
 142 };
 143 ----------
 144
 145         'git74' => <<'----------',
 146 $self->func(
 147   {
 148     command  => [ 'command', 'argument1', 'argument2' ],
 149     callback => sub {
 150       my ($res) = @_;
 151       print($res);
 152     }
 153   }
 154 );
 155
 156 my $test_var = $self->test_call(    #
 157     $arg1,
 158     $arg2
 159 );
 160
 161 my $test_var = $self->test_call(
 162     $arg1,                          #
 163     $arg2
 164 );
 165
 166 my $test_var = $self->test_call(
 167     #
 168     $arg1,
 169     $arg2,
 170 );
 171
 172 my $test_var = $self->test_call(
 173
 174     $arg1,
 175     $arg2,
 176 );
 177
 178 my $test_var = $self->test_call(
 179     $arg1,
 180     $arg2
 181
 182 );
 183
 184 my $test_var = $self->test_call(
 185
 186     $arg1,
 187     $arg2,
 188
 189 );
 190
 191 my $test_var =
 192
 193   $self->test_call(
 194     $arg1,
 195     $arg2
 196
 197   );
 198
 199 ----------
 200
 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
 204     return +{
 205         Map  {
 206 $_->init_arg => $_->get_value($instance) }
 207         Grep { $_->has_value($instance) }
 208         Grep {
 209 defined( $_->init_arg ) }
 210 $class->get_all_attributes
 211     };
 212
 213     return +{
 214         map  {
 215 $_->init_arg => $_->get_value($instance) }
 216         grep { $_->has_value($instance) }
 217         grep {
 218 defined( $_->init_arg ) }
 219 $class->get_all_attributes
 220     };
 221 ----------
 222
 223         'lp2' => <<'----------',
 224 # test issue git #74, lost -lp when final anon sub brace followed by '}'
 225 Util::Parser->new(
 226     Handlers => {
 227         Init  => sub { $self->init(@_) },
 228         Mid =>  { sub { shift; $self->mid(@_) } },
 229         Final => sub { shift; $self->final(@_) }
 230     }
 231 )->parse( $_[0] );
 232 ----------
 233
 234         'novalign' => <<'----------',
 235 {
 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
 246 }
 247
 248 ----------
 249
 250         'rt140025' => <<'----------',
 251 eval {
 252 my $cpid;
 253 my $cmd;
 254
 255  FORK: {
 256  if( $cpid = fork ) {
 257  close( STDOUT );
 258  last;
 259  } elsif( defined $cpid ) {
 260  close( STDIN );
 261  open( STDIN, '<', '/dev/null' ) or die( "open3: $!\n" );
 262  exec $cmd or die( "exec: $!\n" );
 263  } elsif( $! == EAGAIN ) {
 264  sleep 3;
 265  redo FORK;
 266  } else {
 267  die( "Can't fork: $!\n" );
 268  }
 269  }
 270 };
 271 ----------
 272
 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
 279 ----------
 280
 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,
 286   -command  => sub {
 287     change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
 288       ;    # sc
 289   },
 290 )->grid(
 291
 292   # block comment
 293   -row    => $gridy++,
 294   -column => 2,
 295   -sticky => 'e'
 296 );
 297 ----------
 298     };
 299
 300     ####################################
 301     # BEGIN SECTION 3: Expected output #
 302     ####################################
 303     $rtests = {
 304
 305         'novalign.def' => {
 306             source => "novalign",
 307             params => "def",
 308             expect => <<'#1...........',
 309 {
 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
 320 }
 321
 322 #1...........
 323         },
 324
 325         'novalign.novalign1' => {
 326             source => "novalign",
 327             params => "novalign1",
 328             expect => <<'#2...........',
 329 {
 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
 340 }
 341
 342 #2...........
 343         },
 344
 345         'novalign.novalign2' => {
 346             source => "novalign",
 347             params => "novalign2",
 348             expect => <<'#3...........',
 349 {
 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
 360 }
 361
 362 #3...........
 363         },
 364
 365         'novalign.novalign3' => {
 366             source => "novalign",
 367             params => "novalign3",
 368             expect => <<'#4...........',
 369 {
 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
 380 }
 381
 382 #4...........
 383         },
 384
 385         'lp2.def' => {
 386             source => "lp2",
 387             params => "def",
 388             expect => <<'#5...........',
 389 # test issue git #74, lost -lp when final anon sub brace followed by '}'
 390 Util::Parser->new(
 391     Handlers => {
 392         Init  => sub { $self->init(@_) },
 393         Mid   => { sub { shift; $self->mid(@_) } },
 394         Final => sub { shift; $self->final(@_) }
 395     }
 396 )->parse( $_[0] );
 397 #5...........
 398         },
 399
 400         'lp2.lp' => {
 401             source => "lp2",
 402             params => "lp",
 403             expect => <<'#6...........',
 404 # test issue git #74, lost -lp when final anon sub brace followed by '}'
 405 Util::Parser->new(
 406                    Handlers => {
 407                                  Init  => sub { $self->init(@_) },
 408                                  Mid   => { sub { shift; $self->mid(@_) } },
 409                                  Final => sub { shift; $self->final(@_) }
 410                    }
 411 )->parse( $_[0] );
 412 #6...........
 413         },
 414
 415         'braces.braces8' => {
 416             source => "braces",
 417             params => "braces8",
 418             expect => <<'#7...........',
 419 sub message
 420 {   if ( !defined( $_[0] ) ) {
 421         print("Hello, World\n");
 422     }
 423     else {
 424         print( $_[0], "\n" );
 425     }
 426 }
 427
 428 $myfun = sub
 429 {   print("Hello, World\n");
 430 };
 431
 432 eval {
 433     my $app = App::perlbrew->new( "install-patchperl", "-q" );
 434     $app->run();
 435 } or do
 436 {   $error          = $@;
 437     $produced_error = 1;
 438 };
 439
 440 Mojo::IOLoop->next_tick(
 441     sub
 442     {   $ua->get(
 443             '/' => sub
 444             {   push @kept_alive, pop->kept_alive;
 445                 Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
 446             }
 447         );
 448     }
 449 );
 450
 451 $r = do
 452 {   sswitch( $words[ rand @words ] ) {
 453         case $words[0]:
 454         case $words[1]:
 455         case $words[2]:
 456         case $words[3]: { 'ok' }
 457       default: { 'wtf' }
 458     }
 459 };
 460
 461 try {
 462     die;
 463 }
 464 catch {
 465     die;
 466 };
 467 #7...........
 468         },
 469
 470         'rt140025.def' => {
 471             source => "rt140025",
 472             params => "def",
 473             expect => <<'#8...........',
 474 eval {
 475     my $cpid;
 476     my $cmd;
 477
 478   FORK: {
 479         if ( $cpid = fork ) {
 480             close(STDOUT);
 481             last;
 482         }
 483         elsif ( defined $cpid ) {
 484             close(STDIN);
 485             open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
 486             exec $cmd                       or die("exec: $!\n");
 487         }
 488         elsif ( $! == EAGAIN ) {
 489             sleep 3;
 490             redo FORK;
 491         }
 492         else {
 493             die("Can't fork: $!\n");
 494         }
 495     }
 496 };
 497 #8...........
 498         },
 499
 500         'rt140025.rt140025' => {
 501             source => "rt140025",
 502             params => "rt140025",
 503             expect => <<'#9...........',
 504 eval {
 505     my $cpid;
 506     my $cmd;
 507
 508 FORK: {
 509         if ( $cpid = fork ) {
 510             close(STDOUT);
 511             last;
 512         } elsif ( defined $cpid ) {
 513             close(STDIN);
 514             open( STDIN, '<', '/dev/null' ) or die("open3: $!\n");
 515             exec $cmd                       or die("exec: $!\n");
 516         } elsif ( $! == EAGAIN ) {
 517             sleep 3;
 518             redo FORK;
 519         } else {
 520             die("Can't fork: $!\n");
 521         }
 522     }
 523 };
 524 #9...........
 525         },
 526
 527         'xlp1.def' => {
 528             source => "xlp1",
 529             params => "def",
 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,
 535     -command  => sub {
 536         change_state_all( $act_page1, $qualitaet_s_optimierung, { $cb1 => 1 } )
 537           ;    # sc
 538     },
 539 )->grid(
 540
 541     # block comment
 542     -row    => $gridy++,
 543     -column => 2,
 544     -sticky => 'e'
 545 );
 546 #10...........
 547         },
 548
 549         'xlp1.xlp1' => {
 550             source => "xlp1",
 551             params => "xlp1",
 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,
 557                               -command  => sub {
 558                                   change_state_all( $act_page1,
 559                                        $qualitaet_s_optimierung, { $cb1 => 1 } )
 560                                     ;    # sc
 561                               },
 562 )->grid(
 563
 564         # block comment
 565         -row    => $gridy++,
 566         -column => 2,
 567         -sticky => 'e'
 568 );
 569 #11...........
 570         },
 571
 572         'git74.def' => {
 573             source => "git74",
 574             params => "def",
 575             expect => <<'#12...........',
 576 $self->func(
 577     {
 578         command  => [ 'command', 'argument1', 'argument2' ],
 579         callback => sub {
 580             my ($res) = @_;
 581             print($res);
 582         }
 583     }
 584 );
 585
 586 my $test_var = $self->test_call(    #
 587     $arg1,
 588     $arg2
 589 );
 590
 591 my $test_var = $self->test_call(
 592     $arg1,                          #
 593     $arg2
 594 );
 595
 596 my $test_var = $self->test_call(
 597     #
 598     $arg1,
 599     $arg2,
 600 );
 601
 602 my $test_var = $self->test_call(
 603
 604     $arg1,
 605     $arg2,
 606 );
 607
 608 my $test_var = $self->test_call(
 609     $arg1,
 610     $arg2
 611
 612 );
 613
 614 my $test_var = $self->test_call(
 615
 616     $arg1,
 617     $arg2,
 618
 619 );
 620
 621 my $test_var =
 622
 623   $self->test_call(
 624     $arg1,
 625     $arg2
 626
 627   );
 628
 629 #12...........
 630         },
 631
 632         'git74.git74' => {
 633             source => "git74",
 634             params => "git74",
 635             expect => <<'#13...........',
 636 $self -> func (
 637                 {
 638                    command  => [ 'command', 'argument1', 'argument2' ],
 639                    callback => sub
 640                        {
 641                        my ($res) = @_ ;
 642                        print ($res) ;
 643                        }
 644                 }
 645               ) ;
 646
 647 my $test_var = $self -> test_call (    #
 648                                     $arg1,
 649                                     $arg2
 650                                   ) ;
 651
 652 my $test_var = $self -> test_call (
 653                                     $arg1,    #
 654                                     $arg2
 655                                   ) ;
 656
 657 my $test_var = $self -> test_call (
 658                                    #
 659                                    $arg1,
 660                                    $arg2,
 661                                   ) ;
 662
 663 my $test_var = $self -> test_call (
 664
 665                                    $arg1,
 666                                    $arg2,
 667                                   ) ;
 668
 669 my $test_var = $self -> test_call (
 670                                     $arg1,
 671                                     $arg2
 672
 673                                   ) ;
 674
 675 my $test_var = $self -> test_call (
 676
 677                                    $arg1,
 678                                    $arg2,
 679
 680                                   ) ;
 681
 682 my $test_var =
 683
 684     $self -> test_call (
 685                          $arg1,
 686                          $arg2
 687
 688                        ) ;
 689
 690 #13...........
 691         },
 692
 693         'git77.def' => {
 694             source => "git77",
 695             params => "def",
 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
 699     return +{
 700         Map {
 701             $_->init_arg => $_->get_value($instance)
 702         } Grep { $_->has_value($instance) }
 703         Grep {
 704             defined( $_->init_arg )
 705         }
 706         $class->get_all_attributes
 707     };
 708
 709     return +{
 710         map  { $_->init_arg => $_->get_value($instance) }
 711         grep { $_->has_value($instance) }
 712         grep { defined( $_->init_arg ) } $class->get_all_attributes
 713     };
 714 #14...........
 715         },
 716
 717         'git77.git77' => {
 718             source => "git77",
 719             params => "git77",
 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
 723     return +{
 724         Map { $_->init_arg => $_->get_value($instance) }
 725         Grep { $_->has_value($instance) }
 726         Grep { defined( $_->init_arg ) } $class->get_all_attributes
 727     };
 728
 729     return +{
 730         map  { $_->init_arg => $_->get_value($instance) }
 731         grep { $_->has_value($instance) }
 732         grep { defined( $_->init_arg ) } $class->get_all_attributes
 733     };
 734 #15...........
 735         },
 736
 737         'vxl.def' => {
 738             source => "vxl",
 739             params => "def",
 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
 746 #16...........
 747         },
 748
 749         'vxl.vxl1' => {
 750             source => "vxl",
 751             params => "vxl1",
 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
 758 #17...........
 759         },
 760
 761         'vxl.vxl2' => {
 762             source => "vxl",
 763             params => "vxl2",
 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
 770 #18...........
 771         },
 772
 773         'bal.bal1' => {
 774             source => "bal",
 775             params => "bal1",
 776             expect => <<'#19...........',
 777 {
 778   L1:
 779   L2:
 780   L3:
 781     return;
 782 };
 783 #19...........
 784         },
 785     };
 786
 787     my $ntests = 0 + keys %{$rtests};
 788     plan tests => $ntests;
 789 }
 790
 791 ###############
 792 # EXECUTE TESTS
 793 ###############
 794
 795 foreach my $key ( sort keys %{$rtests} ) {
 796     my $output;
 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} : "";
 802     my $stderr_string;
 803     my $errorfile_string;
 804     my $err = Perl::Tidy::perltidy(
 805         source      => \$source,
 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
 811     );
 812     if ( $err || $stderr_string || $errorfile_string ) {
 813         print STDERR "Error output received for test '$key'\n";
 814         if ($err) {
 815             print STDERR "An error flag '$err' was returned\n";
 816             ok( !$err );
 817         }
 818         if ($stderr_string) {
 819             print STDERR "---------------------\n";
 820             print STDERR "<<STDERR>>\n$stderr_string\n";
 821             print STDERR "---------------------\n";
 822             ok( !$stderr_string );
 823         }
 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 );
 829         }
 830     }
 831     else {
 832         if ( !is( $output, $expect, $key ) ) {
 833             my $leno = length($output);
 834             my $lene = length($expect);
 835             if ( $leno == $lene ) {
 836                 print STDERR
 837 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 838             }
 839             else {
 840                 print STDERR
 841 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 842             }
 843         }
 844     }
 845 }