fix b1447; improve sub set_whitespace_flags

This should have been two commits. The first, fix b1447, is just 1 line
and will influence almost no code. The second improves the efficiency
of sub set_whitespace flags, mostly by processing comments faster. It
also fixes a minor problem with marking a sub call for special
formatting when a side comment appears between the sub name and
opening paren (issue c182).

diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data
index 3cebb220e8d54667033577216b178e722297332f..bc9f7f3507fe3251ede2b7ac92b368aec077aa34 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.data
+++ b/dev-bin/run_convergence_tests.pl.data
@@ -11338,6 +11338,27 @@ $last = after (
 --maximum-line-length=20
 --opening-hash-brace-right
 
+==> b1447.in <==
+    ok(defined($seqio=
+                  $gb->get_Stream_by_batch([qw(J00522 AF303112
+                 2981014)])));
+
+    ok(defined($seqio=
+                  $gb->get_Stream_by_batch(
+                                           [qw(J00522 AF303112
+                 2981014)])));
+
+==> b1447.par <==
+# note that notrim-qw converts the quote type from 'q' to 'Q'
+--noadd-whitespace
+--delete-old-whitespace
+--extended-line-up-parentheses
+--stack-opening-square-bracket
+--notrim-qw
+--vertical-tightness-closing=1
+--vertical-tightness=2
+--weld-nested-containers
+
 ==> b146.in <==
 # State 1
 

diff --git a/dev-bin/run_convergence_tests.pl.expect b/dev-bin/run_convergence_tests.pl.expect
index f1a4dbf38f5ad5ca6d3270707f88fdd9b610737c..289ca7d2ef8f7a006778531d6669bf2bfabed92e 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.expect
+++ b/dev-bin/run_convergence_tests.pl.expect
@@ -7694,6 +7694,17 @@ $last = after (
                   die
 "Unrecognized $type number: $num\n";
 
+==> b1447 <==
+    ok(defined($seqio=
+                  $gb->get_Stream_by_batch([qw(J00522 AF303112
+                 2981014)] )
+    ));
+
+    ok(defined($seqio=
+                  $gb->get_Stream_by_batch([qw(J00522 AF303112
+                 2981014)] )
+    ));
+
 ==> b146 <==
 # State 1
 

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 5dcc1ef4ec9ba371b302caf7aabc70d288ff06ef..d3b54033a29a6aab48b1411d7fd8890b22d18ccd 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -2845,9 +2845,6 @@ sub set_whitespace_flags {
     my $j_tight_closing_paren = -1;
     my $rLL                   = $self->[_rLL_];
     my $jmax                  = @{$rLL} - 1;
-    my $token                 = SPACE;
-    my $type                  = 'b';
-    my $last_token            = EMPTY_STRING;
 
     %opening_container_inside_ws = ();
     %closing_container_inside_ws = ();
@@ -2865,41 +2862,34 @@ sub set_whitespace_flags {
 
     my %is_for_foreach = ( 'for' => 1, 'foreach' => 1 );
 
-    my $rtokh;
-    my $rtokh_last      = $rLL->[0];
-    my $rtokh_last_last = $rtokh_last;
-
-    my $last_type = EMPTY_STRING;
+    my $last_token = SPACE;
+    my $last_type  = 'b';
 
-    $rtokh = [ @{ $rLL->[0] } ];
+    my $rtokh_last = [ @{ $rLL->[0] } ];
+    $rtokh_last->[_TOKEN_]         = $last_token;
+    $rtokh_last->[_TYPE_]          = $last_type;
+    $rtokh_last->[_TYPE_SEQUENCE_] = EMPTY_STRING;
+    $rtokh_last->[_LINE_INDEX_]    = 0;
 
-    $rtokh->[_TOKEN_]         = $token;
-    $rtokh->[_TYPE_]          = $type;
-    $rtokh->[_TYPE_SEQUENCE_] = EMPTY_STRING;
-    $rtokh->[_LINE_INDEX_]    = 0;
+    my $rtokh_last_last = $rtokh_last;
 
     my ( $ws_1, $ws_2, $ws_3, $ws_4 );
 
     # main loop over all tokens to define the whitespace flags
     my $last_type_is_opening;
-    foreach my $j ( 0 .. $jmax ) {
+    my ( $token, $type );
+    my $j = -1;
+    foreach my $rtokh ( @{$rLL} ) {
 
-        if ( $rLL->[$j]->[_TYPE_] eq 'b' ) {
+        $j++;
+
+        $type = $rtokh->[_TYPE_];
+        if ( $type eq 'b' ) {
             $rwhitespace_flags->[$j] = WS_OPTIONAL;
             next;
         }
 
-        $last_token = $token;
-        $last_type  = $type;
-
-        if ( $type ne '#' ) {
-            $rtokh_last_last = $rtokh_last;
-            $rtokh_last      = $rtokh;
-        }
-
-        $rtokh = $rLL->[$j];
         $token = $rtokh->[_TOKEN_];
-        $type  = $rtokh->[_TYPE_];
 
         my $ws;
 
@@ -3045,6 +3035,20 @@ sub set_whitespace_flags {
                 }
             }
 
+            # handle a comment
+            elsif ( $type eq '#' ) {
+
+                # newline before block comment ($j==0), and
+                # space before side comment    ($j>0), so ..
+                $ws = WS_YES;
+
+                #---------------------------------
+                # Nothing more to do for a comment
+                #---------------------------------
+                $rwhitespace_flags->[$j] = $ws;
+                next;
+            }
+
             # retain any space between '-' and bare word
             elsif ( $type eq 'w' || $type eq 'C' ) {
                 $ws = WS_OPTIONAL if $last_type eq '-';
@@ -3057,9 +3061,6 @@ sub set_whitespace_flags {
                 $ws = WS_OPTIONAL if ( $last_type eq 'w' );
             }
 
-            # always space before side comment
-            elsif ( $type eq '#' ) { $ws = WS_YES if $j > 0 }
-
             # space_backslash_quote; RT #123774  <<snippets/rt123774.in>>
             # allow a space between a backslash and single or double quote
             # to avoid fooling html formatters
@@ -3247,9 +3248,11 @@ sub set_whitespace_flags {
         # always preserve whatever space was used after a possible
         # filehandle (except _) or here doc operator
         if (
-            $type ne '#'
-            && ( ( $last_type eq 'Z' && $last_token ne '_' )
-                || $last_type eq 'h' )
+            (
+                ( $last_type eq 'Z' && $last_token ne '_' )
+                || $last_type eq 'h'
+            )
+            && $type ne '#' # no longer required due to early exit for '#' above
           )
         {
             $ws = WS_OPTIONAL;
@@ -3317,11 +3320,17 @@ sub set_whitespace_flags {
         if (  !$ws
             && $rtokh->[_LINE_INDEX_] != $rtokh_last->[_LINE_INDEX_] )
         {
-            $ws = 1;
+            $ws = WS_YES;
         }
 
         $rwhitespace_flags->[$j] = $ws;
 
+        # remember non-blank, non-comment tokens
+        $last_token      = $token;
+        $last_type       = $type;
+        $rtokh_last_last = $rtokh_last;
+        $rtokh_last      = $rtokh;
+
         next if ( !DEBUG_WHITE );
 
         my $str = substr( $last_token, 0, 15 );
@@ -10484,11 +10493,13 @@ sub setup_new_weld_measurements {
     # - Convert from '$ok_to_weld' to '$new_weld_ok' to fix b1162.
     # - relaxed constraints for b1227
     # - added skip if type is 'q' for b1349 and b1350 b1351 b1352 b1353
+    # - added skip if type is 'Q' for b1447
     if (   $starting_ci
         && $rOpts_line_up_parentheses
         && $rOpts_delete_old_whitespace
         && !$rOpts_add_whitespace
         && $rLL->[$Kinner_opening]->[_TYPE_] ne 'q'
+        && $rLL->[$Kinner_opening]->[_TYPE_] ne 'Q'
         && defined($Kprev) )
     {
         my $type_first  = $rLL->[$Kfirst]->[_TYPE_];

diff --git a/t/snippets/expect/space_paren.def b/t/snippets/expect/space_paren.def
index a7083ffb354223f86ac98682994e44fc433ccbf1..1a83a5d570909279077419cebc9655abf74d20ae 100644 (file)
--- a/t/snippets/expect/space_paren.def
+++ b/t/snippets/expect/space_paren.def
@@ -2,3 +2,5 @@ myfunc( $a, $b, $c );    # test -sfp
 push( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );     # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;    # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );

diff --git a/t/snippets/expect/space_paren.space_paren1 b/t/snippets/expect/space_paren.space_paren1
index 371dcba46263bb6f6e5c028ce306764ea0665bec..a783d5794c57e5c2f40fcacdfc14df708e533fd1 100644 (file)
--- a/t/snippets/expect/space_paren.space_paren1
+++ b/t/snippets/expect/space_paren.space_paren1
@@ -2,3 +2,5 @@ myfunc ( $a, $b, $c );    # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split ( /\|/, $txt );     # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind ( $o, $n, [ \&$q, \%m ] );

diff --git a/t/snippets/expect/space_paren.space_paren2 b/t/snippets/expect/space_paren.space_paren2
index 052af7c4a33ebbb2bff4167e7590214cbad97213..13c604212791ed9da912bcbe1ecd49bc45ca75bd 100644 (file)
--- a/t/snippets/expect/space_paren.space_paren2
+++ b/t/snippets/expect/space_paren.space_paren2
@@ -2,3 +2,5 @@ myfunc( $a, $b, $c );     # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );      # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index f170789b60fa18ed9ad0b20860aae767e2e67b8e..a2203c37738ff826a1c3abeab71a869614116695 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -382,6 +382,9 @@
 ../snippets27.t        cpb.cpb
 ../snippets27.t        cpb.def
 ../snippets27.t        rt145706.def
+../snippets27.t        olbxl.def
+../snippets27.t        olbxl.olbxl1
+../snippets28.t        olbxl.olbxl2
 ../snippets3.t ce_wn1.ce_wn
 ../snippets3.t ce_wn1.def
 ../snippets3.t colin.colin
@@ -522,6 +525,3 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets27.t        olbxl.def
-../snippets27.t        olbxl.olbxl1
-../snippets28.t        olbxl.olbxl2

diff --git a/t/snippets/space_paren.in b/t/snippets/space_paren.in
index c807602b497399c0037f0a49c0e3bbda70722ee4..c6805294211d82ea18828ecc74a5bb412267ae51 100644 (file)
--- a/t/snippets/space_paren.in
+++ b/t/snippets/space_paren.in
@@ -2,3 +2,5 @@ myfunc ( $a, $b, $c );    # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );      # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );

diff --git a/t/snippets19.t b/t/snippets19.t
index 753c55216e9eea9acc64b00860caa363bedacf3b..d3ed46fbe3ab2db98f31eaa957cb0d12438397e4 100644 (file)
--- a/t/snippets19.t
+++ b/t/snippets19.t
@@ -180,6 +180,8 @@ myfunc ( $a, $b, $c );    # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );      # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );
 ----------
 
         'tightness' => <<'----------',
@@ -406,6 +408,8 @@ myfunc( $a, $b, $c );    # test -sfp
 push( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );     # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;    # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );
 #14...........
         },
 
@@ -417,6 +421,8 @@ myfunc ( $a, $b, $c );    # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split ( /\|/, $txt );     # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind ( $o, $n, [ \&$q, \%m ] );
 #15...........
         },
 
@@ -428,6 +434,8 @@ myfunc( $a, $b, $c );     # test -sfp
 push ( @array, $val );    # test -skp and also -sak='push'
 split( /\|/, $txt );      # test -skp and also -sak='push'
 my ( $v1, $v2 ) = @_;     # test -sak='push'
+$c->    #sub set_whitespace_flags must look back past side comment
+  bind( $o, $n, [ \&$q, \%m ] );
 #16...........
         },
 

diff --git a/t/snippets28.t b/t/snippets28.t
index 18bbaaf8bfd8efacf1ff65c461883fa3cb27ac2b..958a8b5387e618e0f42da8c5cfe6cacfe36e3ba6 100644 (file)
--- a/t/snippets28.t
+++ b/t/snippets28.t
@@ -30,7 +30,7 @@ BEGIN {
     $rsources = {
 
         'olbxl' => <<'----------',
-            eval { 
+            eval {
                require Ace };
 
             @list = map {