1 # Created with: ./make_t.pl
25 # To locate test #13 you can search for its name or the string '#13'
37 ###########################################
38 # BEGIN SECTION 1: Parameter combinations #
39 ###########################################
42 'otr' => <<'----------',
47 'pbp' => "-pbp -nst -nse",
50 ############################
51 # BEGIN SECTION 2: Sources #
52 ############################
55 'otr1' => <<'----------',
61 : ref $_ eq "ARRAY" ? join ':', @$_
63 : die "INVALID SLICE DEF $_"
69 'pbp1' => <<'----------',
70 # break after '+' if default, before + if pbp
71 my $min_gnu_indentation = $standard_increment +
72 $gnu_stack[$max_gnu_stack_index]->get_SPACES();
75 'pbp2' => <<'----------',
76 $tmp = $day - 32075 + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4 + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
79 'pbp3' => <<'----------',
80 return $sec + $SecOff + ( SECS_PER_MINUTE * $min ) + ( SECS_PER_HOUR * $hour ) + ( SECS_PER_DAY * $days );
85 'pbp4' => <<'----------',
86 # with defaults perltidy will break after the '=' here
87 my @host_seq = $level eq "easy" ?
88 @reordered : 0..$last; # reordered has CDROM up front
91 'pbp5' => <<'----------',
92 # illustates problem with -pbp: -ci should not equal -i
93 say 'ok_200_24_hours.value '.average({'$and'=>[{time=>{'$gt',$time-60*60*24}},{status=>200}]});
97 'print1' => <<'----------',
98 # same text twice. Has uncontained commas; -- leave as is
99 print "conformability (Not the same dimension)\n",
102 text_unit($hu), "\n", "\t", $want, " is ", text_unit($wu), "\n",;
105 "conformability (Not the same dimension)\n",
106 "\t", $have, " is ", text_unit($hu), "\n",
107 "\t", $want, " is ", text_unit($wu), "\n",
111 'q1' => <<'----------',
112 print qq(You are in zone $thisTZ
113 Difference with respect to GMT is ), $offset / 3600, qq( hours
114 And local time is $hour hours $min minutes $sec seconds
118 'q2' => <<'----------',
124 'recombine1' => <<'----------',
125 # recombine '= [' here:
127 [ &{ $sth->{'xbase_parsed_sql'}{'selectfn'} }
128 ( $xbase, $values, $sth->{'xbase_bind_values'} ) ]
132 'recombine2' => <<'----------',
133 # recombine = unless old break there
134 $a = [ length( $self->{fb}[-1] ), $#{ $self->{fb} } ] ; # set cursor at end of buffer and print this cursor
137 'recombine3' => <<'----------',
138 # recombine final line
140 ($catpage =~ m:\.gz:)
147 'recombine4' => <<'----------',
148 # do not recombine into two lines after a comma if
149 # the term is complex (has parens) or changes level
150 $delta_time = sprintf "%.4f", ( ( $done[0] + ( $done[1] / 1e6 ) ) - ( $start[0] + ( $start[1] / 1e6 ) ) );
153 'rt101547' => <<'----------',
154 { source_host => MM::Config->instance->host // q{}, }
157 'rt102371' => <<'----------',
162 ####################################
163 # BEGIN SECTION 3: Expected output #
164 ####################################
170 expect => <<'#1...........',
175 : ref $_ eq "ARRAY" ? join ':', @$_
177 : die "INVALID SLICE DEF $_"
187 expect => <<'#2...........',
188 # break after '+' if default, before + if pbp
189 my $min_gnu_indentation = $standard_increment +
190 $gnu_stack[$max_gnu_stack_index]->get_SPACES();
197 expect => <<'#3...........',
198 # break after '+' if default, before + if pbp
199 my $min_gnu_indentation = $standard_increment
200 + $gnu_stack[$max_gnu_stack_index]->get_SPACES();
207 expect => <<'#4...........',
210 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4 +
211 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 -
212 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
219 expect => <<'#5...........',
222 + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4
223 + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
224 - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
231 expect => <<'#6...........',
232 return $sec + $SecOff +
233 ( SECS_PER_MINUTE * $min ) +
234 ( SECS_PER_HOUR * $hour ) +
235 ( SECS_PER_DAY * $days );
243 expect => <<'#7...........',
246 + ( SECS_PER_MINUTE * $min )
247 + ( SECS_PER_HOUR * $hour )
248 + ( SECS_PER_DAY * $days );
256 expect => <<'#8...........',
257 # with defaults perltidy will break after the '=' here
259 $level eq "easy" ? @reordered : 0 .. $last; # reordered has CDROM up front
266 expect => <<'#9...........',
267 # with defaults perltidy will break after the '=' here
271 : 0 .. $last; # reordered has CDROM up front
278 expect => <<'#10...........',
279 # illustates problem with -pbp: -ci should not equal -i
280 say 'ok_200_24_hours.value '
284 [ { time => { '$gt', $time - 60 * 60 * 24 } }, { status => 200 } ]
294 expect => <<'#11...........',
295 # illustates problem with -pbp: -ci should not equal -i
296 say 'ok_200_24_hours.value '
299 { time => { '$gt', $time - 60 * 60 * 24 } }, { status => 200 }
310 expect => <<'#12...........',
311 # same text twice. Has uncontained commas; -- leave as is
312 print "conformability (Not the same dimension)\n",
315 text_unit($hu), "\n", "\t", $want, " is ", text_unit($wu), "\n",;
318 "conformability (Not the same dimension)\n",
319 "\t", $have, " is ", text_unit($hu), "\n",
320 "\t", $want, " is ", text_unit($wu), "\n",
328 expect => <<'#13...........',
329 print qq(You are in zone $thisTZ
330 Difference with respect to GMT is ), $offset / 3600, qq( hours
331 And local time is $hour hours $min minutes $sec seconds
339 expect => <<'#14...........',
346 'recombine1.def' => {
347 source => "recombine1",
349 expect => <<'#15...........',
350 # recombine '= [' here:
352 [ &{ $sth->{'xbase_parsed_sql'}{'selectfn'} }
353 ( $xbase, $values, $sth->{'xbase_bind_values'} ) ]
358 'recombine2.def' => {
359 source => "recombine2",
361 expect => <<'#16...........',
362 # recombine = unless old break there
363 $a = [ length( $self->{fb}[-1] ), $#{ $self->{fb} } ]
364 ; # set cursor at end of buffer and print this cursor
368 'recombine3.def' => {
369 source => "recombine3",
371 expect => <<'#17...........',
372 # recombine final line
374 ( $catpage =~ m:\.gz: )
381 'recombine4.def' => {
382 source => "recombine4",
384 expect => <<'#18...........',
385 # do not recombine into two lines after a comma if
386 # the term is complex (has parens) or changes level
387 $delta_time = sprintf "%.4f",
388 ( ( $done[0] + ( $done[1] / 1e6 ) ) -
389 ( $start[0] + ( $start[1] / 1e6 ) ) );
394 source => "rt101547",
396 expect => <<'#19...........',
397 { source_host => MM::Config->instance->host // q{}, }
402 source => "rt102371",
404 expect => <<'#20...........',
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";