1 # Created with: ./make_t.pl
8 # To locate test #13 you can search for its name or the string '#13'
20 ###########################################
21 # BEGIN SECTION 1: Parameter combinations #
22 ###########################################
26 'lpxl6' => <<'----------',
27 # equivalent to -lpxl='{ [ F(2'
32 ############################
33 # BEGIN SECTION 2: Sources #
34 ############################
37 'bal' => <<'----------',
45 'lpxl' => <<'----------',
46 # simple function call
47 my $loanlength = getLoanLength(
48 $borrower->{'categorycode'}, # sc1
49 $iteminformation->{'itemtype'},
50 $borrower->{'branchcode'} # sc3
53 # function call, more than one level deep
54 my $o = very::long::class::name->new(
62 # function call with sublist
65 "Extra-Parameters: " . join("<->", $extra_parms),
66 "Config: " . join("<->", %config)
69 # simple function call with code block
70 $m->command(-label => 'Save',
71 -command => sub { print "DOS\n"; save_dialog($win); });
73 # function call, ternary in list
75 OptArgs2::Result->usage(
76 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
77 'usage: ' . $usage . "\n" );
87 # 'local' is a keyword, not a user function
89 $len, $pts, @colspec, $char, $cols,
90 $repeat, $celldata, $at_text, $after_text
93 # square bracket with sublists
95 ListElem->new(id => 0, val => 100),
96 ListElem->new(id => 2, val => 50),
97 ListElem->new(id => 1, val => 10),
100 # curly brace with sublists
102 cat => {nap => "lap", eat => "meat"},
103 dog => {prowl => "growl", pool => "drool"},
104 mouse => {nibble => "kibble"},
109 ####################################
110 # BEGIN SECTION 3: Expected output #
111 ####################################
117 expect => <<'#1...........',
127 expect => <<'#2...........',
139 expect => <<'#3...........',
140 # simple function call
141 my $loanlength = getLoanLength(
142 $borrower->{'categorycode'}, # sc1
143 $iteminformation->{'itemtype'},
144 $borrower->{'branchcode'} # sc3
147 # function call, more than one level deep
148 my $o = very::long::class::name->new(
156 # function call with sublist
159 "Extra-Parameters: " . join( "<->", $extra_parms ),
160 "Config: " . join( "<->", %config )
163 # simple function call with code block
166 -command => sub { print "DOS\n"; save_dialog($win); }
169 # function call, ternary in list
170 return OptArgs2::Result->usage(
171 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
172 'usage: ' . $usage . "\n" );
174 # not a function call
182 # 'local' is a keyword, not a user function
184 $len, $pts, @colspec, $char, $cols,
185 $repeat, $celldata, $at_text, $after_text
188 # square bracket with sublists
190 ListElem->new( id => 0, val => 100 ),
191 ListElem->new( id => 2, val => 50 ),
192 ListElem->new( id => 1, val => 10 ),
195 # curly brace with sublists
197 cat => { nap => "lap", eat => "meat" },
198 dog => { prowl => "growl", pool => "drool" },
199 mouse => { nibble => "kibble" },
205 my $ntests = 0 + keys %{$rtests};
206 plan tests => $ntests;
213 foreach my $key ( sort keys %{$rtests} ) {
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} : "";
221 my $errorfile_string;
222 my $err = Perl::Tidy::perltidy(
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
230 if ( $err || $stderr_string || $errorfile_string ) {
231 print STDERR "Error output received for test '$key'\n";
233 print STDERR "An error flag '$err' was returned\n";
236 if ($stderr_string) {
237 print STDERR "---------------------\n";
238 print STDERR "<<STDERR>>\n$stderr_string\n";
239 print STDERR "---------------------\n";
240 ok( !$stderr_string );
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 );
250 if ( !is( $output, $expect, $key ) ) {
251 my $leno = length($output);
252 my $lene = length($expect);
253 if ( $leno == $lene ) {
255 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
259 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";