1 # Created with: ./make_t.pl
21 #18 hanging_side_comments3.def
24 # To locate test #13 you can search for its name or the string '#13'
36 ###########################################
37 # BEGIN SECTION 1: Parameter combinations #
38 ###########################################
40 'ce' => "-cuddled-blocks",
44 'kpit' => "-pt=2 -kpit=0",
45 'kpitl' => <<'----------',
46 -kpit=0 -kpitl='return factorial' -pt=2
48 'outdent2' => <<'----------',
52 'space6' => <<'----------',
60 ############################
61 # BEGIN SECTION 2: Sources #
62 ############################
65 'ce2' => <<'----------',
66 # Previously, perltidy -ce would move a closing brace below a pod section to
67 # form '} else {'. No longer doing this because if you change back to -nce, the
68 # brace cannot go back to where it was.
76 If there is a TTY, we have to determine who it belongs to before we can
83 # Is Perl being run from a slave editor or graphical debugger?
88 'git25' => <<'----------',
89 # example for git #25; use -l=0; was losing alignment; sub 'fix_ragged_lists' was added to fix this
92 { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
93 { 'is_col' => 'corona_ieorres', 'cr_col' => '', 'trans' => 0, },
94 { 'is_col' => 'symptoms_fever', 'cr_col' => 'elig_fever', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
95 { 'is_col' => 'symptoms_cough', 'cr_col' => 'elig_cough', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
96 { 'is_col' => 'symptoms_dys_tachy_noea', 'cr_col' => 'elig_dyspnea', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
97 { 'is_col' => 'symptoms_clinical_susp', 'cr_col' => 'elig_ari', 'trans' => 0, },
98 { 'is_col' => 'sex', 'cr_col' => 'sex', 'trans' => 1, 'manually_reviewed' => 1, 'map' => { '0' => '1', '1' => '2' }, },
99 { 'is_col' => 'age', 'cr_col' => '', 'trans' => 0, },
100 { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
106 'gnu6' => <<'----------',
107 # the closing braces should have the same position for these two hashes with -gnu
121 'hanging_side_comments3' => <<'----------',
122 if ( $var eq 'wastebasket' ) { # this sends a pure block
123 # of hanging side comments
124 #to the vertical aligner.
125 #It caused a crash in
127 #sub 'delete_unmatched_tokens'
131 elsif ( $var eq 'spacecommand' ) {
132 &die("No $val function") unless eval "defined &$val";
136 'kpit' => <<'----------',
137 if ( seek(DATA, 0, 0) ) { ... }
139 # The foreach keyword may be separated from the next opening paren
140 foreach $req(@bgQueue) {
144 # This had trouble because a later padding operation removed the inside space
145 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
146 || @CmdQueue > 0 && $RunNightlyWhenIdle == 2 && $bpc->isAdminJob($CmdQueue[0]->{host})) {
152 'kpitl' => <<'----------',
153 return ( $r**$n ) * ( pi**( $n / 2 ) ) / ( sqrt(pi) * factorial( 2 * ( int( $n
154 / 2 ) ) + 2 ) / factorial( int( $n / 2 ) + 1 ) / ( 4**( int( $n / 2 ) + 1 ) )
158 'lop' => <<'----------',
159 # logical padding examples
164 && ( $a->{'title'} eq $b->{'title'} )
165 && ( $a->{'href'} eq $b->{'href'} ) );
173 lc( $self->mime_attr('content-type')
174 || $self->{MIH_DefaultType}
177 # Padding can also remove spaces; here the space after the '(' is lost:
178 elsif ( $statement_type =~ /^sub\b/
179 || $paren_type[$paren_depth] =~ /^sub\b/ )
182 'outdent' => <<'----------',
184 LOOP: while ( $i = <FOTOS> ) {
192 'space6' => <<'----------',
193 # test some spacing rules at possible filehandles
194 my $z=$x/$y; # ok to change spaces around both sides of the /
195 print $x / $y; # do not remove space before or after / here
196 print $x/$y; # do not add a space before the / here
197 print $x+$y; # do not add a space before the + here
200 'sub3' => <<'----------',
201 # keep these one-line blocks intact
211 'wc' => <<'----------',
215 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
221 &$CantProcessPartFunc( $entity->{'fields'}{
230 ####################################
231 # BEGIN SECTION 3: Expected output #
232 ####################################
238 expect => <<'#1...........',
239 # test some spacing rules at possible filehandles
240 my $z = $x / $y; # ok to change spaces around both sides of the /
241 print $x / $y; # do not remove space before or after / here
242 print $x/ $y; # do not add a space before the / here
243 print $x+ $y; # do not add a space before the + here
250 expect => <<'#2...........',
251 # test some spacing rules at possible filehandles
252 my $z = $x/$y; # ok to change spaces around both sides of the /
253 print $x / $y; # do not remove space before or after / here
254 print $x/$y; # do not add a space before the / here
255 print $x+$y; # do not add a space before the + here
262 expect => <<'#3...........',
263 # keep these one-line blocks intact
277 expect => <<'#4...........',
281 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
290 &$CantProcessPartFunc(
291 $entity->{'fields'}{'content-type'} );
306 expect => <<'#5...........',
310 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
319 &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
334 expect => <<'#6...........',
338 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
344 &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
356 expect => <<'#7...........',
357 # Previously, perltidy -ce would move a closing brace below a pod section to
358 # form '} else {'. No longer doing this because if you change back to -nce, the
359 # brace cannot go back to where it was.
368 If there is a TTY, we have to determine who it belongs to before we can
375 # Is Perl being run from a slave editor or graphical debugger?
384 expect => <<'#8...........',
385 # Previously, perltidy -ce would move a closing brace below a pod section to
386 # form '} else {'. No longer doing this because if you change back to -nce, the
387 # brace cannot go back to where it was.
395 If there is a TTY, we have to determine who it belongs to before we can
402 # Is Perl being run from a slave editor or graphical debugger?
411 expect => <<'#9...........',
412 # the closing braces should have the same position for these two hashes with -gnu
430 expect => <<'#10...........',
431 # the closing braces should have the same position for these two hashes with -gnu
449 expect => <<'#11...........',
450 # example for git #25; use -l=0; was losing alignment; sub 'fix_ragged_lists' was added to fix this
454 { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
455 { 'is_col' => 'corona_ieorres', 'cr_col' => '', 'trans' => 0, },
457 'is_col' => 'symptoms_fever',
458 'cr_col' => 'elig_fever',
460 'manually_reviewed' => '@TODO',
461 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
464 'is_col' => 'symptoms_cough',
465 'cr_col' => 'elig_cough',
467 'manually_reviewed' => '@TODO',
468 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
471 'is_col' => 'symptoms_dys_tachy_noea',
472 'cr_col' => 'elig_dyspnea',
474 'manually_reviewed' => '@TODO',
475 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
478 'is_col' => 'symptoms_clinical_susp',
479 'cr_col' => 'elig_ari',
486 'manually_reviewed' => 1,
487 'map' => { '0' => '1', '1' => '2' },
489 { 'is_col' => 'age', 'cr_col' => '', 'trans' => 0, },
490 { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
501 expect => <<'#12...........',
502 # example for git #25; use -l=0; was losing alignment; sub 'fix_ragged_lists' was added to fix this
506 { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
507 { 'is_col' => 'corona_ieorres', 'cr_col' => '', 'trans' => 0, },
508 { 'is_col' => 'symptoms_fever', 'cr_col' => 'elig_fever', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
509 { 'is_col' => 'symptoms_cough', 'cr_col' => 'elig_cough', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
510 { 'is_col' => 'symptoms_dys_tachy_noea', 'cr_col' => 'elig_dyspnea', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
511 { 'is_col' => 'symptoms_clinical_susp', 'cr_col' => 'elig_ari', 'trans' => 0, },
512 { 'is_col' => 'sex', 'cr_col' => 'sex', 'trans' => 1, 'manually_reviewed' => 1, 'map' => { '0' => '1', '1' => '2' }, },
513 { 'is_col' => 'age', 'cr_col' => '', 'trans' => 0, },
514 { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
522 'outdent.outdent2' => {
524 params => "outdent2",
525 expect => <<'#13...........',
527 LOOP: while ( $i = <FOTOS> ) {
539 expect => <<'#14...........',
540 if ( seek( DATA, 0, 0 ) ) { ... }
542 # The foreach keyword may be separated from the next opening paren
543 foreach $req (@bgQueue) {
547 # This had trouble because a later padding operation removed the inside space
548 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
550 && $RunNightlyWhenIdle == 2
551 && $bpc->isAdminJob( $CmdQueue[0]->{host} ) )
562 expect => <<'#15...........',
563 if ( seek(DATA, 0, 0) ) { ... }
565 # The foreach keyword may be separated from the next opening paren
566 foreach $req ( @bgQueue ) {
570 # This had trouble because a later padding operation removed the inside space
571 while ( $CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
573 && $RunNightlyWhenIdle == 2
574 && $bpc->isAdminJob($CmdQueue[0]->{host}) )
585 expect => <<'#16...........',
590 factorial( 2 * ( int( $n / 2 ) ) + 2 ) /
591 factorial( int( $n / 2 ) + 1 ) /
592 ( 4**( int( $n / 2 ) + 1 ) ) );
599 expect => <<'#17...........',
604 factorial( 2 * (int($n / 2)) + 2 ) /
605 factorial( int($n / 2) + 1 ) /
606 (4**(int($n / 2) + 1)));
610 'hanging_side_comments3.def' => {
611 source => "hanging_side_comments3",
613 expect => <<'#18...........',
614 if ( $var eq 'wastebasket' ) { # this sends a pure block
615 # of hanging side comments
616 #to the vertical aligner.
617 #It caused a crash in
619 #sub 'delete_unmatched_tokens'
623 elsif ( $var eq 'spacecommand' ) {
624 &die("No $val function") unless eval "defined &$val";
632 expect => <<'#19...........',
633 # logical padding examples
638 && ( $a->{'title'} eq $b->{'title'} )
639 && ( $a->{'href'} eq $b->{'href'} ) );
647 lc( $self->mime_attr('content-type')
648 || $self->{MIH_DefaultType}
651 # Padding can also remove spaces; here the space after the '(' is lost:
652 elsif ($statement_type =~ /^sub\b/
653 || $paren_type[$paren_depth] =~ /^sub\b/ )
658 my $ntests = 0 + keys %{$rtests};
659 plan tests => $ntests;
666 foreach my $key ( sort keys %{$rtests} ) {
668 my $sname = $rtests->{$key}->{source};
669 my $expect = $rtests->{$key}->{expect};
670 my $pname = $rtests->{$key}->{params};
671 my $source = $rsources->{$sname};
672 my $params = defined($pname) ? $rparams->{$pname} : "";
674 my $errorfile_string;
675 my $err = Perl::Tidy::perltidy(
677 destination => \$output,
678 perltidyrc => \$params,
679 argv => '', # for safety; hide any ARGV from perltidy
680 stderr => \$stderr_string,
681 errorfile => \$errorfile_string, # not used when -se flag is set
683 if ( $err || $stderr_string || $errorfile_string ) {
684 print STDERR "Error output received for test '$key'\n";
686 print STDERR "An error flag '$err' was returned\n";
689 if ($stderr_string) {
690 print STDERR "---------------------\n";
691 print STDERR "<<STDERR>>\n$stderr_string\n";
692 print STDERR "---------------------\n";
693 ok( !$stderr_string );
695 if ($errorfile_string) {
696 print STDERR "---------------------\n";
697 print STDERR "<<.ERR file>>\n$errorfile_string\n";
698 print STDERR "---------------------\n";
699 ok( !$errorfile_string );
703 if ( !is( $output, $expect, $key ) ) {
704 my $leno = length($output);
705 my $lene = length($expect);
706 if ( $leno == $lene ) {
708 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
712 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";