t/snippets9.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 rt70747.rt70747
   5 #2 rt74856.def
   6 #3 rt78156.def
   7 #4 rt78764.def
   8 #5 rt79813.def
   9 #6 rt79947.def
  10 #7 rt80645.def
  11 #8 rt81852.def
  12 #9 rt81852.rt81852
  13 #10 rt81854.def
  14 #11 rt87502.def
  15 #12 rt93197.def
  16 #13 rt94338.def
  17 #14 rt95419.def
  18 #15 rt95708.def
  19 #16 rt96021.def
  20 #17 rt96101.def
  21 #18 rt98902.def
  22 #19 rt98902.rt98902
  23 #20 rt99961.def
  24
  25 # To locate test #13 you can search for its name or the string '#13'
  26
  27 use strict;
  28 use Test;
  29 use Carp;
  30 use Perl::Tidy;
  31 my $rparams;
  32 my $rsources;
  33 my $rtests;
  34
  35 BEGIN {
  36
  37     ###########################################
  38     # BEGIN SECTION 1: Parameter combinations #
  39     ###########################################
  40     $rparams = {
  41         'def'     => "",
  42         'rt70747' => "-i=2",
  43         'rt81852' => <<'----------',
  44 -wn
  45 -act=2
  46 ----------
  47         'rt98902' => "-boc",
  48     };
  49
  50     ############################
  51     # BEGIN SECTION 2: Sources #
  52     ############################
  53     $rsources = {
  54
  55         'rt70747' => <<'----------',
  56 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
  57   [ map {
  58       my $g = $_->as_hash;
  59       $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; $g;
  60     } @$_;
  61   ]
  62 };
  63 ----------
  64
  65         'rt74856' => <<'----------',
  66 {
  67 my $foo = '1';
  68 #<<<
  69 my $bar = (test())
  70  ? 'some value'
  71  : undef;
  72 #>>>
  73 my $baz = 'something else';
  74 }
  75 ----------
  76
  77         'rt78156' => <<'----------',
  78 package Some::Class 2.012;
  79 ----------
  80
  81         'rt78764' => <<'----------',
  82 qr/3/ ~~ ['1234'] ? 1 : 0;
  83 map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a;
  84 ----------
  85
  86         'rt79813' => <<'----------',
  87 my %hash = ( a => { bbbbbbbbb => {
  88             cccccccccc => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx',
  89         }, },);
  90 ----------
  91
  92         'rt79947' => <<'----------',
  93 try { croak "An Error!"; }
  94 catch ($error) {
  95     print STDERR $error . "\n";
  96 }
  97 ----------
  98
  99         'rt80645' => <<'----------',
 100 BEGIN { $^W = 1; }
 101 use warnings;
 102 use strict;
 103 @$ = 'test';
 104 print $#{$};
 105 ----------
 106
 107         'rt81852' => <<'----------',
 108 do {
 109     {
 110         next if ( $n % 2 );
 111         print $n, "\n";
 112     }
 113 } while ( $n++ < 10 );
 114 ----------
 115
 116         'rt81854' => <<'----------',
 117 return "this is a descriptive error message"
 118   if $res->is_error or not length $data;
 119 ----------
 120
 121         'rt87502' => <<'----------',
 122 if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) {
 123     # CODE
 124 }
 125 ----------
 126
 127         'rt93197' => <<'----------',
 128 $to = $to->{$_} ||= {} for @key; if (1) {2;} else {3;}
 129 ----------
 130
 131         'rt94338' => <<'----------',
 132 # for-loop in a parenthesized block-map triggered an error message
 133 map( { foreach my $item ( '0', '1' ) { print $item} } qw(a b c) );
 134 ----------
 135
 136         'rt95419' => <<'----------',
 137 case "blah" => sub {
 138     { a => 1 }
 139 };
 140 ----------
 141
 142         'rt95708' => <<'----------',
 143 use strict;
 144 use JSON;
 145 my $ref = {
 146 when => time(), message => 'abc' };
 147 my $json  = encode_json   {
 148 when => time(), message => 'abc' };
 149 my $json2 = encode_json + {
 150 when => time(), message => 'abc' };
 151 ----------
 152
 153         'rt96021' => <<'----------',
 154 $a->@*;
 155 $a->**;
 156 $a->$*;
 157 $a->&*;
 158 $a->%*;
 159 $a->$#*
 160 ----------
 161
 162         'rt96101' => <<'----------',
 163 # Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine
 164 # references inside subroutine execution.
 165
 166 # closing brace of second sub should get outdented here
 167 sub startup {
 168     my $self = shift;
 169     $self->plugin(
 170         'authentication' => {
 171             'autoload_user' => 1,
 172             'session_key'   => rand(),
 173             'load_user'     => sub {
 174                 return HaloVP::Users->load(@_);
 175             },
 176             'validate_user' => sub {
 177                 return HaloVP::Users->login(@_);
 178             }
 179         }
 180     );
 181 }
 182
 183 ----------
 184
 185         'rt98902' => <<'----------',
 186 my %foo = (
 187    alpha => 1,
 188 beta => 2, gamma => 3,
 189 );
 190
 191 my @bar = map { {
 192 number => $_,
 193 character => chr $_,
 194 padding => ( ' ' x $_ ),
 195 } } ( 0 .. 32 );
 196 ----------
 197
 198         'rt99961' => <<'----------',
 199 %thing = %{ print qq[blah1\n]; $b; };
 200 ----------
 201     };
 202
 203     ####################################
 204     # BEGIN SECTION 3: Expected output #
 205     ####################################
 206     $rtests = {
 207
 208         'rt70747.rt70747' => {
 209             source => "rt70747",
 210             params => "rt70747",
 211             expect => <<'#1...........',
 212 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
 213   [
 214     map {
 215       my $g = $_->as_hash;
 216       $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ];
 217       $g;
 218     } @$_;
 219   ]
 220 };
 221 #1...........
 222         },
 223
 224         'rt74856.def' => {
 225             source => "rt74856",
 226             params => "def",
 227             expect => <<'#2...........',
 228 {
 229     my $foo = '1';
 230 #<<<
 231 my $bar = (test())
 232  ? 'some value'
 233  : undef;
 234 #>>>
 235     my $baz = 'something else';
 236 }
 237 #2...........
 238         },
 239
 240         'rt78156.def' => {
 241             source => "rt78156",
 242             params => "def",
 243             expect => <<'#3...........',
 244 package Some::Class 2.012;
 245 #3...........
 246         },
 247
 248         'rt78764.def' => {
 249             source => "rt78764",
 250             params => "def",
 251             expect => <<'#4...........',
 252 qr/3/ ~~ ['1234'] ? 1 : 0;
 253 map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a;
 254 #4...........
 255         },
 256
 257         'rt79813.def' => {
 258             source => "rt79813",
 259             params => "def",
 260             expect => <<'#5...........',
 261 my %hash = (
 262     a => {
 263         bbbbbbbbb => {
 264             cccccccccc => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx',
 265         },
 266     },
 267 );
 268 #5...........
 269         },
 270
 271         'rt79947.def' => {
 272             source => "rt79947",
 273             params => "def",
 274             expect => <<'#6...........',
 275 try { croak "An Error!"; }
 276 catch ($error) {
 277     print STDERR $error . "\n";
 278 }
 279 #6...........
 280         },
 281
 282         'rt80645.def' => {
 283             source => "rt80645",
 284             params => "def",
 285             expect => <<'#7...........',
 286 BEGIN { $^W = 1; }
 287 use warnings;
 288 use strict;
 289 @$ = 'test';
 290 print $#{$};
 291 #7...........
 292         },
 293
 294         'rt81852.def' => {
 295             source => "rt81852",
 296             params => "def",
 297             expect => <<'#8...........',
 298 do {
 299     {
 300         next if ( $n % 2 );
 301         print $n, "\n";
 302     }
 303 } while ( $n++ < 10 );
 304 #8...........
 305         },
 306
 307         'rt81852.rt81852' => {
 308             source => "rt81852",
 309             params => "rt81852",
 310             expect => <<'#9...........',
 311 do {{
 312     next if ($n % 2);
 313     print $n, "\n";
 314 }} while ($n++ < 10);
 315 #9...........
 316         },
 317
 318         'rt81854.def' => {
 319             source => "rt81854",
 320             params => "def",
 321             expect => <<'#10...........',
 322 return "this is a descriptive error message"
 323   if $res->is_error or not length $data;
 324 #10...........
 325         },
 326
 327         'rt87502.def' => {
 328             source => "rt87502",
 329             params => "def",
 330             expect => <<'#11...........',
 331 if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) {
 332
 333     # CODE
 334 }
 335 #11...........
 336         },
 337
 338         'rt93197.def' => {
 339             source => "rt93197",
 340             params => "def",
 341             expect => <<'#12...........',
 342 $to = $to->{$_} ||= {} for @key;
 343 if   (1) { 2; }
 344 else     { 3; }
 345 #12...........
 346         },
 347
 348         'rt94338.def' => {
 349             source => "rt94338",
 350             params => "def",
 351             expect => <<'#13...........',
 352 # for-loop in a parenthesized block-map triggered an error message
 353 map( {
 354         foreach my $item ( '0', '1' ) {
 355             print $item;
 356         }
 357 } qw(a b c) );
 358 #13...........
 359         },
 360
 361         'rt95419.def' => {
 362             source => "rt95419",
 363             params => "def",
 364             expect => <<'#14...........',
 365 case "blah" => sub {
 366     { a => 1 }
 367 };
 368 #14...........
 369         },
 370
 371         'rt95708.def' => {
 372             source => "rt95708",
 373             params => "def",
 374             expect => <<'#15...........',
 375 use strict;
 376 use JSON;
 377 my $ref = {
 378     when    => time(),
 379     message => 'abc'
 380 };
 381 my $json = encode_json {
 382     when    => time(),
 383     message => 'abc'
 384 };
 385 my $json2 = encode_json + {
 386     when    => time(),
 387     message => 'abc'
 388 };
 389 #15...........
 390         },
 391
 392         'rt96021.def' => {
 393             source => "rt96021",
 394             params => "def",
 395             expect => <<'#16...........',
 396 $a->@*;
 397 $a->**;
 398 $a->$*;
 399 $a->&*;
 400 $a->%*;
 401 $a->$#*
 402 #16...........
 403         },
 404
 405         'rt96101.def' => {
 406             source => "rt96101",
 407             params => "def",
 408             expect => <<'#17...........',
 409 # Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine
 410 # references inside subroutine execution.
 411
 412 # closing brace of second sub should get outdented here
 413 sub startup {
 414     my $self = shift;
 415     $self->plugin(
 416         'authentication' => {
 417             'autoload_user' => 1,
 418             'session_key'   => rand(),
 419             'load_user'     => sub {
 420                 return HaloVP::Users->load(@_);
 421             },
 422             'validate_user' => sub {
 423                 return HaloVP::Users->login(@_);
 424             }
 425         }
 426     );
 427 }
 428
 429 #17...........
 430         },
 431
 432         'rt98902.def' => {
 433             source => "rt98902",
 434             params => "def",
 435             expect => <<'#18...........',
 436 my %foo = (
 437     alpha => 1,
 438     beta  => 2,
 439     gamma => 3,
 440 );
 441
 442 my @bar =
 443   map { { number => $_, character => chr $_, padding => ( ' ' x $_ ), } }
 444   ( 0 .. 32 );
 445 #18...........
 446         },
 447
 448         'rt98902.rt98902' => {
 449             source => "rt98902",
 450             params => "rt98902",
 451             expect => <<'#19...........',
 452 my %foo = (
 453     alpha => 1,
 454     beta  => 2, gamma => 3,
 455 );
 456
 457 my @bar = map {
 458     {
 459         number    => $_,
 460         character => chr $_,
 461         padding   => ( ' ' x $_ ),
 462     }
 463 } ( 0 .. 32 );
 464 #19...........
 465         },
 466
 467         'rt99961.def' => {
 468             source => "rt99961",
 469             params => "def",
 470             expect => <<'#20...........',
 471 %thing = %{
 472     print qq[blah1\n];
 473     $b;
 474 };
 475 #20...........
 476         },
 477     };
 478
 479     my $ntests = 0 + keys %{$rtests};
 480     plan tests => $ntests;
 481 }
 482
 483 ###############
 484 # EXECUTE TESTS
 485 ###############
 486
 487 foreach my $key ( sort keys %{$rtests} ) {
 488     my $output;
 489     my $sname  = $rtests->{$key}->{source};
 490     my $expect = $rtests->{$key}->{expect};
 491     my $pname  = $rtests->{$key}->{params};
 492     my $source = $rsources->{$sname};
 493     my $params = defined($pname) ? $rparams->{$pname} : "";
 494     my $stderr_string;
 495     my $errorfile_string;
 496     my $err = Perl::Tidy::perltidy(
 497         source      => \$source,
 498         destination => \$output,
 499         perltidyrc  => \$params,
 500         argv        => '',             # for safety; hide any ARGV from perltidy
 501         stderr      => \$stderr_string,
 502         errorfile => \$errorfile_string,    # not used when -se flag is set
 503     );
 504     if ( $err || $stderr_string || $errorfile_string ) {
 505         if ($err) {
 506             print STDERR
 507 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 508             ok( !$err );
 509         }
 510         if ($stderr_string) {
 511             print STDERR "---------------------\n";
 512             print STDERR "<<STDERR>>\n$stderr_string\n";
 513             print STDERR "---------------------\n";
 514             print STDERR
 515 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 516             ok( !$stderr_string );
 517         }
 518         if ($errorfile_string) {
 519             print STDERR "---------------------\n";
 520             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 521             print STDERR "---------------------\n";
 522             print STDERR
 523 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
 524             ok( !$errorfile_string );
 525         }
 526     }
 527     else {
 528         ok( $output, $expect );
 529     }
 530 }