1 # Created with: ./make_t.pl
13 # To locate test #13 you can search for its name or the string '#13'
25 ###########################################
26 # BEGIN SECTION 1: Parameter combinations #
27 ###########################################
32 'git93' => <<'----------',
35 'lpxl6' => <<'----------',
36 # equivalent to -lpxl='{ [ F(2'
41 ############################
42 # BEGIN SECTION 2: Sources #
43 ############################
46 'bal' => <<'----------',
54 'c133' => <<'----------',
55 # this will make 1 line unless -boc is used
57 $x * cos($a) - $y * sin($a),
58 $x * sin($a) + $y * cos($a)
61 # broken list - issue c133
63 $x * cos($a) - $y * sin($a),
64 $x * sin($a) + $y * cos($a)
70 $x * cos($a) - $y * sin($a),
71 $x * sin($a) + $y * cos($a);
74 'c139' => <<'----------',
75 # The '&' has trailing spaces
80 # This '$' has trailing spaces
84 # this arrow has trailing spaces
86 sql_set_env_attr( $evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0 );
88 # spaces and blank line
94 # spaces and blank line
97 sql_set_env_attr( $evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0 );
100 'git93' => <<'----------',
103 use IPC::Cmd qw{can_run run QUOTE};
104 use File::Path qw/mkpath/;
105 use File::Temp qw[tempdir];
106 use Params::Check qw<check>;
107 use Module::Load::Conditional qw#can_load#;
108 use Locale::Maketext::Simple Style => 'gettext'; # does not align
110 # do not align on these 'q' token types - not use statements...
111 my $gene_color_sets = [
112 [ qw( blue blue blue blue ) => 'blue' ],
113 [ qw( brown blue blue blue ) => 'brown' ],
114 [ qw( brown brown green green ) => 'brown' ],
117 sub quux : PluginKeyword { 'quux' }
118 sub qaax : PluginKeyword(qiix) { die "unimplemented" }
120 use vars qw($curdir);
124 'lpxl' => <<'----------',
125 # simple function call
126 my $loanlength = getLoanLength(
127 $borrower->{'categorycode'}, # sc1
128 $iteminformation->{'itemtype'},
129 $borrower->{'branchcode'} # sc3
132 # function call, more than one level deep
133 my $o = very::long::class::name->new(
141 # function call with sublist
144 "Extra-Parameters: " . join("<->", $extra_parms),
145 "Config: " . join("<->", %config)
148 # simple function call with code block
149 $m->command(-label => 'Save',
150 -command => sub { print "DOS\n"; save_dialog($win); });
152 # function call, ternary in list
154 OptArgs2::Result->usage(
155 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
156 'usage: ' . $usage . "\n" );
158 # not a function call
166 # 'local' is a keyword, not a user function
168 $len, $pts, @colspec, $char, $cols,
169 $repeat, $celldata, $at_text, $after_text
172 # square bracket with sublists
174 ListElem->new(id => 0, val => 100),
175 ListElem->new(id => 2, val => 50),
176 ListElem->new(id => 1, val => 10),
179 # curly brace with sublists
181 cat => {nap => "lap", eat => "meat"},
182 dog => {prowl => "growl", pool => "drool"},
183 mouse => {nibble => "kibble"},
188 ####################################
189 # BEGIN SECTION 3: Expected output #
190 ####################################
196 expect => <<'#1...........',
206 expect => <<'#2...........',
218 expect => <<'#3...........',
219 # simple function call
220 my $loanlength = getLoanLength(
221 $borrower->{'categorycode'}, # sc1
222 $iteminformation->{'itemtype'},
223 $borrower->{'branchcode'} # sc3
226 # function call, more than one level deep
227 my $o = very::long::class::name->new(
235 # function call with sublist
238 "Extra-Parameters: " . join( "<->", $extra_parms ),
239 "Config: " . join( "<->", %config )
242 # simple function call with code block
245 -command => sub { print "DOS\n"; save_dialog($win); }
248 # function call, ternary in list
249 return OptArgs2::Result->usage(
250 $style == OptArgs2::STYLE_FULL ? 'FullUsage' : 'NormalUsage',
251 'usage: ' . $usage . "\n" );
253 # not a function call
261 # 'local' is a keyword, not a user function
263 $len, $pts, @colspec, $char, $cols,
264 $repeat, $celldata, $at_text, $after_text
267 # square bracket with sublists
269 ListElem->new( id => 0, val => 100 ),
270 ListElem->new( id => 2, val => 50 ),
271 ListElem->new( id => 1, val => 10 ),
274 # curly brace with sublists
276 cat => { nap => "lap", eat => "meat" },
277 dog => { prowl => "growl", pool => "drool" },
278 mouse => { nibble => "kibble" },
286 expect => <<'#4...........',
287 # this will make 1 line unless -boc is used
289 $x * cos($a) - $y * sin($a),
290 $x * sin($a) + $y * cos($a)
293 # broken list - issue c133
295 $x * cos($a) - $y * sin($a),
296 $x * sin($a) + $y * cos($a)
302 $x * cos($a) - $y * sin($a),
303 $x * sin($a) + $y * cos($a);
310 expect => <<'#5...........',
311 # this will make 1 line unless -boc is used
312 return ( $x * cos($a) - $y * sin($a), $x * sin($a) + $y * cos($a) );
314 # broken list - issue c133
316 $x * cos($a) - $y * sin($a),
317 $x * sin($a) + $y * cos($a)
323 $x * cos($a) - $y * sin($a),
324 $x * sin($a) + $y * cos($a);
331 expect => <<'#6...........',
334 use IPC::Cmd qw{can_run run QUOTE};
335 use File::Path qw/mkpath/;
336 use File::Temp qw[tempdir];
337 use Params::Check qw<check>;
338 use Module::Load::Conditional qw#can_load#;
339 use Locale::Maketext::Simple Style => 'gettext'; # does not align
341 # do not align on these 'q' token types - not use statements...
342 my $gene_color_sets = [
343 [ qw( blue blue blue blue ) => 'blue' ],
344 [ qw( brown blue blue blue ) => 'brown' ],
345 [ qw( brown brown green green ) => 'brown' ],
348 sub quux : PluginKeyword { 'quux' }
349 sub qaax : PluginKeyword(qiix) { die "unimplemented" }
351 use vars qw($curdir);
359 expect => <<'#7...........',
362 use IPC::Cmd qw{can_run run QUOTE};
363 use File::Path qw/mkpath/;
364 use File::Temp qw[tempdir];
365 use Params::Check qw<check>;
366 use Module::Load::Conditional qw#can_load#;
367 use Locale::Maketext::Simple Style => 'gettext'; # does not align
369 # do not align on these 'q' token types - not use statements...
370 my $gene_color_sets = [
371 [ qw( blue blue blue blue ) => 'blue' ],
372 [ qw( brown blue blue blue ) => 'brown' ],
373 [ qw( brown brown green green ) => 'brown' ],
376 sub quux : PluginKeyword { 'quux' }
377 sub qaax : PluginKeyword(qiix) { die "unimplemented" }
379 use vars qw($curdir);
387 expect => <<'#8...........',
388 # The '&' has trailing spaces
391 # This '$' has trailing spaces
394 # this arrow has trailing spaces
395 $r = $c->sql_set_env_attr( $evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0 );
397 # spaces and blank line
402 # spaces and blank line
405 sql_set_env_attr( $evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0 );
410 my $ntests = 0 + keys %{$rtests};
411 plan tests => $ntests;
418 foreach my $key ( sort keys %{$rtests} ) {
420 my $sname = $rtests->{$key}->{source};
421 my $expect = $rtests->{$key}->{expect};
422 my $pname = $rtests->{$key}->{params};
423 my $source = $rsources->{$sname};
424 my $params = defined($pname) ? $rparams->{$pname} : "";
426 my $errorfile_string;
427 my $err = Perl::Tidy::perltidy(
429 destination => \$output,
430 perltidyrc => \$params,
431 argv => '', # for safety; hide any ARGV from perltidy
432 stderr => \$stderr_string,
433 errorfile => \$errorfile_string, # not used when -se flag is set
435 if ( $err || $stderr_string || $errorfile_string ) {
436 print STDERR "Error output received for test '$key'\n";
438 print STDERR "An error flag '$err' was returned\n";
441 if ($stderr_string) {
442 print STDERR "---------------------\n";
443 print STDERR "<<STDERR>>\n$stderr_string\n";
444 print STDERR "---------------------\n";
445 ok( !$stderr_string );
447 if ($errorfile_string) {
448 print STDERR "---------------------\n";
449 print STDERR "<<.ERR file>>\n$errorfile_string\n";
450 print STDERR "---------------------\n";
451 ok( !$errorfile_string );
455 if ( !is( $output, $expect, $key ) ) {
456 my $leno = length($output);
457 my $lene = length($expect);
458 if ( $leno == $lene ) {
460 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
464 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";