"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20210717/t/snippets13.t" (11 Jul 2021, 14337 Bytes) of package /linux/misc/Perl-Tidy-20210717.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "snippets13.t": 20210402_vs_20210717.

    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 }