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