fixed rare problem of some blinkers with -pbp

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 0fa3c26b26a48e5520607f1c01fde5897036cf90..54f03e53e14ddf9f1b51ca664b3f055cf9bd8d01 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -12861,6 +12861,12 @@ sub terminal_type_K {
                 if ( $next_nonblank_token =~ /^(die|confess|croak|warn)$/ ) {
                     if ( $want_break_before{$token} && $i > 0 ) {
                         $bond_strength_to_go[ $i - 1 ] -= $delta_bias;
+
+                        # keep bond strength of a token and its following blank
+                        # the same
+                        if ( $types_to_go[ $i - 1 ] eq 'b' && $i > 2 ) {
+                            $bond_strength_to_go[ $i - 2 ] -= $delta_bias;
+                        }
                     }
                     else {
                         $bond_str -= $delta_bias;
@@ -17252,6 +17258,7 @@ sub set_continuation_breaks {
         #-------------------------------------------------------
         # BEGINNING of inner loop to find the best next breakpoint
         #-------------------------------------------------------
+       my $strength = NO_BREAK;
         for ( $i_test = $i_begin ; $i_test <= $imax ; $i_test++ ) {
             my $type                     = $types_to_go[$i_test];
             my $token                    = $tokens_to_go[$i_test];
@@ -17261,9 +17268,15 @@ sub set_continuation_breaks {
             my $next_nonblank_type       = $types_to_go[$i_next_nonblank];
             my $next_nonblank_token      = $tokens_to_go[$i_next_nonblank];
             my $next_nonblank_block_type = $block_type_to_go[$i_next_nonblank];
-            my $strength                 = $bond_strength_to_go[$i_test];
             my $maximum_line_length      = maximum_line_length($i_begin);
 
+           # adjustments to the previous bond strength may have been made, and
+           # we must keep the bond strength of a token and its following blank
+           # the same; 
+            my $last_strength = $strength;
+            $strength = $bond_strength_to_go[$i_test];
+            if ( $type eq 'b' ) { $strength = $last_strength }
+
             # use old breaks as a tie-breaker.  For example to
             # prevent blinkers with -pbp in this code:
 

diff --git a/t/snippets/expect/pbp6.def b/t/snippets/expect/pbp6.def
new file mode 100644 (file)
index 0000000..1c03ad2
--- /dev/null
+++ b/t/snippets/expect/pbp6.def
@@ -0,0 +1,21 @@
+        # These formerly blinked with -pbp
+        return $width1 *
+          $common_length *
+          (
+            $W * atan2( 1, $W ) +
+              $H * atan2( 1, $H ) -
+              $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ ) +
+              0.25 * log(
+                ( $WSQP1 * $HSQP1 ) /
+                  ( 1 + $WSQ + $HSQ ) *
+                  ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
+                  **$WSQ *
+                  ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )**$HSQ
+              )
+          ) /
+          ( $W * $pi );
+
+        my $oldSec =
+          ( 60 * $session->{originalStartHour} + $session->{originalStartMin} )
+          * 60;
+

diff --git a/t/snippets/expect/pbp6.pbp b/t/snippets/expect/pbp6.pbp
new file mode 100644 (file)
index 0000000..48e26bd
--- /dev/null
+++ b/t/snippets/expect/pbp6.pbp
@@ -0,0 +1,23 @@
+        # These formerly blinked with -pbp
+        return
+            $width1 * $common_length
+            * (
+                  $W * atan2( 1, $W )
+                + $H * atan2( 1, $H )
+                - $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ )
+                + 0.25 * log(
+                  ( $WSQP1 * $HSQP1 )
+                / ( 1 + $WSQ + $HSQ )
+                    * ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
+                    **$WSQ
+                    * ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )
+                    **$HSQ
+                )
+            )
+            / ( $W * $pi );
+
+        my $oldSec
+            = ( 60 * $session->{originalStartHour}
+                + $session->{originalStartMin} )
+            * 60;
+

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 591731ba3ac1284616116e6fd986dbc613dc9eab..2fef0807eb5509c15e6c25f44b949dae3f82f7b8 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -162,6 +162,8 @@
 ../snippets17.t        rperl.rperl
 ../snippets17.t        wn7.def
 ../snippets17.t        wn7.wn
+../snippets17.t        wn8.def
+../snippets17.t        wn8.wn
 ../snippets2.t angle.def
 ../snippets2.t arrows1.def
 ../snippets2.t arrows2.def
@@ -322,5 +324,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets17.t        wn8.def
-../snippets17.t        wn8.wn
+../snippets17.t        pbp6.def
+../snippets17.t        pbp6.pbp

diff --git a/t/snippets/pbp6.in b/t/snippets/pbp6.in
new file mode 100644 (file)
index 0000000..4db6934
--- /dev/null
+++ b/t/snippets/pbp6.in
@@ -0,0 +1,14 @@
+       # These formerly blinked with -pbp
+        return $width1*$common_length*(
+          $W*atan2(1,$W)
+        + $H*atan2(1,$H)
+        - $RTHSQPWSQ*atan2(1,$RTHSQPWSQ)
+        + 0.25*log(
+         ($WSQP1*$HSQP1)/(1+$WSQ+$HSQ)
+         *($WSQ*(1+$WSQ+$HSQ)/($WSQP1*$HSQPWSQ))**$WSQ
+         *($HSQ*(1+$WSQ+$HSQ)/($HSQP1*$HSQPWSQ))**$HSQ
+         )
+         )/($W*$pi);
+
+        my $oldSec = ( 60 * $session->{originalStartHour} + $session->{originalStartMin} ) * 60;
+

diff --git a/t/snippets17.t b/t/snippets17.t
index 73362e4c8715fbd80ef22d382ac3661b42b0d8d9..c164d5088769c2db961bcb12b36b79268450c62a 100644 (file)
--- a/t/snippets17.t
+++ b/t/snippets17.t
@@ -10,6 +10,8 @@
 #7 wn7.wn
 #8 wn8.def
 #9 wn8.wn
+#10 pbp6.def
+#11 pbp6.pbp
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -28,6 +30,7 @@ BEGIN {
     ###########################################
     $rparams = {
         'def'      => "",
+        'pbp'      => "-pbp -nst -nse",
         'rperl'    => "-l=0",
         'rt132059' => "-dac",
         'wn'       => "-wn",
@@ -38,6 +41,23 @@ BEGIN {
     ############################
     $rsources = {
 
+        'pbp6' => <<'----------',
+       # These formerly blinked with -pbp
+        return $width1*$common_length*(
+          $W*atan2(1,$W)
+        + $H*atan2(1,$H)
+        - $RTHSQPWSQ*atan2(1,$RTHSQPWSQ)
+        + 0.25*log(
+         ($WSQP1*$HSQP1)/(1+$WSQ+$HSQ)
+         *($WSQ*(1+$WSQ+$HSQ)/($WSQP1*$HSQPWSQ))**$WSQ
+         *($HSQ*(1+$WSQ+$HSQ)/($HSQP1*$HSQPWSQ))**$HSQ
+         )
+         )/($W*$pi);
+
+        my $oldSec = ( 60 * $session->{originalStartHour} + $session->{originalStartMin} ) * 60;
+
+----------
+
         'rperl' => <<'----------',
 # Some test cases for RPerl, https://github.com/wbraswell/rperl/
 # These must not remain as single lines with default formatting and long lines
@@ -312,6 +332,64 @@ sub foo_subroutine_in_main {
             );
 #9...........
         },
+
+        'pbp6.def' => {
+            source => "pbp6",
+            params => "def",
+            expect => <<'#10...........',
+        # These formerly blinked with -pbp
+        return $width1 *
+          $common_length *
+          (
+            $W * atan2( 1, $W ) +
+              $H * atan2( 1, $H ) -
+              $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ ) +
+              0.25 * log(
+                ( $WSQP1 * $HSQP1 ) /
+                  ( 1 + $WSQ + $HSQ ) *
+                  ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
+                  **$WSQ *
+                  ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )**$HSQ
+              )
+          ) /
+          ( $W * $pi );
+
+        my $oldSec =
+          ( 60 * $session->{originalStartHour} + $session->{originalStartMin} )
+          * 60;
+
+#10...........
+        },
+
+        'pbp6.pbp' => {
+            source => "pbp6",
+            params => "pbp",
+            expect => <<'#11...........',
+        # These formerly blinked with -pbp
+        return
+            $width1 * $common_length
+            * (
+                  $W * atan2( 1, $W )
+                + $H * atan2( 1, $H )
+                - $RTHSQPWSQ * atan2( 1, $RTHSQPWSQ )
+                + 0.25 * log(
+                  ( $WSQP1 * $HSQP1 )
+                / ( 1 + $WSQ + $HSQ )
+                    * ( $WSQ * ( 1 + $WSQ + $HSQ ) / ( $WSQP1 * $HSQPWSQ ) )
+                    **$WSQ
+                    * ( $HSQ * ( 1 + $WSQ + $HSQ ) / ( $HSQP1 * $HSQPWSQ ) )
+                    **$HSQ
+                )
+            )
+            / ( $W * $pi );
+
+        my $oldSec
+            = ( 60 * $session->{originalStartHour}
+                + $session->{originalStartMin} )
+            * 60;
+
+#11...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};