t/snippets13.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 align10.def
   5 #2 align11.def
   6 #3 align12.def
   7 #4 align13.def
   8 #5 rt127633.def
   9 #6 rt127633.rt127633
  10 #7 align14.def
  11 #8 align15.def
  12 #9 align16.def
  13 #10 break5.def
  14 #11 align19.def
  15 #12 align20.def
  16 #13 align21.def
  17 #14 align22.def
  18 #15 align23.def
  19 #16 align24.def
  20 #17 align25.def
  21 #18 align26.def
  22 #19 align27.def
  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         'def'      => "",
  41         'rt127633' => "-baao",
  42     };
  43
  44     ############################
  45     # BEGIN SECTION 2: Sources #
  46     ############################
  47     $rsources = {
  48
  49         'align10' => <<'----------',
  50 $message =~ &rhs_wordwrap( $message, $width );
  51 $message_len =~ split( /^/, $message );
  52 ----------
  53
  54         'align11' => <<'----------',
  55 my $accountno = getnextacctno( $env, $bornum, $dbh );
  56 my $item = getiteminformation( $env, $itemno );
  57 my $account = "Insert into accountlines
  58  bla bla";
  59 ----------
  60
  61         'align12' => <<'----------',
  62     my $type = shift || "o";
  63     my $fname  = ( $type eq 'oo'               ? 'orte_city' : 'orte' );
  64     my $suffix = ( $coord_system eq 'standard' ? ''          : '-orig' );
  65 ----------
  66
  67         'align13' => <<'----------',
  68 # symbols =~ and !~ are equivalent in alignment
  69 ok( $out !~ /EXACT <fop>/, "No 'baz'" );
  70 ok( $out =~ /<liz>/,       "Got 'liz'" );    # liz
  71 ok( $out =~ /<zoo>/,       "Got 'zoo'" );    # zoo
  72 ok( $out !~ /<zap>/,       "Got 'zap'" );    # zap
  73 ----------
  74
  75         'align14' => <<'----------',
  76 # align the =
  77 my($apple)=new Fruit("Apple1",.1,.30);
  78 my($grapefruit)=new Grapefruit("Grapefruit1",.3);
  79 my($redgrapefruit)=new RedGrapefruit("Grapefruit2",.3);
  80 ----------
  81
  82         'align15' => <<'----------',
  83 # align both = and //
  84 my$color=$opts{'-color'}//'black';
  85 my$background=$opts{'-background'}//'none';
  86 my$linewidth=$opts{'-linewidth'}//1;
  87 my$radius=$opts{'-radius'}//0;
  88 ----------
  89
  90         'align16' => <<'----------',
  91 # align all at first =>
  92 use constant {
  93     PHFAM => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
  94     FAMILY => [qw( John Jane Sally )],
  95     AGES   => { John => 33, Jane => 28, Sally => 3 },
  96     RFAM => [ [qw( John Jane Sally )] ],
  97     THREE => 3,
  98     SPIT  => sub { shift },
  99 };
 100
 101 ----------
 102
 103         'align19' => <<'----------',
 104 # different lhs patterns, do not align the '='
 105 @_                                       = qw(sort grep map do eval);
 106 @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
 107 ----------
 108
 109         'align20' => <<'----------',
 110 # marginal two-line match; different lhs patterns; do not align
 111 $w[$i] = $t;
 112 $t = 1000000;
 113 ----------
 114
 115         'align21' => <<'----------',
 116 # two lines with large gap but same lhs pattern so align equals
 117 local (@pieces)            = split( /\./, $filename, 2 );
 118 local ($just_dir_and_base) = $pieces[0];
 119
 120 # two lines with 3 alignment tokens
 121 $expect = "1$expect" if $expect =~ /^e/i;
 122 $p = "1$p" if defined $p and $p =~ /^e/i;
 123
 124 # two lines where alignment causes a large gap
 125 is( eval { sysopen( my $ro, $foo, &O_RDONLY | $TAINT0 ) }, undef );
 126 is( $@, '' );
 127 ----------
 128
 129         'align22' => <<'----------',
 130 # two equality lines with different patterns to left of equals do not align
 131 $signame{$_} = ++$signal;
 132 $signum[$signal] = $_;
 133 ----------
 134
 135         'align23' => <<'----------',
 136 # two equality lines with same pattern on left of equals will align
 137 my $orig = my $format = "^<<<<< ~~\n";
 138 my $abc = "abc";
 139 ----------
 140
 141         'align24' => <<'----------',
 142 # Do not align interior fat commas here; different container types
 143 my $p    = TAP::Parser::SubclassTest->new(
 144     {
 145         exec    => [ $cat            => $file ],
 146         sources => { MySourceHandler => { accept_all => 1 } },
 147     }
 148 );
 149 ----------
 150
 151         'align25' => <<'----------',
 152 # do not align internal commas here; different container types
 153 is_deeply( [ $a,        $a ], [ $b,               $c ] );
 154 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
 155 is_deeply( [ \$a,       \$a ], [ \$b,             \$c ] );
 156
 157 ----------
 158
 159         'align26' => <<'----------',
 160 #  align first of multiple equals
 161 $SIG{PIPE}=sub{die"writingtoaclosedpipe"};
 162 $SIG{BREAK}=$SIG{INT}=$SIG{TERM};
 163 $SIG{HUP}=\&some_handler;
 164 ----------
 165
 166         'align27' => <<'----------',
 167 # do not align first equals here (unmatched commas on left side of =)
 168 my ( $self, $name, $type ) = @_;
 169 my $html_toc_fh            = $self->{_html_toc_fh};
 170 my $html_prelim_fh            = $self->{_html_prelim_fh};
 171 ----------
 172
 173         'break5' => <<'----------',
 174 # do not break at .'s after the ?
 175 return (
 176     ( $pod eq $pod2 ) & amp;
 177       &amp;
 178       ( $htype eq "NAME" )
 179   )
 180   ? "\n&lt;A NAME=\""
 181   . $value
 182   . "\"&gt;\n$text&lt;/A&gt;\n"
 183   : "\n$type$pod2.html\#" . $value . "\"&gt;$text&lt;\/A&gt;\n";
 184 ----------
 185
 186         'rt127633' => <<'----------',
 187 # keep lines long; do not break after 'return' and '.' with -baoo
 188 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) : $ref eq 'ARRAY';
 189 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' .  'bbbbbbbbbbbbbbbbbbbbbbbbb';
 190 ----------
 191     };
 192
 193     ####################################
 194     # BEGIN SECTION 3: Expected output #
 195     ####################################
 196     $rtests = {
 197
 198         'align10.def' => {
 199             source => "align10",
 200             params => "def",
 201             expect => <<'#1...........',
 202 $message     =~ &rhs_wordwrap( $message, $width );
 203 $message_len =~ split( /^/, $message );
 204 #1...........
 205         },
 206
 207         'align11.def' => {
 208             source => "align11",
 209             params => "def",
 210             expect => <<'#2...........',
 211 my $accountno = getnextacctno( $env, $bornum, $dbh );
 212 my $item      = getiteminformation( $env, $itemno );
 213 my $account   = "Insert into accountlines
 214  bla bla";
 215 #2...........
 216         },
 217
 218         'align12.def' => {
 219             source => "align12",
 220             params => "def",
 221             expect => <<'#3...........',
 222     my $type   = shift || "o";
 223     my $fname  = ( $type eq 'oo'               ? 'orte_city' : 'orte' );
 224     my $suffix = ( $coord_system eq 'standard' ? ''          : '-orig' );
 225 #3...........
 226         },
 227
 228         'align13.def' => {
 229             source => "align13",
 230             params => "def",
 231             expect => <<'#4...........',
 232 # symbols =~ and !~ are equivalent in alignment
 233 ok( $out !~ /EXACT <fop>/, "No 'baz'" );
 234 ok( $out =~ /<liz>/,       "Got 'liz'" );    # liz
 235 ok( $out =~ /<zoo>/,       "Got 'zoo'" );    # zoo
 236 ok( $out !~ /<zap>/,       "Got 'zap'" );    # zap
 237 #4...........
 238         },
 239
 240         'rt127633.def' => {
 241             source => "rt127633",
 242             params => "def",
 243             expect => <<'#5...........',
 244 # keep lines long; do not break after 'return' and '.' with -baoo
 245 return $ref eq 'SCALAR'
 246   ? $self->encode_scalar( $object, $name, $type, $attr )
 247   : $ref eq 'ARRAY';
 248 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
 249   . 'bbbbbbbbbbbbbbbbbbbbbbbbb';
 250 #5...........
 251         },
 252
 253         'rt127633.rt127633' => {
 254             source => "rt127633",
 255             params => "rt127633",
 256             expect => <<'#6...........',
 257 # keep lines long; do not break after 'return' and '.' with -baoo
 258 return $ref eq 'SCALAR' ? $self->encode_scalar( $object, $name, $type, $attr ) :
 259   $ref eq 'ARRAY';
 260 my $s = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' .
 261   'bbbbbbbbbbbbbbbbbbbbbbbbb';
 262 #6...........
 263         },
 264
 265         'align14.def' => {
 266             source => "align14",
 267             params => "def",
 268             expect => <<'#7...........',
 269 # align the =
 270 my ($apple)         = new Fruit( "Apple1", .1, .30 );
 271 my ($grapefruit)    = new Grapefruit( "Grapefruit1", .3 );
 272 my ($redgrapefruit) = new RedGrapefruit( "Grapefruit2", .3 );
 273 #7...........
 274         },
 275
 276         'align15.def' => {
 277             source => "align15",
 278             params => "def",
 279             expect => <<'#8...........',
 280 # align both = and //
 281 my $color      = $opts{'-color'}      // 'black';
 282 my $background = $opts{'-background'} // 'none';
 283 my $linewidth  = $opts{'-linewidth'}  // 1;
 284 my $radius     = $opts{'-radius'}     // 0;
 285 #8...........
 286         },
 287
 288         'align16.def' => {
 289             source => "align16",
 290             params => "def",
 291             expect => <<'#9...........',
 292 # align all at first =>
 293 use constant {
 294     PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
 295     FAMILY => [qw( John Jane Sally )],
 296     AGES   => { John => 33, Jane => 28, Sally => 3 },
 297     RFAM   => [ [qw( John Jane Sally )] ],
 298     THREE  => 3,
 299     SPIT   => sub { shift },
 300 };
 301
 302 #9...........
 303         },
 304
 305         'break5.def' => {
 306             source => "break5",
 307             params => "def",
 308             expect => <<'#10...........',
 309 # do not break at .'s after the ?
 310 return (
 311     ( $pod eq $pod2 ) & amp;
 312     &amp;
 313     ( $htype eq "NAME" )
 314   )
 315   ? "\n&lt;A NAME=\"" . $value . "\"&gt;\n$text&lt;/A&gt;\n"
 316   : "\n$type$pod2.html\#" . $value . "\"&gt;$text&lt;\/A&gt;\n";
 317 #10...........
 318         },
 319
 320         'align19.def' => {
 321             source => "align19",
 322             params => "def",
 323             expect => <<'#11...........',
 324 # different lhs patterns, do not align the '='
 325 @_ = qw(sort grep map do eval);
 326 @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_);
 327 #11...........
 328         },
 329
 330         'align20.def' => {
 331             source => "align20",
 332             params => "def",
 333             expect => <<'#12...........',
 334 # marginal two-line match; different lhs patterns; do not align
 335 $w[$i] = $t;
 336 $t = 1000000;
 337 #12...........
 338         },
 339
 340         'align21.def' => {
 341             source => "align21",
 342             params => "def",
 343             expect => <<'#13...........',
 344 # two lines with large gap but same lhs pattern so align equals
 345 local (@pieces)            = split( /\./, $filename, 2 );
 346 local ($just_dir_and_base) = $pieces[0];
 347
 348 # two lines with 3 alignment tokens
 349 $expect = "1$expect" if $expect           =~ /^e/i;
 350 $p      = "1$p"      if defined $p and $p =~ /^e/i;
 351
 352 # two lines where alignment causes a large gap
 353 is( eval { sysopen( my $ro, $foo, &O_RDONLY | $TAINT0 ) }, undef );
 354 is( $@,                                                    '' );
 355 #13...........
 356         },
 357
 358         'align22.def' => {
 359             source => "align22",
 360             params => "def",
 361             expect => <<'#14...........',
 362 # two equality lines with different patterns to left of equals do not align
 363 $signame{$_} = ++$signal;
 364 $signum[$signal] = $_;
 365 #14...........
 366         },
 367
 368         'align23.def' => {
 369             source => "align23",
 370             params => "def",
 371             expect => <<'#15...........',
 372 # two equality lines with same pattern on left of equals will align
 373 my $orig = my $format = "^<<<<< ~~\n";
 374 my $abc  = "abc";
 375 #15...........
 376         },
 377
 378         'align24.def' => {
 379             source => "align24",
 380             params => "def",
 381             expect => <<'#16...........',
 382 # Do not align interior fat commas here; different container types
 383 my $p = TAP::Parser::SubclassTest->new(
 384     {
 385         exec    => [ $cat => $file ],
 386         sources => { MySourceHandler => { accept_all => 1 } },
 387     }
 388 );
 389 #16...........
 390         },
 391
 392         'align25.def' => {
 393             source => "align25",
 394             params => "def",
 395             expect => <<'#17...........',
 396 # do not align internal commas here; different container types
 397 is_deeply( [ $a, $a ],               [ $b, $c ] );
 398 is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
 399 is_deeply( [ \$a, \$a ],             [ \$b, \$c ] );
 400
 401 #17...........
 402         },
 403
 404         'align26.def' => {
 405             source => "align26",
 406             params => "def",
 407             expect => <<'#18...........',
 408 #  align first of multiple equals
 409 $SIG{PIPE}  = sub { die "writingtoaclosedpipe" };
 410 $SIG{BREAK} = $SIG{INT} = $SIG{TERM};
 411 $SIG{HUP}   = \&some_handler;
 412 #18...........
 413         },
 414
 415         'align27.def' => {
 416             source => "align27",
 417             params => "def",
 418             expect => <<'#19...........',
 419 # do not align first equals here (unmatched commas on left side of =)
 420 my ( $self, $name, $type ) = @_;
 421 my $html_toc_fh    = $self->{_html_toc_fh};
 422 my $html_prelim_fh = $self->{_html_prelim_fh};
 423 #19...........
 424         },
 425     };
 426
 427     my $ntests = 0 + keys %{$rtests};
 428     plan tests => $ntests;
 429 }
 430
 431 ###############
 432 # EXECUTE TESTS
 433 ###############
 434
 435 foreach my $key ( sort keys %{$rtests} ) {
 436     my $output;
 437     my $sname  = $rtests->{$key}->{source};
 438     my $expect = $rtests->{$key}->{expect};
 439     my $pname  = $rtests->{$key}->{params};
 440     my $source = $rsources->{$sname};
 441     my $params = defined($pname) ? $rparams->{$pname} : "";
 442     my $stderr_string;
 443     my $errorfile_string;
 444     my $err = Perl::Tidy::perltidy(
 445         source      => \$source,
 446         destination => \$output,
 447         perltidyrc  => \$params,
 448         argv        => '',             # for safety; hide any ARGV from perltidy
 449         stderr      => \$stderr_string,
 450         errorfile   => \$errorfile_string,    # not used when -se flag is set
 451     );
 452     if ( $err || $stderr_string || $errorfile_string ) {
 453         print STDERR "Error output received for test '$key'\n";
 454         if ($err) {
 455             print STDERR "An error flag '$err' was returned\n";
 456             ok( !$err );
 457         }
 458         if ($stderr_string) {
 459             print STDERR "---------------------\n";
 460             print STDERR "<<STDERR>>\n$stderr_string\n";
 461             print STDERR "---------------------\n";
 462             ok( !$stderr_string );
 463         }
 464         if ($errorfile_string) {
 465             print STDERR "---------------------\n";
 466             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 467             print STDERR "---------------------\n";
 468             ok( !$errorfile_string );
 469         }
 470     }
 471     else {
 472         if ( !is( $output, $expect, $key ) ) {
 473             my $leno = length($output);
 474             my $lene = length($expect);
 475             if ( $leno == $lene ) {
 476                 print STDERR
 477 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 478             }
 479             else {
 480                 print STDERR
 481 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 482             }
 483         }
 484     }
 485 }