improve some edge cases of parsing + - *

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index 1b6d6791361414a45b33b437a41ca169c13a006d..ad4dc6837cccc0e725cd33895946b02081fd3778 100644 (file)
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -3721,14 +3721,16 @@ EOM
         my $self = shift;
 
         # '*' = typeglob, or multiply?
-        if ( $expecting == UNKNOWN && $last_nonblank_type eq 'Z' ) {
-            if (   $next_type ne 'b'
+        if ( $expecting == UNKNOWN ) {
+            if (   $last_nonblank_type eq 'Z'
+                && $next_type ne 'b'
                 && $next_type ne '('
                 && $next_type ne '#' )    # Fix c036
             {
                 $expecting = TERM;
             }
         }
+
         if ( $expecting == TERM ) {
             $self->scan_simple_identifier();
         }
@@ -3971,7 +3973,6 @@ EOM
         elsif ( $expecting == OPERATOR ) {
         }
         else {
-
             if ( $next_type eq 'w' ) {
                 $type = 'm';
             }
@@ -4776,7 +4777,7 @@ EOM
         return ( $function_count, $constant_count );
     } ## end sub get_bareword_counts
 
-    # hashes used to guess bareword type
+    # hashes used to help determine a bareword type
     my %is_wiUC;
     my %is_function_follower;
     my %is_constant_follower;
@@ -4789,9 +4790,14 @@ EOM
         @qz = qw( use require no );
         @is_use_require_no{@qz} = (1) x scalar(@qz);
 
+        # These pre-token types after a bareword imply that it
+        # is not a constant, except when '(' is followed by ')'.
         @qz = qw# ( [ { $ @ " ' m #;
         @is_function_follower{@qz} = (1) x scalar(@qz);
 
+        # These pre-token types after a bareword imply that it
+        # MIGHT be a constant, but it also might be a function taking
+        # 0 or more call args.
         @qz = qw# ; ) ] } if unless #;
         push @qz, ',';
         @is_constant_follower{@qz} = (1) x scalar(@qz);
@@ -6451,10 +6457,9 @@ BEGIN {
     push @q, '->';    # was previously in UNKNOWN
     @op_expected_table{@q} = (TERM) x scalar(@q);
 
-    # Always UNKNOWN following these types;
-    # previously had '->' in this list for c030
-    @q = qw( w );
-    @op_expected_table{@q} = (UNKNOWN) x scalar(@q);
+    # No UNKNOWN table types:
+    #  removed '->' for c030, now always TERM
+    #  removed 'w' for c392 to allow use of 'function_count' info in the sub
 
     # Always expecting OPERATOR ...
     # 'n' and 'v' are currently excluded because they might be VERSION numbers
@@ -6713,8 +6718,23 @@ sub operator_expected {
         return OPERATOR;
     }
 
+    # Section 2E: bareword
+    if ( $last_nonblank_type eq 'w' ) {
+
+        # see if this has been seen in the role of a function taking args
+        my $rinfo = $self->[_rbareword_info_]->{$current_package};
+        if ($rinfo) {
+            $rinfo = $rinfo->{$last_nonblank_token};
+            if ($rinfo) {
+                my $function_count = $rinfo->{function_count};
+                if ( $function_count && $function_count > 0 ) { return TERM }
+            }
+        }
+        return UNKNOWN;
+    }
+
     #-----------------------------------
-    # Section 2E: file handle or similar
+    # Section 2F: file handle or similar
     #-----------------------------------
     if ( $last_nonblank_type eq 'Z' ) {
 
@@ -9912,11 +9932,6 @@ sub find_angle_operator_termination {
     my $filter;
 
     my $expecting_TERM = $expecting == TERM;
-    if ( $last_nonblank_type eq 'w' ) {
-        my ( $function_count, $constant_count_uu ) =
-          $self->get_bareword_counts($last_nonblank_token);
-        $expecting_TERM ||= $function_count;
-    }
 
     # we just have to find the next '>' if a term is expected
     if ($expecting_TERM) { $filter = '[\>]' }

diff --git a/t/snippets/expect/rt95708.def b/t/snippets/expect/rt95708.def
index 4df7f1439b4969cf874f43c248058355d5cfaea2..0c5cd4b318b1f5aaf66cdc544ec46d09fec2131b 100644 (file)
--- a/t/snippets/expect/rt95708.def
+++ b/t/snippets/expect/rt95708.def
@@ -8,7 +8,7 @@ my $json = encode_json {
     when    => time(),
     message => 'abc'
 };
-my $json2 = encode_json + {
+my $json2 = encode_json +{
     when    => time(),
     message => 'abc'
 };

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 853468511371e81f33aad160b4167809589a6141..eefddfbd3147f0415f6f92680f686009501de604 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -456,6 +456,8 @@
 ../snippets30.t        csc.csc3
 ../snippets30.t        git159.def
 ../snippets30.t        git159.git159
+../snippets30.t        git162.def
+../snippets30.t        git162.git162
 ../snippets4.t gnu1.gnu
 ../snippets4.t gnu2.def
 ../snippets4.t gnu2.gnu
@@ -576,5 +578,3 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets30.t        git162.def
-../snippets30.t        git162.git162

diff --git a/t/snippets9.t b/t/snippets9.t
index 6cf0617b7adadf337e348bb5d2194e7062550ddd..4b5fd348dfb091f6f96887eeef9d7eb92a81f2a8 100644 (file)
--- a/t/snippets9.t
+++ b/t/snippets9.t
@@ -382,7 +382,7 @@ my $json = encode_json {
     when    => time(),
     message => 'abc'
 };
-my $json2 = encode_json + {
+my $json2 = encode_json +{
     when    => time(),
     message => 'abc'
 };