From 246699ca5e3af04fcf52cf11c1535421dd986e59 Mon Sep 17 00:00:00 2001 From: Graham Barr Date: Wed, 5 Nov 1997 11:22:34 -0600 Subject: [PATCH] (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 --- cv.h | 2 ++ ext/Opcode/Opcode.xs | 1 + op.c | 4 ++++ pp_hot.c | 5 +++++ sv.h | 3 ++- toke.c | 1 + 6 files changed, 15 insertions(+), 1 deletion(-) 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); -- 2.7.4