From 85ecb7acad3c32a7314008e4caab01be295cf8c3 Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Tue, 1 Jun 2021 13:12:46 -0700
Subject: [PATCH] improved treatment of lexical subs

---
 lib/Perl/Tidy/Tokenizer.pm | 40 ++++++++++++++++++++++++++++++++------
 local-docs/BugLog.pod      | 32 ++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 6 deletions(-)

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index 72fa9675..3169e420 100644
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -7219,10 +7219,30 @@ sub scan_identifier_do {
             $match   = 1;
             $subname = $2;
 
-            $package = ( defined($1) && $1 ) ? $1 : $current_package;
-            $package =~ s/\'/::/g;
-            if ( $package =~ /^\:/ ) { $package = 'main' . $package }
-            $package =~ s/::$//;
+            my $is_lexical_sub =
+              $last_nonblank_type eq 'k' && $last_nonblank_token eq 'my';
+            if ( $is_lexical_sub && $1 ) {
+                warning(
+                    "'my' sub $subname cannot be in package '$1'\n"
+                );
+                $is_lexical_sub = 0;
+            }
+
+            if ($is_lexical_sub) {
+
+                # lexical subs use the block sequence number as a package name
+                my $seqno =
+                  $current_sequence_number[BRACE][ $current_depth[BRACE] ];
+                $seqno   = 1 unless ( defined($seqno) );
+                $package = $seqno;
+            }
+            else {
+                $package = ( defined($1) && $1 ) ? $1 : $current_package;
+                $package =~ s/\'/::/g;
+                if ( $package =~ /^\:/ ) { $package = 'main' . $package }
+                $package =~ s/::$//;
+            }
+
             my $pos  = pos($input_line);
             my $numc = $pos - $pos_beg;
             $tok  = 'sub ' . substr( $input_line, $pos_beg, $numc );
@@ -7353,9 +7373,17 @@ sub scan_identifier_do {
                         && $subname !~ /^[A-Z]+$/ )
                     {
                         my $lno = $saw_function_definition{$package}{$subname};
-                        warning(
+                        if ( $package =~ /^\d/ ) {
+                            warning(
+"already saw definition of lexical 'sub $subname' at line $lno\n"
+                            );
+
+                        }
+                        else {
+                            warning(
 "already saw definition of 'sub $subname' in package '$package' at line $lno\n"
-                        );
+                            );
+                        }
                     }
                     $saw_function_definition{$package}{$subname} =
                       $tokenizer_self->[_last_line_number_];
diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod
index 6b89eb8f..a0d3644c 100644
--- a/local-docs/BugLog.pod
+++ b/local-docs/BugLog.pod
@@ -2,6 +2,38 @@
 
 =over 4
 
+=item B<improved treatment of lexical subs>
+
+This update improves the treatment of lexical subs.  Previously they were formatted
+correctly but an error would have been produced if the same name was used for lexical
+subs defined in different blocks.
+
+For example, running the previous version of perltidy on the following:
+
+    use feature qw(lexical_subs);
+    use warnings; no warnings "experimental::lexical_subs";
+    {
+        my sub hello { print "Hello from hello1\n" }
+        {
+            my sub hello { print "Hello from hello2\n" }
+            hello();
+        }
+        hello();
+    }
+    {
+        my sub hello { print "Hello from hello3\n" }
+        hello();
+    }
+
+gave the (incorrect) error message:
+
+    6: already saw definition of 'sub hello' in package 'main' at line 4
+    12: already saw definition of 'sub hello' in package 'main' at line 6
+
+This update fixes that.
+
+1 Jun 2021.
+
 =item B<add v-string underscores; warn of leading commas>
 
 This update cleans up a couple of open issues in the tokenizer.
-- 
2.39.5