"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/t/snippets9.t" (7 Jan 2020, 11549 Bytes) of package /linux/misc/Perl-Tidy-20200110.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 "snippets9.t": 20191203_vs_20200110.

    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 }