New upstream version 20200110

[perltidy.git] / lib / Perl / Tidy / Tokenizer.pm

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index c7bc6ff7f9b8b0f63b84cc6a3b5bd758aebd31c7..e1d644a96bb06a3e89949e14a4edf45ff62e1270 100644 (file)
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -21,7 +21,7 @@
 package Perl::Tidy::Tokenizer;
 use strict;
 use warnings;
-our $VERSION = '20190601';
+our $VERSION = '20200110';
 
 use Perl::Tidy::LineBuffer;
 
@@ -114,6 +114,8 @@ use vars qw{
   %is_keyword_taking_list
   %is_keyword_taking_optional_args
   %is_q_qq_qw_qx_qr_s_y_tr_m
+  %is_sub
+  %is_package
 };
 
 # possible values of operator_expected()
@@ -144,6 +146,28 @@ sub DESTROY {
     return;
 }
 
+sub check_options {
+
+    # Check Tokenizer parameters
+    my $rOpts = shift;
+
+    %is_sub = ();
+    $is_sub{'sub'} = 1;
+
+    # Install any aliases to 'sub'
+    if ( $rOpts->{'sub-alias-list'} ) {
+
+        # Note that any 'sub-alias-list' has been preprocessed to
+        # be a trimmed, space-separated list which includes 'sub'
+        # for example, it might be 'sub method fun'
+        my @sub_alias_list = split /\s+/, $rOpts->{'sub-alias-list'};
+        foreach my $word (@sub_alias_list) {
+            $is_sub{$word} = 1;
+        }
+    }
+    return;
+}
+
 sub new {
 
     my ( $class, @args ) = @_;
@@ -340,6 +364,11 @@ sub get_saw_brace_error {
     }
 }
 
+sub get_unexpected_error_count {
+    my ($self) = shift;
+    return $self->{_unexpected_error_count};
+}
+
 # interface to Perl::Tidy::Diagnostics routines
 sub write_diagnostics {
     my $msg = shift;
@@ -2031,8 +2060,22 @@ sub prepare_for_a_new_file {
             {
                 $is_pattern = 0;
             }
+
+            # patch for RT#131288, user constant function without prototype
+            # last type is 'U' followed by ?.
+            elsif ( $last_nonblank_type =~ /^[FUY]$/ ) {
+                $is_pattern = 0;
+            }
             elsif ( $expecting == UNKNOWN ) {
 
+                # In older versions of Perl, a bare ? can be a pattern
+                # delimiter.  Sometime after Perl 5.10 this seems to have
+                # been dropped, but we have to support it in order to format
+                # older programs.  For example, the following line worked
+                # at one time:
+                #      ?(.*)? && (print $1,"\n");
+                # In current versions it would have to be written with slashes:
+                #      /(.*)/ && (print $1,"\n");
                 my $msg;
                 ( $is_pattern, $msg ) =
                   guess_if_pattern_or_conditional( $i, $rtokens, $rtoken_map,
@@ -2441,10 +2484,6 @@ sub prepare_for_a_new_file {
     @_ = qw(use require);
     @is_use_require{@_} = (1) x scalar(@_);
 
-    my %is_sub_package;
-    @_ = qw(sub package);
-    @is_sub_package{@_} = (1) x scalar(@_);
-
     # This hash holds the hash key in $tokenizer_self for these keywords:
     my %is_format_END_DATA = (
         'format'   => '_in_format',
@@ -2860,7 +2899,7 @@ EOM
             # but do not start on blanks and comments
             if ( $id_scan_state && $pre_type !~ /[b#]/ ) {
 
-                if ( $id_scan_state =~ /^(sub|package)/ ) {
+                if ( $is_sub{$id_scan_state} || $is_package{$id_scan_state} ) {
                     scan_id();
                 }
                 else {
@@ -3221,7 +3260,7 @@ EOM
                 elsif (
                        ( $next_nonblank_token eq ':' )
                     && ( $rtokens->[ $i_next + 1 ] ne ':' )
-                    && ( $i_next <= $max_token_index )      # colon on same line
+                    && ( $i_next <= $max_token_index )    # colon on same line
                     && label_ok()
                   )
                 {
@@ -3236,7 +3275,7 @@ EOM
                 }
 
                 #      'sub' || 'package'
-                elsif ( $is_sub_package{$tok_kw} ) {
+                elsif ( $is_sub{$tok_kw} || $is_package{$tok_kw} ) {
                     error_if_expecting_OPERATOR()
                       if ( $expecting == OPERATOR );
                     scan_id();
@@ -3709,7 +3748,7 @@ EOM
             if ( $type eq ';' && $tok =~ /\w/ ) { $fix_type = 'k' }
 
             # output anonymous 'sub' as keyword
-            if ( $type eq 't' && $tok eq 'sub' ) { $fix_type = 'k' }
+            if ( $type eq 't' && $is_sub{$tok} ) { $fix_type = 'k' }
 
             # -----------------------------------------------------------------
 
@@ -4225,7 +4264,13 @@ sub operator_expected {
         # could change the interpretation of the statement.
         else {
             if ( $tok =~ /^([x\/\+\-\*\%\&\.\?\<]|\>\>)$/ ) {
-                complain("operator in print statement not recommended\n");
+
+               # Do not complain in 'use' statements, which have special syntax.
+               # For example, from RT#130344:
+               #   use lib $FindBin::Bin . '/lib';
+                if ( $statement_type ne 'use' ) {
+                    complain("operator in print statement not recommended\n");
+                }
                 $op_expected = OPERATOR;
             }
         }
@@ -4518,6 +4563,13 @@ sub code_block_type {
         return $last_nonblank_token;
     }
 
+    # or a sub alias
+    elsif (( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' )
+        && ( $is_sub{$last_nonblank_token} ) )
+    {
+        return 'sub';
+    }
+
     elsif ( $statement_type =~ /^(sub|package)\b/ ) {
         return $statement_type;
     }
@@ -4718,6 +4770,7 @@ sub report_unexpected {
               write_on_underline( $underline, $pos_prev - $offset, '-' x $num );
             $trailer = " (previous token underlined)";
         }
+        $underline =~ s/\s+$//;
         warning( $numbered_line . "\n" );
         warning( $underline . "\n" );
         warning( $msg . $trailer . "\n" );
@@ -5524,7 +5577,7 @@ sub scan_id_do {
     # handle non-blank line; identifier, if any, must follow
     unless ($blank_line) {
 
-        if ( $id_scan_state eq 'sub' ) {
+        if ( $is_sub{$id_scan_state} ) {
             ( $i, $tok, $type, $id_scan_state ) = do_scan_sub(
                 $input_line, $i,             $i_beg,
                 $tok,        $type,          $rtokens,
@@ -5532,7 +5585,7 @@ sub scan_id_do {
             );
         }
 
-        elsif ( $id_scan_state eq 'package' ) {
+        elsif ( $is_package{$id_scan_state} ) {
             ( $i, $tok, $type ) =
               do_scan_package( $input_line, $i, $i_beg, $tok, $type, $rtokens,
                 $rtoken_map, $max_token_index );
@@ -6273,7 +6326,7 @@ sub scan_identifier_do {
             $attrs = $2;
 
             # If we also found the sub name on this call then append PROTO.
-            # This is not necessary but for compatability with previous
+            # This is not necessary but for compatibility with previous
             # versions when the -csc flag is used:
             if ( $match && $proto ) {
                 $tok .= $proto;
@@ -6385,6 +6438,7 @@ sub scan_identifier_do {
                 $statement_type = $tok;
             }
             elsif ($next_nonblank_token) {      # EOF technically ok
+                $subname = "" unless defined($subname);
                 warning(
 "expecting ':' or ';' or '{' after definition or declaration of sub '$subname' but saw '$next_nonblank_token'\n"
                 );
@@ -7756,6 +7810,12 @@ BEGIN {
     @q = qw(q qq qw qx qr s y tr m);
     @is_q_qq_qw_qx_qr_s_y_tr_m{@q} = (1) x scalar(@q);
 
+    @q = qw(sub);
+    @is_sub{@q} = (1) x scalar(@q);
+
+    @q = qw(package);
+    @is_package{@q} = (1) x scalar(@q);
+
     # These keywords are handled specially in the tokenizer code:
     my @special_keywords = qw(
       do