case b1481

diff --git a/bin/perltidy b/bin/perltidy
index 9e4140f40046ca58691c47dfc68bfa9f735a07d1..16facbfcd59e7ee58769e3f5ccf318f9a12b2160 100755 (executable)
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -1531,7 +1531,7 @@ Suppose the user requests that / signs have a space to the left but not to the r
 
 If formatted in this way, the program will not run (at least with recent versions of perl) because the $x is taken to be a filehandle and / is assumed to start a quote. In a complex program, there might happen to be a / which terminates the multiline quote without a syntax error, allowing the program to run, but not as intended.
 
-Related issues arise with other binary operator symbols, such as + and -, and in older versions of perl there could be problems with ternary operators.  So to avoid changing program behavior, perltidy has the simple rule that whitespace around possible filehandles is left unchanged.  Likewise, whitespace around barewords is left unchanged.  The reason is that if the barewords are defined in other modules, or in code that has not even been written yet, perltidy will not have seen their prototypes and must treat them cautiously.
+Related issues arise with other binary operator symbols, such as + and -, and in older versions of perl there could be problems with ternary operators.  So to avoid changing program behavior, perltidy has the simple rule that whitespace around possible filehandles is left unchanged.  Likewise, whitespace around unknown barewords is left unchanged.  The reason is that if the barewords are defined in other modules, or in code that has not even been written yet, perltidy will not have seen their prototypes and must treat them cautiously.
 
 In perltidy this is implemented in the tokenizer by marking token following a
 B<print> keyword as a special type B<Z>.  When formatting is being done,

diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data
index 12879377a76b8ed27f7d909ece0a40e6632471ea..a06bd83629d4b978c5974aa6b8e4da7a46afd6c2 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.data
+++ b/dev-bin/run_convergence_tests.pl.data
@@ -12190,6 +12190,29 @@ run_sub ( ->$blah{ say "ok 5" ; }
 --want-trailing-commas='h'
 --delete-trailing-commas
 
+==> b1481.in <==
+$hr
+          ->set_uri_schemes
+          ([
+ 'http','https',
+ undef,'ftp'
+          ]);
+$hr->set_uri_schemes([
+ 'http','https',
+ undef,'ftp'
+] );
+
+
+==> b1481.par <==
+--maximum-line-length=22
+--indent-columns=1
+--continuation-indentation=10
+--weld-nested-containers
+--noadd-whitespace
+--paren-vertical-tightness-closing=1
+--delete-old-whitespace
+--stack-opening-square-bracket
+
 ==> b148.in <==
 # state 1
 @yydgoto=(

diff --git a/dev-bin/run_convergence_tests.pl.expect b/dev-bin/run_convergence_tests.pl.expect
index f41ad4bf18c776fa153fb6d5b02e08fd9bd794d5..856d09b6a95c5d64322e167544b9f206262b727a 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.expect
+++ b/dev-bin/run_convergence_tests.pl.expect
@@ -8282,6 +8282,17 @@ run_sub (
 );
 
 
+==> b1481 <==
+$hr->set_uri_schemes([
+ 'http','https',
+ undef,'ftp'
+] );
+$hr->set_uri_schemes([
+ 'http','https',
+ undef,'ftp'
+] );
+
+
 ==> b156 <==
 # State 1
 {
@@ -9976,12 +9987,15 @@ my$cmb=CPAN::Mirrored::By->new({
 });
 
 # S2
-my$cmb=CPAN::Mirrored::By->new({
-          continent=>"continent",
-          country=>"country",
-          http=>"http",
-          ftp=>"ftp",
-});
+my$cmb=
+  CPAN::Mirrored::By->new(
+      {
+        continent=>"continent",
+        country=>"country",
+        http=>"http",
+        ftp=>"ftp",
+      }
+  );
 
 ==> b753 <==
 # S1

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 929b0a59e1f136ce21f644b3f49ee805980a6c09..024904dc14a010a86f63a100e26bcc388bb5f38c 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -18640,6 +18640,9 @@ sub weld_nested_containers {
         my $inner_level = $inner_opening->[_LEVEL_];
         if ( $inner_level >= $high_stress_level ) { next }
 
+        # extra tolerance added under high stress to fix b1481
+        my $stress_tol = ( $high_stress_level - $inner_level <= 1 ) ? 1 : 0;
+
         # Set flag saying if this pair starts a new weld
         my $starting_new_weld = !( @welds && $outer_seqno == $welds[-1]->[0] );
 
@@ -18978,6 +18981,7 @@ EOM
                 $is_one_line_weld || $is_multiline_weld
               ? $single_line_tol
               : $multiline_tol;
+            $tol += $stress_tol;
 
             # By how many characters does this exceed the text window?
             my $excess =