This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More Chip patches:
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 6 Feb 1998 15:06:18 +0000 (15:06 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 6 Feb 1998 15:06:18 +0000 (15:06 +0000)
Subject: [PATCH] Fix SEGV from combining caller and C<package;>
Date: Thu, 5 Feb 1998 21:47:50 -0500 (EST)
Subject: [PATCH] Fix line numbers after here documents in eval STRING
Date: Thu, 5 Feb 1998 21:50:08 -0500 (EST)
Subject: [PATCH] Make recursive lexical analysis more robust
Date: Thu, 5 Feb 1998 21:57:02 -0500 (EST)

p4raw-id: //depot/perl@464

pp_ctl.c
sv.c
toke.c

index acf6f01..a4135c6 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1134,6 +1134,7 @@ PP(pp_caller)
     register PERL_CONTEXT *cx;
     I32 dbcxix;
     I32 gimme;
+    HV *hv;
     SV *sv;
     I32 count = 0;
 
@@ -1163,14 +1164,22 @@ PP(pp_caller)
     }
 
     if (GIMME != G_ARRAY) {
-       dTARGET;
-
-       sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
-       PUSHs(TARG);
+       hv = cx->blk_oldcop->cop_stash;
+       if (!hv)
+           PUSHs(&sv_undef);
+       else {
+           dTARGET;
+           sv_setpv(TARG, HvNAME(hv));
+           PUSHs(TARG);
+       }
        RETURN;
     }
 
-    PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
+    hv = cx->blk_oldcop->cop_stash;
+    if (!hv)
+       PUSHs(&sv_undef);
+    else
+       PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
     PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
diff --git a/sv.c b/sv.c
index 38c0411..61f8ba7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3553,6 +3553,9 @@ sv_reset(register char *s, HV *stash)
     register I32 max;
     char todo[256];
 
+    if (!stash)
+       return;
+
     if (!*s) {         /* reset ?? searches */
        for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
            pm->op_pmflags &= ~PMf_USED;
diff --git a/toke.c b/toke.c
index 4547ad0..589393a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -49,6 +49,8 @@ static int uni _((I32 f, char *s));
 #endif
 static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
 static void restore_rsfp _((void *f));
+static void restore_expect _((void *e));
+static void restore_lex_expect _((void *e));
 
 static char ident_too_long[] = "Identifier too long";
 
@@ -257,6 +259,11 @@ lex_start(SV *line)
     SAVEPPTR(lex_brackstack);
     SAVEPPTR(lex_casestack);
     SAVEDESTRUCTOR(restore_rsfp, rsfp);
+    SAVESPTR(lex_stuff);
+    SAVEI32(lex_defer);
+    SAVESPTR(lex_repl);
+    SAVEDESTRUCTOR(restore_expect, tokenbuf + expect); /* encode as pointer */
+    SAVEDESTRUCTOR(restore_lex_expect, tokenbuf + expect);
 
     lex_state = LEX_NORMAL;
     lex_defer = 0;
@@ -271,11 +278,7 @@ lex_start(SV *line)
     *lex_casestack = '\0';
     lex_dojoin = 0;
     lex_starts = 0;
-    if (lex_stuff)
-       SvREFCNT_dec(lex_stuff);
     lex_stuff = Nullsv;
-    if (lex_repl)
-       SvREFCNT_dec(lex_repl);
     lex_repl = Nullsv;
     lex_inpat = 0;
     lex_inwhat = 0;
@@ -315,6 +318,22 @@ restore_rsfp(void *f)
 }
 
 static void
+restore_expect(e)
+void *e;
+{
+    /* a safe way to store a small integer in a pointer */
+    expect = (expectation)((char *)e - tokenbuf);
+}
+
+static void
+restore_lex_expect(e)
+void *e;
+{
+    /* a safe way to store a small integer in a pointer */
+    lex_expect = (expectation)((char *)e - tokenbuf);
+}
+
+static void
 incline(char *s)
 {
     dTHR;
@@ -4841,6 +4860,8 @@ scan_heredoc(register char *s)
        }
        sv_setpvn(tmpstr,d+1,s-d);
        s += len - 1;
+       curcop->cop_line++;     /* the preceding stmt passes a newline */
+
        sv_catpvn(herewas,s,bufend-s);
        sv_setsv(linestr,herewas);
        oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);