Fix for: [perl #2738] perl segfautls on input

The parser was incorrectly accepting <> as a subroutine prototype and
newATTRSUB didn't validate the proto argument before accessing op_sv.

p4raw-id: //depot/perl@22990

diff --git a/op.c b/op.c
index cdc0749..0fd5547 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4069,11 +4069,19 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     char *name;
     char *aname;
     GV *gv;
-    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
+    char *ps;
     register CV *cv=0;
     SV *const_sv;
 
     name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+
+    if (proto) {
+       assert(proto->op_type == OP_CONST);
+       ps = SvPVx(((SVOP*)proto)->op_sv, n_a);
+    }
+    else
+       ps = Nullch;
+
     if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
        SV *sv = sv_newmortal();
        Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 747dc05..8541645 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1729,6 +1729,10 @@ characters in prototypes are $, @, %, *, ;, [, ], &, and \.
 (F) When using the C<sub> keyword to construct an anonymous subroutine,
 you must always specify a block of code. See L<perlsub>.
 
+=item Illegal declaration of subroutine %s
+
+(F) A subroutine was not declared correctly. See L<perlsub>.
+
 =item Illegal division by zero
 
 (F) You tried to divide a number by 0.  Either something was wrong in

diff --git a/t/comp/parser.t b/t/comp/parser.t
index 92b9a6c..d784373 100644 (file)
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -9,7 +9,7 @@ BEGIN {
 }
 
 require "./test.pl";
-plan( tests => 44 );
+plan( tests => 47 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -156,3 +156,15 @@ EOF
     pass();
     $[ = 0; # restore the original value for less side-effects
 }
+
+# [perl #2738] perl segfautls on input
+{
+    eval q{ sub _ <> {} };
+    like($@, qr/Illegal declaration of subroutine main::_/, "readline operator as prototype");
+
+    eval q{ $s = sub <> {} };
+    like($@, qr/Illegal declaration of anonymous subroutine/, "readline operator as prototype");
+
+    eval q{ sub _ __FILE__ {} };
+    like($@, qr/Illegal declaration of subroutine main::_/, "__FILE__ as prototype");
+}

diff --git a/toke.c b/toke.c
index b113499..2b14e02 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5095,8 +5095,12 @@ Perl_yylex(pTHX)
 
                if (*s == ':' && s[1] != ':')
                    PL_expect = attrful;
-               else if (!have_name && *s != '{' && key == KEY_sub)
-                   Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+               else if (*s != '{' && key == KEY_sub) {
+                   if (!have_name)
+                       Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+                   else if (*s != ';')
+                       Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+               }
 
                if (have_proto) {
                    PL_nextval[PL_nexttoke].opval =