This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make ‘No comma allowed’ respect lex subs
authorFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 16:43:31 +0000 (09:43 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 17:03:57 +0000 (10:03 -0700)
$ ./perl -lIlib -XMfeature=:all -e 'sub foo {} print foo,bar'
bar
$ ./perl -lIlib -XMfeature=:all -e 'state sub foo {} print foo,bar'
No comma allowed after filehandle at -e line 1.

This commit makes the latter behave like the former.

t/op/lexsub.t
toke.c

index 7fedbf9..91bb15f 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 139;
+plan 141;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -391,6 +391,12 @@ sub _cmp { $a cmp $b }
   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
     'sort state_sub LIST'
 }
+{
+  state sub handel { "" }
+  print handel, "ok ", curr_test(),
+       " - no 'No comma allowed' after state sub\n";
+  curr_test(curr_test()+1);
+}
 
 # -------------------- my -------------------- #
 
@@ -748,6 +754,11 @@ is runperl(switches => ['-lXMfeature=:all'],
   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
     'sort my_sub LIST'
 }
+{
+  my sub handel { "" }
+  print handel,"ok ",curr_test()," - no 'No comma allowed' after my sub\n";
+  curr_test(curr_test()+1);
+}
 
 # -------------------- Interactions (and misc tests) -------------------- #
 
diff --git a/toke.c b/toke.c
index cd00e9d..2c76477 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8243,12 +8243,20 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
            s++;
        if (*s == ',') {
            GV* gv;
+           PADOFFSET off;
            if (keyword(w, s - w, 0))
                return;
 
            gv = gv_fetchpvn_flags(w, s - w, ( UTF ? SVf_UTF8 : 0 ), SVt_PVCV);
            if (gv && GvCVu(gv))
                return;
+           if (s - w <= 254) {
+               char tmpbuf[256];
+               Copy(w, tmpbuf+1, s - w, char);
+               *tmpbuf = '&';
+               off = pad_findmy_pvn(tmpbuf, s-w+1, UTF ? SVf_UTF8 : 0);
+               if (off != NOT_IN_PAD) return;
+           }
            Perl_croak(aTHX_ "No comma allowed after %s", what);
        }
     }