t/snippets15.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 gnu5.gnu
   5 #2 wngnu1.def
   6 #3 olbs.def
   7 #4 olbs.olbs0
   8 #5 olbs.olbs2
   9 #6 break_old_methods.break_old_methods
  10 #7 break_old_methods.def
  11 #8 bom1.bom
  12 #9 bom1.def
  13 #10 align28.def
  14 #11 align29.def
  15 #12 align30.def
  16 #13 git09.def
  17 #14 git09.git09
  18 #15 git14.def
  19 #16 sal.def
  20 #17 sal.sal
  21 #18 spp.def
  22 #19 spp.spp0
  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         'bom'               => "-bom -wn",
  41         'break_old_methods' => "--break-at-old-method-breakpoints",
  42         'def'               => "",
  43         'git09'             => "-ce -cbl=map,sort,grep",
  44         'gnu'               => "-gnu",
  45         'olbs0'             => "-olbs=0",
  46         'olbs2'             => "-olbs=2",
  47         'sal'               => <<'----------',
  48 -sal='method fun'
  49 ----------
  50         'spp0' => "-spp=0",
  51     };
  52
  53     ############################
  54     # BEGIN SECTION 2: Sources #
  55     ############################
  56     $rsources = {
  57
  58         'align28' => <<'----------',
  59 # tests for 'delete_needless_parens'
  60 # align all '='s; but do not align parens
  61 my $w = $columns * $cell_w + ( $columns + 1 ) * $border;
  62 my $h = $rows * $cell_h + ( $rows + 1 ) * $border;
  63 my $img = new Gimp::Image( $w, $h, RGB );
  64
  65 # keep leading paren after if as alignment for padding
  66 eval {
  67     if   ( $a->{'abc'} eq 'ABC' ) { no_op(23) }
  68     else                          { no_op(42) }
  69 };
  70 ----------
  71
  72         'align29' => <<'----------',
  73 # alignment with lots of commas
  74 is( floor(1.23441242), 1, "Basic floor(1.23441242) test" );
  75 is( fmod( 3.5, 2.0 ), 1.5, "Basic fmod(3.5, 2.0) test" );
  76 is( join( " ", frexp(1) ), "0.5 1", "Basic frexp(1) test" );
  77 is( ldexp( 0, 1 ), 0, "Basic ldexp(0,1) test" );
  78 is( log10(1),  0, "Basic log10(1) test" );
  79 ----------
  80
  81         'align30' => <<'----------',
  82 # commas on lhs align, commas on rhs do not (different subs)
  83 ($x,$y,$z)=spherical_to_cartesian($rho,$theta,$phi);
  84 ($rho_c,$theta,$z)=spherical_to_cylindrical($rho_s,$theta,$phi);
  85 ( $r2, $theta2, $z2 )=cartesian_to_cylindrical( $x1, $y1, $z1 );
  86
  87 # two-line if/elsif gets aligned
  88 if($i==$depth){$_++;}
  89 elsif($i>$depth){$_=0;}
  90 ----------
  91
  92         'bom1' => <<'----------',
  93 # keep cuddled call chain with -bom
  94 return Mojo::Promise->resolve(
  95     $query_params
  96 )->then(
  97     &_reveal_event
  98 )->then(sub ($code) {
  99     return $c->render(text => '', status => $code);
 100 })->catch(sub {
 101     # 1. return error
 102     return $c->render(json => {}, status => 400);
 103 });
 104 ----------
 105
 106         'break_old_methods' => <<'----------',
 107 my $q = $rs
 108    ->related_resultset('CDs')
 109    ->related_resultset('Tracks')
 110    ->search({
 111       'track.id' => { -ident => 'none_search.id' },
 112    })
 113    ->as_query;
 114 ----------
 115
 116         'git09' => <<'----------',
 117 # no one-line block for first map with -ce -cbl=map,sort,grep
 118 @sorted = map {
 119     $_->[0]
 120 } sort {
 121     $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
 122 } map {
 123     [$_, length($_)]
 124 } @unsorted;
 125 ----------
 126
 127         'git14' => <<'----------',
 128 # git#14; do not break at trailing 'or'
 129 $second = {
 130     key1 => 'aaa',
 131     key2 => 'bbb',
 132 } if $flag1 or $flag2;
 133 ----------
 134
 135         'gnu5' => <<'----------',
 136         # side comments limit gnu type formatting with l=80; note extra comma
 137         push @tests, [
 138             "Lowest code point requiring 13 bytes to represent",    # 2**36
 139             "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
 140             ($::is64bit) ? 0x1000000000 : -1,    # overflows on 32bit
 141           ],
 142           ;
 143 ----------
 144
 145         'olbs' => <<'----------',
 146 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 147 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 148 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
 149 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 150 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 151 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 152 ----------
 153
 154         'sal' => <<'----------',
 155 sub get_val () {
 156
 157 }
 158
 159 method get_value () {
 160
 161 }
 162
 163 fun get_other_value () {
 164
 165 }
 166 ----------
 167
 168         'spp' => <<'----------',
 169 sub get_val() { }
 170
 171 sub get_Val  () { }
 172
 173 sub Get_val             () { }
 174 my $sub1=sub                     () { };
 175 my $sub2=sub () { };
 176 ----------
 177
 178         'wngnu1' => <<'----------',
 179     # test with -wn -gnu
 180     foreach my $parameter (
 181         qw(
 182         set_themes
 183         add_themes
 184         severity
 185         maximum_violations_per_document
 186         _non_public_data
 187         )
 188       )
 189     {
 190         is(
 191             $config->get($parameter),
 192             undef,
 193             qq<"$parameter" is not defined via get() for $policy_short_name.>,
 194         );
 195     }
 196 ----------
 197     };
 198
 199     ####################################
 200     # BEGIN SECTION 3: Expected output #
 201     ####################################
 202     $rtests = {
 203
 204         'gnu5.gnu' => {
 205             source => "gnu5",
 206             params => "gnu",
 207             expect => <<'#1...........',
 208         # side comments limit gnu type formatting with l=80; note extra comma
 209         push @tests, [
 210                  "Lowest code point requiring 13 bytes to represent",    # 2**36
 211                  "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
 212                  ($::is64bit) ? 0x1000000000 : -1,    # overflows on 32bit
 213                      ],
 214           ;
 215 #1...........
 216         },
 217
 218         'wngnu1.def' => {
 219             source => "wngnu1",
 220             params => "def",
 221             expect => <<'#2...........',
 222     # test with -wn -gnu
 223     foreach my $parameter (
 224         qw(
 225         set_themes
 226         add_themes
 227         severity
 228         maximum_violations_per_document
 229         _non_public_data
 230         )
 231       )
 232     {
 233         is(
 234             $config->get($parameter),
 235             undef,
 236             qq<"$parameter" is not defined via get() for $policy_short_name.>,
 237         );
 238     }
 239 #2...........
 240         },
 241
 242         'olbs.def' => {
 243             source => "olbs",
 244             params => "def",
 245             expect => <<'#3...........',
 246 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 247 for $x ( 1, 2 ) { s/(.*)/+$1/ }     # side comment
 248 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
 249 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 250 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 251 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 252 #3...........
 253         },
 254
 255         'olbs.olbs0' => {
 256             source => "olbs",
 257             params => "olbs0",
 258             expect => <<'#4...........',
 259 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 260 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 261 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" }
 262 for $x ( 1, 2 ) { s/(.*)/+$1/ }
 263 for $x ( 1, 2 ) { s/(.*)/+$1/ }    # side comment
 264 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 265 #4...........
 266         },
 267
 268         'olbs.olbs2' => {
 269             source => "olbs",
 270             params => "olbs2",
 271             expect => <<'#5...........',
 272 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 273 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 274 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 275 for $x ( 1, 2 ) { s/(.*)/+$1/; }
 276 for $x ( 1, 2 ) { s/(.*)/+$1/; }    # side comment
 277 if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
 278 #5...........
 279         },
 280
 281         'break_old_methods.break_old_methods' => {
 282             source => "break_old_methods",
 283             params => "break_old_methods",
 284             expect => <<'#6...........',
 285 my $q = $rs
 286   ->related_resultset('CDs')
 287   ->related_resultset('Tracks')
 288   ->search(
 289     {
 290         'track.id' => { -ident => 'none_search.id' },
 291     }
 292 )->as_query;
 293 #6...........
 294         },
 295
 296         'break_old_methods.def' => {
 297             source => "break_old_methods",
 298             params => "def",
 299             expect => <<'#7...........',
 300 my $q = $rs->related_resultset('CDs')->related_resultset('Tracks')->search(
 301     {
 302         'track.id' => { -ident => 'none_search.id' },
 303     }
 304 )->as_query;
 305 #7...........
 306         },
 307
 308         'bom1.bom' => {
 309             source => "bom1",
 310             params => "bom",
 311             expect => <<'#8...........',
 312 # keep cuddled call chain with -bom
 313 return Mojo::Promise->resolve(
 314     $query_params
 315 )->then(
 316     &_reveal_event
 317 )->then( sub ($code) {
 318     return $c->render( text => '', status => $code );
 319 } )->catch( sub {
 320
 321     # 1. return error
 322     return $c->render( json => {}, status => 400 );
 323 } );
 324 #8...........
 325         },
 326
 327         'bom1.def' => {
 328             source => "bom1",
 329             params => "def",
 330             expect => <<'#9...........',
 331 # keep cuddled call chain with -bom
 332 return Mojo::Promise->resolve($query_params)->then(&_reveal_event)->then(
 333     sub ($code) {
 334         return $c->render( text => '', status => $code );
 335     }
 336 )->catch(
 337     sub {
 338         # 1. return error
 339         return $c->render( json => {}, status => 400 );
 340     }
 341 );
 342 #9...........
 343         },
 344
 345         'align28.def' => {
 346             source => "align28",
 347             params => "def",
 348             expect => <<'#10...........',
 349 # tests for 'delete_needless_parens'
 350 # align all '='s; but do not align parens
 351 my $w   = $columns * $cell_w + ( $columns + 1 ) * $border;
 352 my $h   = $rows * $cell_h + ( $rows + 1 ) * $border;
 353 my $img = new Gimp::Image( $w, $h, RGB );
 354
 355 # keep leading paren after if as alignment for padding
 356 eval {
 357     if   ( $a->{'abc'} eq 'ABC' ) { no_op(23) }
 358     else                          { no_op(42) }
 359 };
 360 #10...........
 361         },
 362
 363         'align29.def' => {
 364             source => "align29",
 365             params => "def",
 366             expect => <<'#11...........',
 367 # alignment with lots of commas
 368 is( floor(1.23441242),     1,       "Basic floor(1.23441242) test" );
 369 is( fmod( 3.5, 2.0 ),      1.5,     "Basic fmod(3.5, 2.0) test" );
 370 is( join( " ", frexp(1) ), "0.5 1", "Basic frexp(1) test" );
 371 is( ldexp( 0, 1 ),         0,       "Basic ldexp(0,1) test" );
 372 is( log10(1),              0,       "Basic log10(1) test" );
 373 #11...........
 374         },
 375
 376         'align30.def' => {
 377             source => "align30",
 378             params => "def",
 379             expect => <<'#12...........',
 380 # commas on lhs align, commas on rhs do not (different subs)
 381 ( $x,     $y,      $z )  = spherical_to_cartesian( $rho, $theta, $phi );
 382 ( $rho_c, $theta,  $z )  = spherical_to_cylindrical( $rho_s, $theta, $phi );
 383 ( $r2,    $theta2, $z2 ) = cartesian_to_cylindrical( $x1, $y1, $z1 );
 384
 385 # two-line if/elsif gets aligned
 386 if    ( $i == $depth ) { $_++; }
 387 elsif ( $i > $depth )  { $_ = 0; }
 388 #12...........
 389         },
 390
 391         'git09.def' => {
 392             source => "git09",
 393             params => "def",
 394             expect => <<'#13...........',
 395 # no one-line block for first map with -ce -cbl=map,sort,grep
 396 @sorted =
 397   map  { $_->[0] }
 398   sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
 399   map  { [ $_, length($_) ] } @unsorted;
 400 #13...........
 401         },
 402
 403         'git09.git09' => {
 404             source => "git09",
 405             params => "git09",
 406             expect => <<'#14...........',
 407 # no one-line block for first map with -ce -cbl=map,sort,grep
 408 @sorted = map {
 409     $_->[0]
 410 } sort {
 411     $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0]
 412 } map {
 413     [ $_, length($_) ]
 414 } @unsorted;
 415 #14...........
 416         },
 417
 418         'git14.def' => {
 419             source => "git14",
 420             params => "def",
 421             expect => <<'#15...........',
 422 # git#14; do not break at trailing 'or'
 423 $second = {
 424     key1 => 'aaa',
 425     key2 => 'bbb',
 426 } if $flag1 or $flag2;
 427 #15...........
 428         },
 429
 430         'sal.def' => {
 431             source => "sal",
 432             params => "def",
 433             expect => <<'#16...........',
 434 sub get_val () {
 435
 436 }
 437
 438 method get_value() {
 439
 440 }
 441
 442 fun get_other_value() {
 443
 444 }
 445 #16...........
 446         },
 447
 448         'sal.sal' => {
 449             source => "sal",
 450             params => "sal",
 451             expect => <<'#17...........',
 452 sub get_val () {
 453
 454 }
 455
 456 method get_value () {
 457
 458 }
 459
 460 fun get_other_value () {
 461
 462 }
 463 #17...........
 464         },
 465
 466         'spp.def' => {
 467             source => "spp",
 468             params => "def",
 469             expect => <<'#18...........',
 470 sub get_val() { }
 471
 472 sub get_Val () { }
 473
 474 sub Get_val () { }
 475 my $sub1 = sub () { };
 476 my $sub2 = sub () { };
 477 #18...........
 478         },
 479
 480         'spp.spp0' => {
 481             source => "spp",
 482             params => "spp0",
 483             expect => <<'#19...........',
 484 sub get_val() { }
 485
 486 sub get_Val() { }
 487
 488 sub Get_val() { }
 489 my $sub1 = sub() { };
 490 my $sub2 = sub() { };
 491 #19...........
 492         },
 493     };
 494
 495     my $ntests = 0 + keys %{$rtests};
 496     plan tests => $ntests;
 497 }
 498
 499 ###############
 500 # EXECUTE TESTS
 501 ###############
 502
 503 foreach my $key ( sort keys %{$rtests} ) {
 504     my $output;
 505     my $sname  = $rtests->{$key}->{source};
 506     my $expect = $rtests->{$key}->{expect};
 507     my $pname  = $rtests->{$key}->{params};
 508     my $source = $rsources->{$sname};
 509     my $params = defined($pname) ? $rparams->{$pname} : "";
 510     my $stderr_string;
 511     my $errorfile_string;
 512     my $err = Perl::Tidy::perltidy(
 513         source      => \$source,
 514         destination => \$output,
 515         perltidyrc  => \$params,
 516         argv        => '',             # for safety; hide any ARGV from perltidy
 517         stderr      => \$stderr_string,
 518         errorfile   => \$errorfile_string,    # not used when -se flag is set
 519     );
 520     if ( $err || $stderr_string || $errorfile_string ) {
 521         print STDERR "Error output received for test '$key'\n";
 522         if ($err) {
 523             print STDERR "An error flag '$err' was returned\n";
 524             ok( !$err );
 525         }
 526         if ($stderr_string) {
 527             print STDERR "---------------------\n";
 528             print STDERR "<<STDERR>>\n$stderr_string\n";
 529             print STDERR "---------------------\n";
 530             ok( !$stderr_string );
 531         }
 532         if ($errorfile_string) {
 533             print STDERR "---------------------\n";
 534             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 535             print STDERR "---------------------\n";
 536             ok( !$errorfile_string );
 537         }
 538     }
 539     else {
 540         if ( !is( $output, $expect, $key ) ) {
 541             my $leno = length($output);
 542             my $lene = length($expect);
 543             if ( $leno == $lene ) {
 544                 print STDERR
 545 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 546             }
 547             else {
 548                 print STDERR
 549 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 550             }
 551         }
 552     }
 553 }