From c60b114c52995326121a886e8ae4ca0dbef7ef11 Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Thu, 5 Sep 2024 19:55:21 -0700
Subject: [PATCH] case b1481

---
 bin/perltidy                            |  2 +-
 dev-bin/run_convergence_tests.pl.data   | 23 ++++++++++++++++++++++
 dev-bin/run_convergence_tests.pl.expect | 26 +++++++++++++++++++------
 lib/Perl/Tidy/Formatter.pm              |  4 ++++
 4 files changed, 48 insertions(+), 7 deletions(-)

diff --git a/bin/perltidy b/bin/perltidy
index 9e4140f4..16facbfc 100755
--- 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 12879377..a06bd836 100644
--- 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 f41ad4bf..856d09b6 100644
--- 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 929b0a59..024904dc 100644
--- 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 =
-- 
2.39.5