add test cases to check recent updates

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index c788c5ca041efaf5af16ff0cc4150e98da18213d..940db966adcbf93bbcdc8115bf5f418f3de59e30 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -2493,6 +2493,7 @@ EOM
     my %is_lt_gt_le_ge;
     my %is_container_token;
 
+    my %binary_bond_strength_nospace;
     my %binary_bond_strength;
     my %nobreak_lhs;
     my %nobreak_rhs;
@@ -2574,11 +2575,12 @@ EOM
         # breakpoint token should appear at the end of one line or the
         # beginning of the next line.
 
-        %right_bond_strength  = ();
-        %left_bond_strength   = ();
-        %binary_bond_strength = ();
-        %nobreak_lhs          = ();
-        %nobreak_rhs          = ();
+        %right_bond_strength          = ();
+        %left_bond_strength           = ();
+        %binary_bond_strength_nospace = ();
+        %binary_bond_strength         = ();
+        %nobreak_lhs                  = ();
+        %nobreak_rhs                  = ();
 
         # The hash keys in this section are token types, plus the text of
         # certain keywords like 'or', 'and'.
@@ -2864,8 +2866,13 @@ EOM
         # a construction like '{-y}'.  The '-' quotes the 'y' and prevents
         # it from being taken as a transliteration. We have to keep
         # token types 'L m w' together to prevent this error.
-        $binary_bond_strength{'L{'}{'m'} = NO_BREAK;
-        $binary_bond_strength{'m'}{'w'} = NO_BREAK;
+        $binary_bond_strength{'L{'}{'m'}        = NO_BREAK;
+        $binary_bond_strength_nospace{'m'}{'w'} = NO_BREAK;
+
+       # keep 'bareword-' together, but only if there is no space between
+       # the word and dash. Do not keep together if there is a space.
+        # example 'use perl6-alpha'
+        $binary_bond_strength_nospace{'w'}{'m'} = NO_BREAK;
 
         # use strict requires that bare word and => not be separated
         $binary_bond_strength{'w'}{'=>'} = NO_BREAK;
@@ -3227,11 +3234,6 @@ EOM
                 }
             }
 
-           # keep 'bareword-' together, but only if there is no space between
-           # the word and dash. Do not keep together if there is a space.
-            # example 'use perl6-alpha'
-            elsif ( $type eq 'w' && $next_type eq 'm' ) { $bond_str = NO_BREAK }
-
             # Breaking before a ? before a quote can cause trouble if
             # they are not separated by a blank.
             # Example: a syntax error occurs if you break before the ? here
@@ -3277,11 +3279,18 @@ EOM
                 $rtype = $next_nonblank_type . $next_nonblank_token;
             }
 
+            # apply binary rules which apply regardless of space between tokens
             if ( $binary_bond_strength{$ltype}{$rtype} ) {
                 $bond_str           = $binary_bond_strength{$ltype}{$rtype};
                 $tabulated_bond_str = $bond_str;
             }
 
+            # apply binary rules which apply only if no space between tokens
+            if ( $binary_bond_strength_nospace{$ltype}{$next_type} ) {
+                $bond_str           = $binary_bond_strength{$ltype}{$next_type};
+                $tabulated_bond_str = $bond_str;
+            }
+
             if ( $nobreak_rhs{$ltype} || $nobreak_lhs{$rtype} ) {
                 $bond_str           = NO_BREAK;
                 $tabulated_bond_str = $bond_str;

diff --git a/t/snippets/expect/extrude5.def b/t/snippets/expect/extrude5.def
new file mode 100644 (file)
index 0000000..feb87f1
--- /dev/null
+++ b/t/snippets/expect/extrude5.def
@@ -0,0 +1,2 @@
+use perl6-alpha;
+$var{-y} = 1;

diff --git a/t/snippets/expect/extrude5.extrude b/t/snippets/expect/extrude5.extrude
new file mode 100644 (file)
index 0000000..3852980
--- /dev/null
+++ b/t/snippets/expect/extrude5.extrude
@@ -0,0 +1,7 @@
+use
+perl6-alpha
+;
+$var{-y}
+=
+1
+;

diff --git a/t/snippets/extrude5.in b/t/snippets/extrude5.in
new file mode 100644 (file)
index 0000000..feb87f1
--- /dev/null
+++ b/t/snippets/extrude5.in
@@ -0,0 +1,2 @@
+use perl6-alpha;
+$var{-y} = 1;

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index f124af0de8892b486dc7f3349105fe298befd380..02a3413123a47d222e047c09b135a9aefdfa1161 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -280,6 +280,8 @@
 ../snippets22.t        xci.def
 ../snippets22.t        xci.xci1
 ../snippets22.t        xci.xci2
+../snippets22.t        mangle4.def
+../snippets22.t        mangle4.mangle
 ../snippets3.t ce_wn1.ce_wn
 ../snippets3.t ce_wn1.def
 ../snippets3.t colin.colin
@@ -420,5 +422,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets22.t        mangle4.def
-../snippets22.t        mangle4.mangle
+../snippets22.t        extrude5.def
+../snippets22.t        extrude5.extrude

diff --git a/t/snippets22.t b/t/snippets22.t
index 082fcad0602dbd56b24625e197bacf8992c4caf3..ae25c270daf201dd38291514ede90c284ab65b13 100644 (file)
--- a/t/snippets22.t
+++ b/t/snippets22.t
@@ -13,6 +13,8 @@
 #10 xci.xci2
 #11 mangle4.def
 #12 mangle4.mangle
+#13 extrude5.def
+#14 extrude5.extrude
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -38,6 +40,7 @@ BEGIN {
 -bli -blil='*'
 ----------
         'def'       => "",
+        'extrude'   => "--extrude",
         'here_long' => "-l=33",
         'mangle'    => "--mangle",
         'xci1'      => "-xci",
@@ -108,6 +111,11 @@ try {
 catch {
     die;
 };
+----------
+
+        'extrude5' => <<'----------',
+use perl6-alpha;
+$var{-y} = 1;
 ----------
 
         'here_long' => <<'----------',
@@ -460,6 +468,29 @@ $ #foo)))
 {$a.$b}
 #12...........
         },
+
+        'extrude5.def' => {
+            source => "extrude5",
+            params => "def",
+            expect => <<'#13...........',
+use perl6-alpha;
+$var{-y} = 1;
+#13...........
+        },
+
+        'extrude5.extrude' => {
+            source => "extrude5",
+            params => "extrude",
+            expect => <<'#14...........',
+use
+perl6-alpha
+;
+$var{-y}
+=
+1
+;
+#14...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};