adjust -wn rules to avoid blinkers

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 7f59c627dde4154d919dec21ba592850fe1d055c..0fa3c26b26a48e5520607f1c01fde5897036cf90 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -4127,7 +4127,8 @@ sub weld_nested_containers {
             #              ->GenerateFieldForSelectSQL() } );
 
             my $iline_oc = $outer_closing->[_LINE_INDEX_];
-            if ( $iline_oc <= $iline_oo + 1 ) {
+            my $token_oo = $outer_opening->[_TOKEN_];
+            if ( $iline_oc <= $iline_oo + 1 && $token_oo eq '(') {
 
                 # Look for following semicolon...
                 my $Knext_nonblank = $self->K_next_nonblank($Kouter_closing);
@@ -4135,7 +4136,7 @@ sub weld_nested_containers {
                   defined($Knext_nonblank)
                   ? $rLL->[$Knext_nonblank]->[_TYPE_]
                   : 'b';
-                if ( $next_nonblank_type eq ';' ) {
+                if ( $next_nonblank_type eq ';') {
 
                     # Then do not weld if no other containers between inner
                     # opening and closing.
@@ -4175,8 +4176,7 @@ sub weld_nested_containers {
         if ( $iline_ic == $iline_io ) {
 
             my $token_oo = $outer_opening->[_TOKEN_];
-            my $token_io = $inner_opening->[_TOKEN_];
-            $do_not_weld ||= $token_oo eq '(' && $token_io ne '(';
+            $do_not_weld ||= $token_oo eq '(';
         }
 
         # DO-NOT-WELD RULE 3:

diff --git a/t/snippets/expect/wn8.def b/t/snippets/expect/wn8.def
new file mode 100644 (file)
index 0000000..c31a77b
--- /dev/null
+++ b/t/snippets/expect/wn8.def
@@ -0,0 +1,19 @@
+            # Former -wn blinkers, which oscillated between two states
+
+            # fixed RULE 1 only applies to '('
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+            # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );

diff --git a/t/snippets/expect/wn8.wn b/t/snippets/expect/wn8.wn
new file mode 100644 (file)
index 0000000..00a672a
--- /dev/null
+++ b/t/snippets/expect/wn8.wn
@@ -0,0 +1,15 @@
+            # Former -wn blinkers, which oscillated between two states
+
+            # fixed RULE 1 only applies to '('
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 0c4d130b32669ccdce838ff143eb577ea15d298e..591731ba3ac1284616116e6fd986dbc613dc9eab 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -322,3 +322,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
+../snippets17.t        wn8.def
+../snippets17.t        wn8.wn

diff --git a/t/snippets/wn8.in b/t/snippets/wn8.in
new file mode 100644 (file)
index 0000000..9cce748
--- /dev/null
+++ b/t/snippets/wn8.in
@@ -0,0 +1,16 @@
+           # Former -wn blinkers, which oscillated between two states
+
+           # fixed RULE 1 only applies to '('
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+           # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(_(
+                 "Cannot delete zone $name: sub-zones or appellations exist."));

diff --git a/t/snippets17.t b/t/snippets17.t
index 2623786e8ba5284c8708090b77c532468422aa8b..73362e4c8715fbd80ef22d382ac3661b42b0d8d9 100644 (file)
--- a/t/snippets17.t
+++ b/t/snippets17.t
@@ -8,6 +8,8 @@
 #5 rperl.rperl
 #6 wn7.def
 #7 wn7.wn
+#8 wn8.def
+#9 wn8.wn
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -95,6 +97,25 @@ my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) {
                      do { 1; !!(my $x = bless []); }
                    );
 ----------
+
+        'wn8' => <<'----------',
+           # Former -wn blinkers, which oscillated between two states
+
+           # fixed RULE 1 only applies to '('
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+           # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(_(
+                 "Cannot delete zone $name: sub-zones or appellations exist."));
+----------
     };
 
     ####################################
@@ -243,6 +264,54 @@ sub foo_subroutine_in_main {
                     f( do { 1; !!( my $x = bless [] ); } );
 #7...........
         },
+
+        'wn8.def' => {
+            source => "wn8",
+            params => "def",
+            expect => <<'#8...........',
+            # Former -wn blinkers, which oscillated between two states
+
+            # fixed RULE 1 only applies to '('
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+            my $res = eval {
+                { $die_on_fetch, 0 }
+            };
+
+            # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+#8...........
+        },
+
+        'wn8.wn' => {
+            source => "wn8",
+            params => "wn",
+            expect => <<'#9...........',
+            # Former -wn blinkers, which oscillated between two states
+
+            # fixed RULE 1 only applies to '('
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            my $res = eval { { $die_on_fetch, 0 } };
+
+            # fixed RULE 2 applies to any inner opening token
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+
+            $app->FORM->{'appbar1'}->set_status(
+                _("Cannot delete zone $name: sub-zones or appellations exist.")
+            );
+#9...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};