fix -qwaf instabilities b1482 b1485

diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data
index a06bd83629d4b978c5974aa6b8e4da7a46afd6c2..a2a0fde9e6e14f4702ce317d8c1dd4c8b40b63e1 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.data
+++ b/dev-bin/run_convergence_tests.pl.data
@@ -12190,6 +12190,26 @@ run_sub ( ->$blah{ say "ok 5" ; }
 --want-trailing-commas='h'
 --delete-trailing-commas
 
+==> b148.in <==
+# state 1
+@yydgoto=(
+    1,25,140,86,36,129,141,155,90,159,28,82,38,48,
+    132,40,91,147,134,151,160,29,130,77,78,158,30, );
+
+# state 2
+@yydgoto=(
+    1,25,140,86,36,129,141,155,90,159,28,82,38,48,132,40,91,147,134,151,160,29,130,77,78,158,30, );
+
+
+==> b148.par <==
+--noadd-whitespace
+--break-before-paren-and-indent=1
+--break-before-paren=2
+--extended-continuation-indentation
+--maximum-line-length=95
+--paren-vertical-tightness-closing=1
+--variable-maximum-line-length
+
 ==> b1481.in <==
 $hr
           ->set_uri_schemes
@@ -12213,25 +12233,36 @@ $hr->set_uri_schemes([
 --delete-old-whitespace
 --stack-opening-square-bracket
 
-==> b148.in <==
-# state 1
-@yydgoto=(
-    1,25,140,86,36,129,141,155,90,159,28,82,38,48,
-    132,40,91,147,134,151,160,29,130,77,78,158,30, );
+==> b1482.in <==
+@ISA =
+      qw(
+    Net::FTP::I) ;
 
-# state 2
-@yydgoto=(
-    1,25,140,86,36,129,141,155,90,159,28,82,38,48,132,40,91,147,134,151,160,29,130,77,78,158,30, );
+@ISA =
+      qw(Net::FTP::I
+      ) ;
 
+==> b1482.par <==
+--maximum-line-length=21
+--continuation-indentation=6
+--noadd-whitespace
+--qw-as-function
+--want-break-after='='
 
-==> b148.par <==
+==> b1485.in <==
+use
+  UnixODBC qw(
+         :all);
+use
+  UnixODBC qw(
+         :all
+  );
+
+==> b1485.par <==
+--maximum-line-length=15
+--indent-columns=9
 --noadd-whitespace
---break-before-paren-and-indent=1
---break-before-paren=2
---extended-continuation-indentation
---maximum-line-length=95
---paren-vertical-tightness-closing=1
---variable-maximum-line-length
+--qw-as-function
 
 ==> b156.in <==
 # State 1

diff --git a/dev-bin/run_convergence_tests.pl.expect b/dev-bin/run_convergence_tests.pl.expect
index 856d09b6a95c5d64322e167544b9f206262b727a..cdc9f126148f49c25cb4df4bbf03d297311525f0 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.expect
+++ b/dev-bin/run_convergence_tests.pl.expect
@@ -8293,6 +8293,22 @@ $hr->set_uri_schemes([
 ] );
 
 
+==> b1482 <==
+@ISA =qw(
+      Net::FTP::I) ;
+
+@ISA =qw(Net::FTP::I
+) ;
+
+==> b1485 <==
+use UnixODBC
+  qw(
+  :all);
+use UnixODBC
+  qw(
+  :all
+  );
+
 ==> b156 <==
 # State 1
 {

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 5b2e484d918abab9d0c89ee15b643b75c14241e9..2a4f50d1db865e575a2916e57522ea603609d8a8 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -6665,10 +6665,14 @@ EOM
 
         my $qw_text       = $rLL->[-1]->[_TOKEN_];
         my $qw_type       = $rLL->[-1]->[_TYPE_];
+        my $qw_level      = $rLL->[-1]->[_LEVEL_];
         my $qw_text_start = $qw_text;
         my $opening       = EMPTY_STRING;
         my $closing       = EMPTY_STRING;
 
+        # the new word tokens are 1 level deeper than the original 'q' token
+        my $level_words = $qw_level + 1;
+
         if ( $qw_type ne 'q' ) {
 
             # This should never happen because the calling sub should have just
@@ -6700,6 +6704,15 @@ EOM
             }
             $qw_text = substr( $qw_text, 3 );
             $qw_text =~ s/^\s+//;
+
+            # Do not use -qwaf under high stress (b1482,b1483,b1484,b1485,1486)
+            # Note: so far all known cases of stress instability have had -naws
+            # set, so this is included for now. It may eventually need to be
+            # removed.
+            if ( !$rOpts_add_whitespace && $level_words >= $high_stress_level )
+            {
+                return;
+            }
         }
 
         # Look for and remove any closing ')'
@@ -6750,9 +6763,6 @@ EOM
         # now push on the replacement tokens
         my $nonblank_push_count = 0;
 
-        # the new word tokens are 1 level deeper than the original 'q' token
-        my $level_words = $rtoken_q->[_LEVEL_] + 1;
-
         if ($opening) {
 
             # generate a new sequence number, one greater than the previous,