t/snippets26.t

   1 # Created with: ./make_t.pl
   2
   3 # Contents:
   4 #1 bal.bal2
   5 #2 bal.def
   6 #3 lpxl.lpxl6
   7
   8 # To locate test #13 you can search for its name or the string '#13'
   9
  10 use strict;
  11 use Test::More;
  12 use Carp;
  13 use Perl::Tidy;
  14 my $rparams;
  15 my $rsources;
  16 my $rtests;
  17
  18 BEGIN {
  19
  20     ###########################################
  21     # BEGIN SECTION 1: Parameter combinations #
  22     ###########################################
  23     $rparams = {
  24         'bal2'  => "-bal=2",
  25         'def'   => "",
  26         'lpxl6' => <<'----------',
  27 # equivalent to -lpxl='{ [ F(2'
  28 -lp -lpil='f(2'
  29 ----------
  30     };
  31
  32     ############################
  33     # BEGIN SECTION 2: Sources #
  34     ############################
  35     $rsources = {
  36
  37         'bal' => <<'----------',
  38 {
  39   L1:
  40   L2:
  41   L3: return;
  42 };
  43 ----------
  44
  45         'lpxl' => <<'----------',
  46 # simple function call
  47 my $loanlength = getLoanLength(
  48                                 $borrower->{'categorycode'},    # sc1
  49                                 $iteminformation->{'itemtype'},
  50                                 $borrower->{'branchcode'}       # sc3
  51 );
  52
  53 # function call, more than one level deep
  54 my $o = very::long::class::name->new(
  55     {
  56         propA => "a",
  57         propB => "b",
  58         propC => "c",
  59     }
  60 );
  61
  62 # function call with sublist
  63 debug(
  64       "Connecting to DB.",
  65       "Extra-Parameters: " . join("<->", $extra_parms),
  66       "Config: " . join("<->", %config)
  67      );
  68
  69 # simple function call with code block
  70 $m->command(-label   => 'Save',
  71             -command => sub { print "DOS\n"; save_dialog($win); });
  72
  73 # function call, ternary in list
  74 return
  75   OptArgs2::Result->usage(
  76     $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
  77     'usage: ' . $usage . "\n" );
  78
  79 # not a function call
  80 %blastparam = (
  81     -run            => \%runparam,
  82     -file           => '',
  83     -parse          => 1,
  84     -signif         => 1e-5,
  85 );
  86
  87 # 'local' is a keyword, not a user function
  88     local (
  89         $len,    $pts,      @colspec, $char, $cols,
  90         $repeat, $celldata, $at_text, $after_text
  91     );
  92
  93 # square bracket with sublists
  94 $data = [
  95          ListElem->new(id => 0, val => 100),
  96          ListElem->new(id => 2, val => 50),
  97          ListElem->new(id => 1, val => 10),
  98         ];
  99
 100 # curly brace with sublists
 101 $behaviour = {
 102               cat   => {nap    => "lap",   eat  => "meat"},
 103               dog   => {prowl  => "growl", pool => "drool"},
 104               mouse => {nibble => "kibble"},
 105              };
 106 ----------
 107     };
 108
 109     ####################################
 110     # BEGIN SECTION 3: Expected output #
 111     ####################################
 112     $rtests = {
 113
 114         'bal.bal2' => {
 115             source => "bal",
 116             params => "bal2",
 117             expect => <<'#1...........',
 118 {
 119   L1: L2: L3: return;
 120 };
 121 #1...........
 122         },
 123
 124         'bal.def' => {
 125             source => "bal",
 126             params => "def",
 127             expect => <<'#2...........',
 128 {
 129   L1:
 130   L2:
 131   L3: return;
 132 };
 133 #2...........
 134         },
 135
 136         'lpxl.lpxl6' => {
 137             source => "lpxl",
 138             params => "lpxl6",
 139             expect => <<'#3...........',
 140 # simple function call
 141 my $loanlength = getLoanLength(
 142                                 $borrower->{'categorycode'},    # sc1
 143                                 $iteminformation->{'itemtype'},
 144                                 $borrower->{'branchcode'}       # sc3
 145 );
 146
 147 # function call, more than one level deep
 148 my $o = very::long::class::name->new(
 149     {
 150         propA => "a",
 151         propB => "b",
 152         propC => "c",
 153     }
 154 );
 155
 156 # function call with sublist
 157 debug(
 158     "Connecting to DB.",
 159     "Extra-Parameters: " . join( "<->", $extra_parms ),
 160     "Config: " . join( "<->", %config )
 161 );
 162
 163 # simple function call with code block
 164 $m->command(
 165     -label   => 'Save',
 166     -command => sub { print "DOS\n"; save_dialog($win); }
 167 );
 168
 169 # function call, ternary in list
 170 return OptArgs2::Result->usage(
 171     $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
 172     'usage: ' . $usage . "\n" );
 173
 174 # not a function call
 175 %blastparam = (
 176     -run    => \%runparam,
 177     -file   => '',
 178     -parse  => 1,
 179     -signif => 1e-5,
 180 );
 181
 182 # 'local' is a keyword, not a user function
 183 local (
 184     $len,    $pts,      @colspec, $char, $cols,
 185     $repeat, $celldata, $at_text, $after_text
 186 );
 187
 188 # square bracket with sublists
 189 $data = [
 190     ListElem->new( id => 0, val => 100 ),
 191     ListElem->new( id => 2, val => 50 ),
 192     ListElem->new( id => 1, val => 10 ),
 193 ];
 194
 195 # curly brace with sublists
 196 $behaviour = {
 197     cat   => { nap    => "lap",   eat  => "meat" },
 198     dog   => { prowl  => "growl", pool => "drool" },
 199     mouse => { nibble => "kibble" },
 200 };
 201 #3...........
 202         },
 203     };
 204
 205     my $ntests = 0 + keys %{$rtests};
 206     plan tests => $ntests;
 207 }
 208
 209 ###############
 210 # EXECUTE TESTS
 211 ###############
 212
 213 foreach my $key ( sort keys %{$rtests} ) {
 214     my $output;
 215     my $sname  = $rtests->{$key}->{source};
 216     my $expect = $rtests->{$key}->{expect};
 217     my $pname  = $rtests->{$key}->{params};
 218     my $source = $rsources->{$sname};
 219     my $params = defined($pname) ? $rparams->{$pname} : "";
 220     my $stderr_string;
 221     my $errorfile_string;
 222     my $err = Perl::Tidy::perltidy(
 223         source      => \$source,
 224         destination => \$output,
 225         perltidyrc  => \$params,
 226         argv        => '',             # for safety; hide any ARGV from perltidy
 227         stderr      => \$stderr_string,
 228         errorfile   => \$errorfile_string,    # not used when -se flag is set
 229     );
 230     if ( $err || $stderr_string || $errorfile_string ) {
 231         print STDERR "Error output received for test '$key'\n";
 232         if ($err) {
 233             print STDERR "An error flag '$err' was returned\n";
 234             ok( !$err );
 235         }
 236         if ($stderr_string) {
 237             print STDERR "---------------------\n";
 238             print STDERR "<<STDERR>>\n$stderr_string\n";
 239             print STDERR "---------------------\n";
 240             ok( !$stderr_string );
 241         }
 242         if ($errorfile_string) {
 243             print STDERR "---------------------\n";
 244             print STDERR "<<.ERR file>>\n$errorfile_string\n";
 245             print STDERR "---------------------\n";
 246             ok( !$errorfile_string );
 247         }
 248     }
 249     else {
 250         if ( !is( $output, $expect, $key ) ) {
 251             my $leno = length($output);
 252             my $lene = length($expect);
 253             if ( $leno == $lene ) {
 254                 print STDERR
 255 "#> Test '$key' gave unexpected output.  Strings differ but both have length $leno\n";
 256             }
 257             else {
 258                 print STDERR
 259 "#> Test '$key' gave unexpected output.  String lengths differ: output=$leno, expected=$lene\n";
 260             }
 261         }
 262     }
 263 }