This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make &foo respect our sub
authorFather Chrysostomos <sprout@cpan.org>
Mon, 2 Jul 2012 05:53:41 +0000 (22:53 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 16 Sep 2012 05:44:53 +0000 (22:44 -0700)
This changes &foo to go through S_pending_ident (by setting
PL_pending_ident, which causes yylex to defer to S_pending_ident for
the next token) the way $foo and %foo do.

This necessitated reducing the maximum identifier length of &foo from
252 to 251, making it match @foo, $foo, etc.  So somebody‚Äôs JAPH might
break. :-)

MANIFEST
t/cmd/lexsub.t [new file with mode: 0644]
t/comp/parser.t
toke.c

index 46f29a7..6883a5f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4994,6 +4994,7 @@ t/bigmem/read.t                   Check read() handles large offsets
 t/bigmem/vec.t                 Check vec() handles large offsets
 t/cmd/elsif.t                  See if else-if works
 t/cmd/for.t                    See if for loops work
+t/cmd/lexsub.t                 See if lexical subroutines work
 t/cmd/mod.t                    See if statement modifiers work
 t/cmd/subval.t                 See if subroutine values work
 t/cmd/switch.t                 See if switch optimizations work
diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t
new file mode 100644 (file)
index 0000000..6dd5059
--- /dev/null
@@ -0,0 +1,70 @@
+#!perl
+
+print "1..14\n";
+
+{
+  our sub foo { 42 }
+  print "not " unless foo == 42;
+  print "ok 1 - calling our sub from same package\n";
+  print "not " unless &foo == 42;
+  print "ok 2 - calling our sub from same package (amper)\n";
+  package bar;
+  sub bar::foo { 43 }
+  print "not " unless foo == 42;
+  print "ok 3 - calling our sub from another package # TODO\n";
+  print "not " unless &foo == 42;
+  print "ok 4 - calling our sub from another package (amper)\n";
+}
+package bar;
+print "not " unless foo == 43;
+print "ok 5 - our sub falling out of scope\n";
+print "not " unless &foo == 43;
+print "ok 6 - our sub falling out of scope (called via amper)\n";
+package main;
+{
+  sub bar::a { 43 }
+  our sub a {
+    if (shift) {
+      package bar;
+      print "not " unless a == 43;
+      print "ok 7 - our sub invisible inside itself\n";
+      print "not " unless &a == 43;
+      print "ok 8 - our sub invisible inside itself (called via amper)\n";
+    }
+    42
+  }
+  a(1);
+  sub bar::b { 43 }
+  our sub b;
+  our sub b {
+    if (shift) {
+      package bar;
+      print "not " unless b == 42;
+      print "ok 9 - our sub visible inside itself after decl # TODO\n";
+      print "not " unless &b == 42;
+      print "ok 10 - our sub visible inside itself after decl (amper)\n";
+    }
+    42
+  }
+  b(1)
+}
+sub c { 42 }
+sub bar::c { 43 }
+{
+  our sub c;
+  package bar;
+  print "not " unless c == 42;
+  print "ok 11 - our sub foo; makes lex alias for existing sub # TODO\n";
+  print "not " unless &c == 42;
+  print "ok 12 - our sub foo; makes lex alias for existing sub (amper)\n";
+}
+{
+  our sub d;
+  sub d { 'd42' }
+  sub bar::d { 'd43' }
+  package bar;
+  print "not " unless d eq 'd42';
+  print "ok 13 - our sub foo; applies to subsequent sub foo {} # TODO\n";
+  print "not " unless &d eq 'd42';
+  print "ok 14 - our sub foo; applies to subsequent sub foo {} (amper)\n";
+}
index a5ba93c..a0f9a0c 100644 (file)
@@ -318,9 +318,9 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
   eval qq[ %$xFC ];
   like($@, qr/Identifier too long/, "too long id in % sigil ctx");
 
-  eval qq[ \\&$xFC ]; # take a ref since I don't want to call it
-  is($@, "", "252 character & sigil ident ok");
-  eval qq[ \\&$xFD ];
+  eval qq[ \\&$xFB ]; # take a ref since I don't want to call it
+  is($@, "", "251 character & sigil ident ok");
+  eval qq[ \\&$xFC ];
   like($@, qr/Identifier too long/, "too long id in & sigil ctx");
 
   eval qq[ *$xFC ];
diff --git a/toke.c b/toke.c
index 568e618..1a82259 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5987,10 +5987,12 @@ Perl_yylex(pTHX)
            BAop(OP_BIT_AND);
        }
 
-       s = scan_ident(s - 1, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
-       if (*PL_tokenbuf) {
+       PL_tokenbuf[0] = '&';
+       s = scan_ident(s - 1, PL_bufend, PL_tokenbuf + 1,
+                      sizeof PL_tokenbuf - 1, TRUE);
+       if (PL_tokenbuf[1]) {
            PL_expect = XOPERATOR;
-           force_ident(PL_tokenbuf, '&');
+           PL_pending_ident = '&';
        }
        else
            PREREF('&');