From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Fri, 6 Feb 1998 15:06:18 +0000 (+0000)
Subject: More Chip patches:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=49d8d3a1123fb996c090905424ed66f675b3df17;p=p5sagit%2Fp5-mst-13.2.git

More Chip patches:
	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
---

diff --git a/pp_ctl.c b/pp_ctl.c
index acf6f01..a4135c6 100644
--- 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
--- 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
--- 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);