"Fossies" - the Fresh Open Source Software Archive

Member "Perl-Tidy-20200110/t/snippets8.t" (7 Jan 2020, 11906 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 "snippets8.t": 20191203_vs_20200110.

    1 # Created with: ./make_t.pl
    2 
    3 # Contents:
    4 #1 rt123749.rt123749
    5 #2 rt123774.def
    6 #3 rt124114.def
    7 #4 rt124354.def
    8 #5 rt124354.rt124354
    9 #6 rt125012.def
   10 #7 rt125012.rt125012
   11 #8 rt125506.def
   12 #9 rt125506.rt125506
   13 #10 rt126965.def
   14 #11 rt15735.def
   15 #12 rt18318.def
   16 #13 rt18318.rt18318
   17 #14 rt27000.def
   18 #15 rt31741.def
   19 #16 rt49289.def
   20 #17 rt50702.def
   21 #18 rt50702.rt50702
   22 #19 rt68870.def
   23 #20 rt70747.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         'rt123749' => "-wn",
   43         'rt124354' => "-io",
   44         'rt125012' => <<'----------',
   45 -mangle
   46 -dac
   47 ----------
   48         'rt125506' => "-io",
   49         'rt18318'  => <<'----------',
   50 -nwrs='A'
   51 ----------
   52         'rt50702' => <<'----------',
   53 -wbb='='
   54 ----------
   55     };
   56 
   57     ############################
   58     # BEGIN SECTION 2: Sources #
   59     ############################
   60     $rsources = {
   61 
   62         'rt123749' => <<'----------',
   63 get('http://mojolicious.org')->then(
   64     sub {
   65         my $mojo = shift;
   66         say $mojo->res->code;
   67         return get('http://metacpan.org');
   68     }
   69 )->then(
   70     sub {
   71         my $cpan = shift;
   72         say $cpan->res->code;
   73     }
   74 )->catch(
   75     sub {
   76         my $err = shift;
   77         warn "Something went wrong: $err";
   78     }
   79 )->wait;
   80 ----------
   81 
   82         'rt123774' => <<'----------',
   83 # retain any space between backslash and quote to avoid fooling html formatters
   84 my $var1 = \ "bubba";
   85 my $var2 = \"bubba";
   86 my $var3 = \ 'bubba';
   87 my $var4 = \'bubba';
   88 my $var5 = \            "bubba";
   89 ----------
   90 
   91         'rt124114' => <<'----------',
   92 #!/usr/bin/perl 
   93 my %h = {
   94     a    => 2 > 3 ? 1 : 0,
   95     bbbb => sub { my $y = "1" },
   96     c    => sub { my $z = "2" },
   97     d    => 2 > 3 ? 1 : 0,
   98 };
   99 ----------
  100 
  101         'rt124354' => <<'----------',
  102 package Foo;
  103 
  104 use Moose;
  105 
  106 has a => ( is => 'ro', isa => 'Int' );
  107 has b => ( is => 'ro', isa => 'Int' );
  108 has c => ( is => 'ro', isa => 'Int' );
  109 
  110 __PACKAGE__->meta->make_immutable;
  111 ----------
  112 
  113         'rt125012' => <<'----------',
  114 ++$_ for
  115 #one space before eol:
  116 values %_;
  117 system
  118 #one space before eol:
  119 qq{};
  120 ----------
  121 
  122         'rt125506' => <<'----------',
  123 my $t = '
  124         un
  125         deux
  126         trois
  127 	';
  128 ----------
  129 
  130         'rt126965' => <<'----------',
  131 my $restrict_customer = shift ? 1 : 0;
  132 ----------
  133 
  134         'rt15735' => <<'----------',
  135 my $user_prefs = $ref_type eq 'SCALAR' ? _load_from_string( $profile ) : $ref_type eq 'ARRAY' ? _load_from_array( $profile ) : $ref_type eq 'HASH' ? _load_from_hash( $profile ) : _load_from_file( $profile );
  136 ----------
  137 
  138         'rt18318' => <<'----------',
  139 # Class::Std attribute list
  140 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
  141 # after it
  142 my %rank_of : ATTR( :init_arg<starting_rank>  :get<rank>  :set<rank> );
  143 ----------
  144 
  145         'rt27000' => <<'----------',
  146 print add( 3, 4 ), "\n";
  147 print add( 4, 3 ), "\n";
  148 
  149 sub add {
  150     my ( $term1, $term2 ) = @_;
  151 # line 1234
  152     die "$term1 > $term2" if $term1 > $term2;
  153     return $term1 + $term2;
  154 }
  155 ----------
  156 
  157         'rt31741' => <<'----------',
  158 $msg //= 'World';
  159 ----------
  160 
  161         'rt49289' => <<'----------',
  162 use constant qw{ DEBUG 0 };
  163 ----------
  164 
  165         'rt50702' => <<'----------',
  166 if (1) { my $uid = $ENV{ 'ORIG_LOGNAME' } || $ENV{ 'LOGNAME' } || $ENV{ 'REMOTE_USER' } || 'foobar'; } if (2) { my $uid = ($ENV{ 'ORIG_LOGNAME' } || $ENV{ 'LOGNAME' } || $ENV{ 'REMOTE_USER' } || 'foobar'); }
  167 ----------
  168 
  169         'rt68870' => <<'----------',
  170 s///r;
  171 ----------
  172 
  173         'rt70747' => <<'----------',
  174 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
  175   [ map {
  176       my $g = $_->as_hash;
  177       $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; $g;
  178     } @$_;
  179   ]
  180 };
  181 ----------
  182     };
  183 
  184     ####################################
  185     # BEGIN SECTION 3: Expected output #
  186     ####################################
  187     $rtests = {
  188 
  189         'rt123749.rt123749' => {
  190             source => "rt123749",
  191             params => "rt123749",
  192             expect => <<'#1...........',
  193 get('http://mojolicious.org')->then( sub {
  194     my $mojo = shift;
  195     say $mojo->res->code;
  196     return get('http://metacpan.org');
  197 } )->then( sub {
  198     my $cpan = shift;
  199     say $cpan->res->code;
  200 } )->catch( sub {
  201     my $err = shift;
  202     warn "Something went wrong: $err";
  203 } )->wait;
  204 #1...........
  205         },
  206 
  207         'rt123774.def' => {
  208             source => "rt123774",
  209             params => "def",
  210             expect => <<'#2...........',
  211 # retain any space between backslash and quote to avoid fooling html formatters
  212 my $var1 = \ "bubba";
  213 my $var2 = \"bubba";
  214 my $var3 = \ 'bubba';
  215 my $var4 = \'bubba';
  216 my $var5 = \ "bubba";
  217 #2...........
  218         },
  219 
  220         'rt124114.def' => {
  221             source => "rt124114",
  222             params => "def",
  223             expect => <<'#3...........',
  224 #!/usr/bin/perl 
  225 my %h = {
  226     a    => 2 > 3 ? 1 : 0,
  227     bbbb => sub { my $y = "1" },
  228     c    => sub { my $z = "2" },
  229     d    => 2 > 3 ? 1 : 0,
  230 };
  231 #3...........
  232         },
  233 
  234         'rt124354.def' => {
  235             source => "rt124354",
  236             params => "def",
  237             expect => <<'#4...........',
  238 package Foo;
  239 
  240 use Moose;
  241 
  242 has a => ( is => 'ro', isa => 'Int' );
  243 has b => ( is => 'ro', isa => 'Int' );
  244 has c => ( is => 'ro', isa => 'Int' );
  245 
  246 __PACKAGE__->meta->make_immutable;
  247 #4...........
  248         },
  249 
  250         'rt124354.rt124354' => {
  251             source => "rt124354",
  252             params => "rt124354",
  253             expect => <<'#5...........',
  254 package Foo;
  255 
  256 use Moose;
  257 
  258 has a => ( is => 'ro', isa => 'Int' );
  259 has b => ( is => 'ro', isa => 'Int' );
  260 has c => ( is => 'ro', isa => 'Int' );
  261 
  262 __PACKAGE__->meta->make_immutable;
  263 #5...........
  264         },
  265 
  266         'rt125012.def' => {
  267             source => "rt125012",
  268             params => "def",
  269             expect => <<'#6...........',
  270 ++$_ for
  271 
  272   #one space before eol:
  273   values %_;
  274 system
  275 
  276   #one space before eol:
  277   qq{};
  278 #6...........
  279         },
  280 
  281         'rt125012.rt125012' => {
  282             source => "rt125012",
  283             params => "rt125012",
  284             expect => <<'#7...........',
  285 ++$_ for
  286   values%_;
  287 system
  288   qq{};
  289 #7...........
  290         },
  291 
  292         'rt125506.def' => {
  293             source => "rt125506",
  294             params => "def",
  295             expect => <<'#8...........',
  296 my $t = '
  297         un
  298         deux
  299         trois
  300 	';
  301 #8...........
  302         },
  303 
  304         'rt125506.rt125506' => {
  305             source => "rt125506",
  306             params => "rt125506",
  307             expect => <<'#9...........',
  308 my $t = '
  309         un
  310         deux
  311         trois
  312 	';
  313 #9...........
  314         },
  315 
  316         'rt126965.def' => {
  317             source => "rt126965",
  318             params => "def",
  319             expect => <<'#10...........',
  320 my $restrict_customer = shift ? 1 : 0;
  321 #10...........
  322         },
  323 
  324         'rt15735.def' => {
  325             source => "rt15735",
  326             params => "def",
  327             expect => <<'#11...........',
  328 my $user_prefs =
  329     $ref_type eq 'SCALAR' ? _load_from_string($profile)
  330   : $ref_type eq 'ARRAY'  ? _load_from_array($profile)
  331   : $ref_type eq 'HASH'   ? _load_from_hash($profile)
  332   :                         _load_from_file($profile);
  333 #11...........
  334         },
  335 
  336         'rt18318.def' => {
  337             source => "rt18318",
  338             params => "def",
  339             expect => <<'#12...........',
  340 # Class::Std attribute list
  341 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
  342 # after it
  343 my %rank_of : ATTR( :init_arg<starting_rank>  :get<rank>  :set<rank> );
  344 #12...........
  345         },
  346 
  347         'rt18318.rt18318' => {
  348             source => "rt18318",
  349             params => "rt18318",
  350             expect => <<'#13...........',
  351 # Class::Std attribute list
  352 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
  353 # after it
  354 my %rank_of :ATTR( :init_arg<starting_rank>  :get<rank>  :set<rank> );
  355 #13...........
  356         },
  357 
  358         'rt27000.def' => {
  359             source => "rt27000",
  360             params => "def",
  361             expect => <<'#14...........',
  362 print add( 3, 4 ), "\n";
  363 print add( 4, 3 ), "\n";
  364 
  365 sub add {
  366     my ( $term1, $term2 ) = @_;
  367 # line 1234
  368     die "$term1 > $term2" if $term1 > $term2;
  369     return $term1 + $term2;
  370 }
  371 #14...........
  372         },
  373 
  374         'rt31741.def' => {
  375             source => "rt31741",
  376             params => "def",
  377             expect => <<'#15...........',
  378 $msg //= 'World';
  379 #15...........
  380         },
  381 
  382         'rt49289.def' => {
  383             source => "rt49289",
  384             params => "def",
  385             expect => <<'#16...........',
  386 use constant qw{ DEBUG 0 };
  387 #16...........
  388         },
  389 
  390         'rt50702.def' => {
  391             source => "rt50702",
  392             params => "def",
  393             expect => <<'#17...........',
  394 if (1) {
  395     my $uid =
  396          $ENV{'ORIG_LOGNAME'}
  397       || $ENV{'LOGNAME'}
  398       || $ENV{'REMOTE_USER'}
  399       || 'foobar';
  400 }
  401 if (2) {
  402     my $uid =
  403       (      $ENV{'ORIG_LOGNAME'}
  404           || $ENV{'LOGNAME'}
  405           || $ENV{'REMOTE_USER'}
  406           || 'foobar' );
  407 }
  408 #17...........
  409         },
  410 
  411         'rt50702.rt50702' => {
  412             source => "rt50702",
  413             params => "rt50702",
  414             expect => <<'#18...........',
  415 if (1) {
  416     my $uid
  417       = $ENV{'ORIG_LOGNAME'}
  418       || $ENV{'LOGNAME'}
  419       || $ENV{'REMOTE_USER'}
  420       || 'foobar';
  421 }
  422 if (2) {
  423     my $uid
  424       = (    $ENV{'ORIG_LOGNAME'}
  425           || $ENV{'LOGNAME'}
  426           || $ENV{'REMOTE_USER'}
  427           || 'foobar' );
  428 }
  429 #18...........
  430         },
  431 
  432         'rt68870.def' => {
  433             source => "rt68870",
  434             params => "def",
  435             expect => <<'#19...........',
  436 s///r;
  437 #19...........
  438         },
  439 
  440         'rt70747.def' => {
  441             source => "rt70747",
  442             params => "def",
  443             expect => <<'#20...........',
  444 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
  445     [
  446         map {
  447             my $g = $_->as_hash;
  448             $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ];
  449             $g;
  450         } @$_;
  451     ]
  452 };
  453 #20...........
  454         },
  455     };
  456 
  457     my $ntests = 0 + keys %{$rtests};
  458     plan tests => $ntests;
  459 }
  460 
  461 ###############
  462 # EXECUTE TESTS
  463 ###############
  464 
  465 foreach my $key ( sort keys %{$rtests} ) {
  466     my $output;
  467     my $sname  = $rtests->{$key}->{source};
  468     my $expect = $rtests->{$key}->{expect};
  469     my $pname  = $rtests->{$key}->{params};
  470     my $source = $rsources->{$sname};
  471     my $params = defined($pname) ? $rparams->{$pname} : "";
  472     my $stderr_string;
  473     my $errorfile_string;
  474     my $err = Perl::Tidy::perltidy(
  475         source      => \$source,
  476         destination => \$output,
  477         perltidyrc  => \$params,
  478         argv        => '',             # for safety; hide any ARGV from perltidy
  479         stderr      => \$stderr_string,
  480         errorfile => \$errorfile_string,    # not used when -se flag is set
  481     );
  482     if ( $err || $stderr_string || $errorfile_string ) {
  483         if ($err) {
  484             print STDERR
  485 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
  486             ok( !$err );
  487         }
  488         if ($stderr_string) {
  489             print STDERR "---------------------\n";
  490             print STDERR "<<STDERR>>\n$stderr_string\n";
  491             print STDERR "---------------------\n";
  492             print STDERR
  493 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
  494             ok( !$stderr_string );
  495         }
  496         if ($errorfile_string) {
  497             print STDERR "---------------------\n";
  498             print STDERR "<<.ERR file>>\n$errorfile_string\n";
  499             print STDERR "---------------------\n";
  500             print STDERR
  501 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
  502             ok( !$errorfile_string );
  503         }
  504     }
  505     else {
  506         ok( $output, $expect );
  507     }
  508 }