From: Graham Barr <gbarr@pobox.com>
Date: Wed, 5 Nov 1997 17:22:34 +0000 (-0600)
Subject: (Retracted by #11223.)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=246699ca5e3af04fcf52cf11c1535421dd986e59;p=p5sagit%2Fp5-mst-13.2.git

(Retracted by #11223.)
Subject: [PATCH] Re: Problem with Safe.pm and Perl 5.004
Message-Id: <3460FFBA.6DA51F46@ti.com>

p4raw-id: //depot/perl@11212
---

diff --git a/cv.h b/cv.h
index 7fa9400..bf9e180 100644
--- a/cv.h
+++ b/cv.h
@@ -34,6 +34,7 @@ struct xpvcv {
     struct perl_thread *xcv_owner;	/* current owner thread */
 #endif /* USE_THREADS */
     cv_flags_t	xcv_flags;
+    HV *	xcv_defstash;
 };
 
 /*
@@ -69,6 +70,7 @@ Returns the stash of the CV.
 #define CvOWNER(sv)	((XPVCV*)SvANY(sv))->xcv_owner
 #endif /* USE_THREADS */
 #define CvFLAGS(sv)	((XPVCV*)SvANY(sv))->xcv_flags
+#define CvDEFSTASH(sv)	((XPVCV*)SvANY(sv))->xcv_defstash
 
 #define CVf_CLONE	0x0001	/* anon CV uses external lexicals */
 #define CVf_CLONED	0x0002	/* a clone of one of those */
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 6c58312..5f091f8 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -290,6 +290,7 @@ PPCODE:
     GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV))));
 
     PUSHMARK(SP);
+    CvDEFSTASH(SvRV(codesv)) = PL_defstash;
     perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */
     SPAGAIN; /* for the PUTBACK added by xsubpp */
     LEAVE;
diff --git a/op.c b/op.c
index bb288a3..3daba0d 100644
--- a/op.c
+++ b/op.c
@@ -4202,6 +4202,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
 	CvCONST_off(cv);
     }
+    CvDEFSTASH(cv) = Nullhv;
     if (CvPADLIST(cv)) {
 	/* may be during global destruction */
 	if (SvREFCNT(CvPADLIST(cv))) {
@@ -4319,6 +4320,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     CvGV(cv)		= CvGV(proto);
     CvSTASH(cv)		= CvSTASH(proto);
     CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
+    CvDEFSTASH(cv)	= CvDEFSTASH(proto);
     CvSTART(cv)		= CvSTART(proto);
     if (outside)
 	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
@@ -4710,6 +4712,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
 	cv_undef(cv);
 	CvFLAGS(cv) = CvFLAGS(PL_compcv);
+	CvDEFSTASH(cv) = CvDEFSTASH(PL_compcv);
 	CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
 	CvOUTSIDE(PL_compcv) = 0;
 	CvPADLIST(cv) = CvPADLIST(PL_compcv);
@@ -5045,6 +5048,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     CvFILE(cv) = filename;	/* NOTE: not copied, as it is expected to be
 				   an external constant string */
     CvXSUB(cv) = subaddr;
+    CvDEFSTASH(cv) = PL_defstash;
 
     if (name) {
 	char *s = strrchr(name,':');
diff --git a/pp_hot.c b/pp_hot.c
index 9d51b1e..a28337f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2516,6 +2516,11 @@ try_autoload:
 	goto retry;
     }
 
+    if(CvDEFSTASH(cv) != PL_defstash) {
+        save_hptr(&PL_defstash);
+	PL_defstash = CvDEFSTASH(cv);
+    }
+
     gimme = GIMME_V;
     if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
 	cv = get_db_sub(&sv, cv);
diff --git a/sv.h b/sv.h
index 74a47d0..a41e9b8 100644
--- a/sv.h
+++ b/sv.h
@@ -322,7 +322,7 @@ struct xpvbm {
     U8		xbm_rare;	/* rarest character in string */
 };
 
-/* This structure much match XPVCV in cv.h */
+/* This structure must match XPVCV in cv.h */
 
 typedef U16 cv_flags_t;
 
@@ -350,6 +350,7 @@ struct xpvfm {
     struct perl_thread *xcv_owner;	/* current owner thread */
 #endif /* USE_THREADS */
     cv_flags_t	xcv_flags;
+    HV *	xcv_defstash;
 
     I32		xfm_lines;
 };
diff --git a/toke.c b/toke.c
index 11b8a7b..fa2b2bd 100644
--- a/toke.c
+++ b/toke.c
@@ -7437,6 +7437,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
     CvFLAGS(PL_compcv) |= flags;
+    CvDEFSTASH(PL_compcv) = PL_defstash;
 
     PL_comppad = newAV();
     av_push(PL_comppad, Nullsv);