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 # These closing braces no longer have the same position with -gnu after an
108 # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
109 # But adding the -xlp should make them all have the same indentation.
126 'hanging_side_comments3' => <<'----------',
127 if ( $var eq 'wastebasket' ) { # this sends a pure block
128 # of hanging side comments
129 #to the vertical aligner.
130 #It caused a crash in
132 #sub 'delete_unmatched_tokens'
136 elsif ( $var eq 'spacecommand' ) {
137 &die("No $val function") unless eval "defined &$val";
141 'kpit' => <<'----------',
142 if ( seek(DATA, 0, 0) ) { ... }
144 # The foreach keyword may be separated from the next opening paren
145 foreach $req(@bgQueue) {
149 # This had trouble because a later padding operation removed the inside space
150 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
151 || @CmdQueue > 0 && $RunNightlyWhenIdle == 2 && $bpc->isAdminJob($CmdQueue[0]->{host})) {
157 'kpitl' => <<'----------',
158 return ( $r**$n ) * ( pi**( $n / 2 ) ) / ( sqrt(pi) * factorial( 2 * ( int( $n
159 / 2 ) ) + 2 ) / factorial( int( $n / 2 ) + 1 ) / ( 4**( int( $n / 2 ) + 1 ) )
163 'lop' => <<'----------',
164 # logical padding examples
169 && ( $a->{'title'} eq $b->{'title'} )
170 && ( $a->{'href'} eq $b->{'href'} ) );
178 lc( $self->mime_attr('content-type')
179 || $self->{MIH_DefaultType}
182 # Padding can also remove spaces; here the space after the '(' is lost:
183 elsif ( $statement_type =~ /^sub\b/
184 || $paren_type[$paren_depth] =~ /^sub\b/ )
187 'outdent' => <<'----------',
189 LOOP: while ( $i = <FOTOS> ) {
197 'space6' => <<'----------',
198 # test some spacing rules at possible filehandles
199 my $z=$x/$y; # ok to change spaces around both sides of the /
200 print $x / $y; # do not remove space before or after / here
201 print $x/$y; # do not add a space before the / here
202 print $x+$y; # do not add a space before the + here
205 'sub3' => <<'----------',
206 # keep these one-line blocks intact
216 'wc' => <<'----------',
220 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
226 &$CantProcessPartFunc( $entity->{'fields'}{
235 ####################################
236 # BEGIN SECTION 3: Expected output #
237 ####################################
243 expect => <<'#1...........',
244 # test some spacing rules at possible filehandles
245 my $z = $x / $y; # ok to change spaces around both sides of the /
246 print $x / $y; # do not remove space before or after / here
247 print $x/ $y; # do not add a space before the / here
248 print $x+ $y; # do not add a space before the + here
255 expect => <<'#2...........',
256 # test some spacing rules at possible filehandles
257 my $z = $x/$y; # ok to change spaces around both sides of the /
258 print $x / $y; # do not remove space before or after / here
259 print $x/$y; # do not add a space before the / here
260 print $x+$y; # do not add a space before the + here
267 expect => <<'#3...........',
268 # keep these one-line blocks intact
282 expect => <<'#4...........',
286 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
295 &$CantProcessPartFunc(
296 $entity->{'fields'}{'content-type'} );
311 expect => <<'#5...........',
315 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
324 &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
339 expect => <<'#6...........',
343 $dir eq 'left' ? $cells[$a] <=> $cells[$b] : $cells[$b] <=> $cells[$a];
349 &$CantProcessPartFunc( $entity->{'fields'}{'content-type'} );
361 expect => <<'#7...........',
362 # Previously, perltidy -ce would move a closing brace below a pod section to
363 # form '} else {'. No longer doing this because if you change back to -nce, the
364 # brace cannot go back to where it was.
373 If there is a TTY, we have to determine who it belongs to before we can
380 # Is Perl being run from a slave editor or graphical debugger?
389 expect => <<'#8...........',
390 # Previously, perltidy -ce would move a closing brace below a pod section to
391 # form '} else {'. No longer doing this because if you change back to -nce, the
392 # brace cannot go back to where it was.
400 If there is a TTY, we have to determine who it belongs to before we can
407 # Is Perl being run from a slave editor or graphical debugger?
416 expect => <<'#9...........',
417 # These closing braces no longer have the same position with -gnu after an
418 # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
419 # But adding the -xlp should make them all have the same indentation.
440 expect => <<'#10...........',
441 # These closing braces no longer have the same position with -gnu after an
442 # update 13 dec 2021 in which the vertical aligner zeros recoverable spaces.
443 # But adding the -xlp should make them all have the same indentation.
464 expect => <<'#11...........',
465 # example for git #25; use -l=0; was losing alignment; sub 'fix_ragged_lists' was added to fix this
469 { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
470 { 'is_col' => 'corona_ieorres', 'cr_col' => '', 'trans' => 0, },
472 'is_col' => 'symptoms_fever',
473 'cr_col' => 'elig_fever',
475 'manually_reviewed' => '@TODO',
476 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
479 'is_col' => 'symptoms_cough',
480 'cr_col' => 'elig_cough',
482 'manually_reviewed' => '@TODO',
483 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
486 'is_col' => 'symptoms_dys_tachy_noea',
487 'cr_col' => 'elig_dyspnea',
489 'manually_reviewed' => '@TODO',
490 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' },
493 'is_col' => 'symptoms_clinical_susp',
494 'cr_col' => 'elig_ari',
501 'manually_reviewed' => 1,
502 'map' => { '0' => '1', '1' => '2' },
504 { 'is_col' => 'age', 'cr_col' => '', 'trans' => 0, },
505 { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
516 expect => <<'#12...........',
517 # example for git #25; use -l=0; was losing alignment; sub 'fix_ragged_lists' was added to fix this
521 { 'is_col' => 'dsstdat', 'cr_col' => 'enroll_isaric_date', 'trans' => 0, },
522 { 'is_col' => 'corona_ieorres', 'cr_col' => '', 'trans' => 0, },
523 { 'is_col' => 'symptoms_fever', 'cr_col' => 'elig_fever', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
524 { 'is_col' => 'symptoms_cough', 'cr_col' => 'elig_cough', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
525 { 'is_col' => 'symptoms_dys_tachy_noea', 'cr_col' => 'elig_dyspnea', 'trans' => 1, 'manually_reviewed' => '@TODO', 'map' => { '0' => '0', '1' => '1', '9' => '@TODO' }, },
526 { 'is_col' => 'symptoms_clinical_susp', 'cr_col' => 'elig_ari', 'trans' => 0, },
527 { 'is_col' => 'sex', 'cr_col' => 'sex', 'trans' => 1, 'manually_reviewed' => 1, 'map' => { '0' => '1', '1' => '2' }, },
528 { 'is_col' => 'age', 'cr_col' => '', 'trans' => 0, },
529 { 'is_col' => 'ageu', 'cr_col' => '', 'trans' => 0, },
537 'outdent.outdent2' => {
539 params => "outdent2",
540 expect => <<'#13...........',
542 LOOP: while ( $i = <FOTOS> ) {
554 expect => <<'#14...........',
555 if ( seek( DATA, 0, 0 ) ) { ... }
557 # The foreach keyword may be separated from the next opening paren
558 foreach $req (@bgQueue) {
562 # This had trouble because a later padding operation removed the inside space
563 while ($CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
565 && $RunNightlyWhenIdle == 2
566 && $bpc->isAdminJob( $CmdQueue[0]->{host} ) )
577 expect => <<'#15...........',
578 if ( seek(DATA, 0, 0) ) { ... }
580 # The foreach keyword may be separated from the next opening paren
581 foreach $req ( @bgQueue ) {
585 # This had trouble because a later padding operation removed the inside space
586 while ( $CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1
588 && $RunNightlyWhenIdle == 2
589 && $bpc->isAdminJob($CmdQueue[0]->{host}) )
600 expect => <<'#16...........',
605 factorial( 2 * ( int( $n / 2 ) ) + 2 ) /
606 factorial( int( $n / 2 ) + 1 ) /
607 ( 4**( int( $n / 2 ) + 1 ) ) );
614 expect => <<'#17...........',
619 factorial( 2 * (int($n / 2)) + 2 ) /
620 factorial( int($n / 2) + 1 ) /
621 (4**(int($n / 2) + 1)));
625 'hanging_side_comments3.def' => {
626 source => "hanging_side_comments3",
628 expect => <<'#18...........',
629 if ( $var eq 'wastebasket' ) { # this sends a pure block
630 # of hanging side comments
631 #to the vertical aligner.
632 #It caused a crash in
634 #sub 'delete_unmatched_tokens'
638 elsif ( $var eq 'spacecommand' ) {
639 &die("No $val function") unless eval "defined &$val";
647 expect => <<'#19...........',
648 # logical padding examples
653 && ( $a->{'title'} eq $b->{'title'} )
654 && ( $a->{'href'} eq $b->{'href'} ) );
662 lc( $self->mime_attr('content-type')
663 || $self->{MIH_DefaultType}
666 # Padding can also remove spaces; here the space after the '(' is lost:
667 elsif ($statement_type =~ /^sub\b/
668 || $paren_type[$paren_depth] =~ /^sub\b/ )
673 my $ntests = 0 + keys %{$rtests};
674 plan tests => $ntests;
681 foreach my $key ( sort keys %{$rtests} ) {
683 my $sname = $rtests->{$key}->{source};
684 my $expect = $rtests->{$key}->{expect};
685 my $pname = $rtests->{$key}->{params};
686 my $source = $rsources->{$sname};
687 my $params = defined($pname) ? $rparams->{$pname} : "";
689 my $errorfile_string;
690 my $err = Perl::Tidy::perltidy(
692 destination => \$output,
693 perltidyrc => \$params,
694 argv => '', # for safety; hide any ARGV from perltidy
695 stderr => \$stderr_string,
696 errorfile => \$errorfile_string, # not used when -se flag is set
698 if ( $err || $stderr_string || $errorfile_string ) {
699 print STDERR "Error output received for test '$key'\n";
701 print STDERR "An error flag '$err' was returned\n";
704 if ($stderr_string) {
705 print STDERR "---------------------\n";
706 print STDERR "<<STDERR>>\n$stderr_string\n";
707 print STDERR "---------------------\n";
708 ok( !$stderr_string );
710 if ($errorfile_string) {
711 print STDERR "---------------------\n";
712 print STDERR "<<.ERR file>>\n$errorfile_string\n";
713 print STDERR "---------------------\n";
714 ok( !$errorfile_string );
718 if ( !is( $output, $expect, $key ) ) {
719 my $leno = length($output);
720 my $lene = length($expect);
721 if ( $leno == $lene ) {
723 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
727 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";