In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c947b31cf1422f59c2ed95f6d3de272c2793a60c?hp=e153fc352d5563cbaf10c069aab4a773d1172fd4>
- Log ----------------------------------------------------------------- commit c947b31cf1422f59c2ed95f6d3de272c2793a60c Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 17:06:03 2012 -0700 Do away with stashpv_hvname_match For some reason this is listed in the API, even though it is not docu- mented and is only available under ithreads. It was added by commit ed221c5717, which doesnât explain why it needed to be part of the API. (Presumably because a public macro used it, even though there are better ways to solve that.) It is unused on CPAN and (now) in core, so there is no reason to keep it. M embed.fnc M embed.h M proto.h M util.c commit 61b3e50d8dcb71970472bb2a7467f30042a9eaf5 Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 16:57:23 2012 -0700 Say goodbye to SAVECOPSTASH This is undocumented and unused. M scope.h commit 69927412246c66d2f82f9f7a155734300e71398d Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 16:44:54 2012 -0700 Obliterate CopSTASH_free It is unused outside the core, defined as a no-op, and undocumented. M cop.h M op.c M perl.c commit 2b2e870525cc613cf38ea39455b32d4a7e39a430 Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 16:41:23 2012 -0700 stash.t: Un-TODO passing tests M t/op/stash.t M t/uni/stash.t commit d4d03940c58a0177edb93c8854929856e9975bf9 Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 14:04:03 2012 -0700 [perl #78742] Store CopSTASH in a pad under threads Before this commit, a pointer to the copâs stash was stored in cop->cop_stash under non-threaded perls, and the name and name length were stored in cop->cop_stashpv and cop->cop_stashlen under ithreads. Consequently, eval "__PACKAGE__" would end up returning the wrong package name under threads if the current package had been assigned over. This commit changes the way cops store their stash under threads. Now it is an offset (cop->cop_stashoff) into the new PL_stashpad array (just a mallocked block), which holds pointers to all stashes that have code compiled in them. I didnât use the lexical pads, because CopSTASH(cop) wonât work unless PL_curpad is holding the right pad. And things start to get very hairy in pp_caller, since the correct pad isnât anywhere easily accessible on the context stack (oldcomppad actually referring to the current comppad). The approach Iâve followed uses far less code, too. In addition to fixing the bug, this also saves memory. Instead of allocating a separate PV for every single statement (to hold the stash name), now all lines of code in a package can share the same stashpad slot. So, on a 32-bit OS X, thatâs 16 bytes less memory per COP for short package names. Since stashoff is the same size as stashpv, there is no difference there. Each package now needs just 4 bytes in the stashpad for storing a pointer. For speedâs sake PL_stashpadix stores the index of the last-used stashpad offset. So only when switching packages is there a linear search through the stashpad. M cop.h M embed.fnc M embed.h M embedvar.h M ext/B/B.xs M gv.c M intrpvar.h M makedef.pl M op.c M perl.c M proto.h M scope.h M sv.c M util.c commit f3ac9fb2631eb3706dcdd2fe0274a953da37486f Author: Father Chrysostomos <[email protected]> Date: Mon Jun 4 13:10:28 2012 -0700 Increase $B::VERSION to 1.36 M ext/B/B.pm commit 715f9ce71e7b8c216a043af2cd6bb78c340f56c1 Author: Father Chrysostomos <[email protected]> Date: Sat Jun 2 19:03:52 2012 -0700 pad.c: Remove obsolete comment We now store the UTF8-ness in the pad, as of 5.15.4 or so. M pad.c commit 28333232a1c7950f0ac34311fd2baae99f4e9a6f Author: Father Chrysostomos <[email protected]> Date: Thu May 31 23:02:31 2012 -0700 Donât localise CopSTASH(&PL_compiling) in newCONSTSUB When newCONSTSUB was added in commit 5476c433, it did not set curcop temporarily to &compiling, and so gv_fetchpv would look at curcop->cop_stash. So cop_stash needed to be localised. (Time passes.... curcop is now PL_curcop. &compiling is now &PL_compiling. gv_fetchpv is now gv_fetchpvn_flags. curcop->cop_stash is now CopSTASH(PL_curcop).) Since commit 401667e9, newCONSTSUB has set PL_curcop to &PL_compiling temporarily. When that is the case, gv_fetchpvn_flags uses PL_curstash and ignores CopSTASH(PL_curcop). So this localisation is no longer necessary, as newCONSTSUB has always set (PL_)curstash. M op.c ----------------------------------------------------------------------- Summary of changes: cop.h | 48 ++++++++++-------------------------------------- embed.fnc | 5 +++-- embed.h | 2 +- embedvar.h | 3 +++ ext/B/B.pm | 2 +- ext/B/B.xs | 6 +++++- gv.c | 9 --------- intrpvar.h | 3 +++ makedef.pl | 3 +++ op.c | 40 ++++++++++++++++++++++++++++++---------- pad.c | 5 ----- perl.c | 4 ++-- proto.h | 12 +++++------- scope.h | 9 +++------ sv.c | 14 ++++++++++---- t/op/stash.t | 5 +---- t/uni/stash.t | 5 +---- util.c | 34 ---------------------------------- 18 files changed, 81 insertions(+), 128 deletions(-) diff --git a/cop.h b/cop.h index dc52807..9f3762e 100644 --- a/cop.h +++ b/cop.h @@ -387,9 +387,8 @@ struct cop { line_t cop_line; /* line # of this command */ /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS - char * cop_stashpv; /* package line was compiled in */ + PADOFFSET cop_stashoff; /* package line was compiled in */ char * cop_file; /* file name the following line # is from */ - I32 cop_stashlen; /* negative for UTF8 */ #else HV * cop_stash; /* package line was compiled in */ GV * cop_filegv; /* file the following line # is from */ @@ -426,41 +425,14 @@ struct cop { # else # define CopFILEAVx(c) (GvAV(gv_fetchfile(CopFILE(c)))) # endif -# define CopSTASHPV(c) ((c)->cop_stashpv) +# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] +# define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \ + ? alloccopstash(hv) \ + : 0) # ifdef NETWARE -# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = \ - ((pv) ? savepvn(pv,n) : NULL)) -# else -# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = (pv) \ - ? savesharedpvn(pv,n) : NULL) -# endif - -# define CopSTASH_len_set(c,n) ((c)->cop_stashlen = (n)) -# define CopSTASH_len(c) ((c)->cop_stashlen) - -# define CopSTASH(c) (CopSTASHPV(c) \ - ? gv_stashpvn(CopSTASHPV(c), \ - CopSTASH_len(c) < 0 \ - ? -CopSTASH_len(c) \ - : CopSTASH_len(c), \ - GV_ADD|SVf_UTF8*(CopSTASH_len(c) < 0) \ - ) \ - : NULL) -# define CopSTASH_set(c,hv) (CopSTASHPV_set(c, \ - (hv) ? HvNAME_get(hv) : NULL, \ - (hv) ? HvNAMELEN(hv) : 0), \ - CopSTASH_len_set(c, \ - (hv) ? HvNAMEUTF8(hv) \ - ? -HvNAMELEN(hv) \ - : HvNAMELEN(hv) \ - : 0)) -# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv)) -# ifdef NETWARE -# define CopSTASH_free(c) SAVECOPSTASH_FREE(c) # define CopFILE_free(c) SAVECOPFILE_FREE(c) # else -# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c)) # define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL)) # endif #else @@ -479,15 +451,15 @@ struct cop { ? SvPVX(GvSV(CopFILEGV(c))) : NULL) # define CopSTASH(c) ((c)->cop_stash) # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) -# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) - /* cop_stash is not refcounted */ -# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) -# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) -# define CopSTASH_free(c) # define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL)) #endif /* USE_ITHREADS */ +#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) + /* cop_stash is not refcounted */ +#define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +#define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) + #define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash)) #define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h)) diff --git a/embed.fnc b/embed.fnc index 8738f69..455a8c3 100644 --- a/embed.fnc +++ b/embed.fnc @@ -973,6 +973,9 @@ p |void |package_version|NN OP* v : Used in toke.c and perly.y p |PADOFFSET|allocmy |NN const char *const name|const STRLEN len\ |const U32 flags +#ifdef USE_ITHREADS +p |PADOFFSET|alloccopstash|NN HV *hv +#endif : Used in perly.y pR |OP* |oopsAV |NN OP* o : Used in perly.y @@ -2437,8 +2440,6 @@ np |void |my_swabn |NN void* ptr|int n Ap |GV* |gv_fetchpvn_flags|NN const char* name|STRLEN len|I32 flags|const svtype sv_type Ap |GV* |gv_fetchsv|NN SV *name|I32 flags|const svtype sv_type -ApR |bool |stashpv_hvname_match|NN const COP *c|NN const HV *hv - #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP : Used in sv.c p |void |dump_sv_child |NN SV *sv diff --git a/embed.h b/embed.h index 7c5575e..1815481 100644 --- a/embed.h +++ b/embed.h @@ -531,7 +531,6 @@ #define sortsv_flags(a,b,c,d) Perl_sortsv_flags(aTHX_ a,b,c,d) #define stack_grow(a,b,c) Perl_stack_grow(aTHX_ a,b,c) #define start_subparse(a,b) Perl_start_subparse(aTHX_ a,b) -#define stashpv_hvname_match(a,b) Perl_stashpv_hvname_match(aTHX_ a,b) #define str_to_version(a) Perl_str_to_version(aTHX_ a) #define sv_2bool_flags(a,b) Perl_sv_2bool_flags(aTHX_ a,b) #define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d) @@ -1742,6 +1741,7 @@ #define pidgone(a,b) S_pidgone(aTHX_ a,b) # endif # if defined(USE_ITHREADS) +#define alloccopstash(a) Perl_alloccopstash(aTHX_ a) #define mro_meta_dup(a,b) Perl_mro_meta_dup(aTHX_ a,b) #define padlist_dup(a,b) Perl_padlist_dup(aTHX_ a,b) # endif diff --git a/embedvar.h b/embedvar.h index c4a0fa9..5245261 100644 --- a/embedvar.h +++ b/embedvar.h @@ -316,6 +316,9 @@ #define PL_stack_sp (vTHX->Istack_sp) #define PL_start_env (vTHX->Istart_env) #define PL_stashcache (vTHX->Istashcache) +#define PL_stashpad (vTHX->Istashpad) +#define PL_stashpadix (vTHX->Istashpadix) +#define PL_stashpadmax (vTHX->Istashpadmax) #define PL_statbuf (vTHX->Istatbuf) #define PL_statcache (vTHX->Istatcache) #define PL_statgv (vTHX->Istatgv) diff --git a/ext/B/B.pm b/ext/B/B.pm index 7507c40..d7a5cdf 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.35'; + $B::VERSION = '1.36'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 632c874..69fc6bb 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1163,10 +1163,12 @@ BOOT: #ifdef USE_ITHREADS cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__); XSANY.any_i32 = PMOP_pmoffset_ix; +# if PERL_VERSION >= 17 && defined(CopSTASH_len) cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_stashpv_ix; cv = newXS("B::COP::file", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_file_ix; +# endif #else cv = newXS("B::COP::stash", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_stash_ix; @@ -1261,7 +1263,9 @@ COP_stashlen(o) #endif -#else +#endif + +#if !defined(USE_ITHREADS) || (PERL_VERSION > 16 && !defined(CopSTASH_len)) char * COP_stashpv(o) diff --git a/gv.c b/gv.c index d7660f7..020e2a2 100644 --- a/gv.c +++ b/gv.c @@ -923,17 +923,8 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags) superisa = GvAVn(gv); GvMULTI_on(gv); sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0); -#ifdef USE_ITHREADS - av_push(superisa, newSVpvn_flags(CopSTASHPV(PL_curcop), - CopSTASH_len(PL_curcop) < 0 - ? -CopSTASH_len(PL_curcop) - : CopSTASH_len(PL_curcop), - SVf_UTF8*(CopSTASH_len(PL_curcop) < 0) - )); -#else av_push(superisa, newSVhek(CopSTASH(PL_curcop) ? HvNAME_HEK(CopSTASH(PL_curcop)) : NULL)); -#endif return stash; } diff --git a/intrpvar.h b/intrpvar.h index 56435d6..0124f51 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -690,6 +690,9 @@ PERLVAR(I, regex_padav, AV *) /* All regex objects, indexed via the Entry 0 is an SV whose PV is a "packed" list of IVs listing the now-free slots in the array */ +PERLVAR(I, stashpad, HV **) /* for CopSTASH */ +PERLVARI(I, stashpadmax, PADOFFSET, 64) +PERLVARI(I, stashpadix, PADOFFSET, 0) #endif #ifdef USE_REENTRANT_API diff --git a/makedef.pl b/makedef.pl index a52241f..f309efb 100644 --- a/makedef.pl +++ b/makedef.pl @@ -355,6 +355,9 @@ unless ($define{'USE_ITHREADS'}) { PL_hints_mutex PL_my_ctx_mutex PL_perlio_mutex + PL_stashpad + PL_stashpadix + PL_stashpadmax Perl_clone_params_del Perl_clone_params_new Perl_parser_dup diff --git a/op.c b/op.c index 6845eba..bc6df04 100644 --- a/op.c +++ b/op.c @@ -465,6 +465,34 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) return off; } +#ifdef USE_ITHREADS +PADOFFSET +Perl_alloccopstash(pTHX_ HV *hv) +{ + PADOFFSET off = 0, o = 1; + bool found_slot = FALSE; + + PERL_ARGS_ASSERT_ALLOCCOPSTASH; + + if (PL_stashpad[PL_stashpadix] == hv) return PL_stashpadix; + + for (; o < PL_stashpadmax; ++o) { + if (PL_stashpad[o] == hv) return PL_stashpadix = o; + if (!PL_stashpad[o] || SvTYPE(PL_stashpad[o]) != SVt_PVHV) + found_slot = TRUE, off = o; + } + if (!found_slot) { + Renew(PL_stashpad, PL_stashpadmax + 10, HV *); + Zero(PL_stashpad + PL_stashpadmax, 10, HV *); + off = PL_stashpadmax; + PL_stashpadmax += 10; + } + + PL_stashpad[PL_stashpadix = off] = hv; + return off; +} +#endif + /* free the body of an op without examining its contents. * Always use this rather than FreeOp directly */ @@ -741,7 +769,6 @@ S_cop_free(pTHX_ COP* cop) PERL_ARGS_ASSERT_COP_FREE; CopFILE_free(cop); - CopSTASH_free(cop); if (! specialWARN(cop->cop_warnings)) PerlMemShared_free(cop->cop_warnings); cophh_free(CopHINTHASH_get(cop)); @@ -6994,9 +7021,7 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len, if (stash) { SAVEGENERICSV(PL_curstash); - SAVECOPSTASH(PL_curcop); PL_curstash = (HV *)SvREFCNT_inc_simple_NN(stash); - CopSTASH_set(PL_curcop,stash); } /* file becomes the CvFILE. For an XS, it's usually static storage, @@ -7008,10 +7033,6 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len, CvXSUBANY(cv).any_ptr = sv; CvCONST_on(cv); -#ifdef USE_ITHREADS - if (stash) - CopSTASH_free(PL_curcop); -#endif LEAVE; return cv; @@ -10020,8 +10041,7 @@ Perl_rpeep(pTHX_ register OP *o) data. */ firstcop->cop_line = secondcop->cop_line; #ifdef USE_ITHREADS - firstcop->cop_stashpv = secondcop->cop_stashpv; - firstcop->cop_stashlen = secondcop->cop_stashlen; + firstcop->cop_stashoff = secondcop->cop_stashoff; firstcop->cop_file = secondcop->cop_file; #else firstcop->cop_stash = secondcop->cop_stash; @@ -10033,7 +10053,7 @@ Perl_rpeep(pTHX_ register OP *o) firstcop->cop_hints_hash = secondcop->cop_hints_hash; #ifdef USE_ITHREADS - secondcop->cop_stashpv = NULL; + secondcop->cop_stashoff = NULL; secondcop->cop_file = NULL; #else secondcop->cop_stash = NULL; diff --git a/pad.c b/pad.c index 6901b83..689a180 100644 --- a/pad.c +++ b/pad.c @@ -652,11 +652,6 @@ but is used for debugging. /* XXX DAPM integrate alloc(), add_name() and add_anon(), * or at least rationalise ??? */ -/* And flag whether the incoming name is UTF8 or 8 bit? - Could do this either with the +ve/-ve hack of the HV code, or expanding - the flag bits. Either way, this makes proper Unicode safe pad support. - NWC -*/ PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) diff --git a/perl.c b/perl.c index 44987d3..79d15e2 100644 --- a/perl.c +++ b/perl.c @@ -307,6 +307,7 @@ perl_construct(pTHXx) else all hell breaks loose in S_find_uninit_var(). */ Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs("")); PL_regex_pad = AvARRAY(PL_regex_padav); + Newxz(PL_stashpad, PL_stashpadmax, HV *); #endif #ifdef USE_REENTRANT_API Perl_reentrant_init(aTHX); @@ -828,7 +829,6 @@ perl_destruct(pTHXx) #endif CopFILE_free(&PL_compiling); - CopSTASH_free(&PL_compiling); /* The exit() function will do everything that needs doing. */ return STATUS_EXIT; @@ -843,6 +843,7 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_regex_padav); PL_regex_padav = NULL; PL_regex_pad = NULL; + Safefree(PL_stashpad); #endif SvREFCNT_dec(MUTABLE_SV(PL_stashcache)); @@ -1024,7 +1025,6 @@ perl_destruct(pTHXx) cophh_free(CopHINTHASH_get(&PL_compiling)); CopHINTHASH_set(&PL_compiling, cophh_new_empty()); CopFILE_free(&PL_compiling); - CopSTASH_free(&PL_compiling); /* Prepare to destruct main symbol table. */ diff --git a/proto.h b/proto.h index 19d825a..539d06d 100644 --- a/proto.h +++ b/proto.h @@ -3667,13 +3667,6 @@ PERL_CALLCONV PerlIO* Perl_start_glob(pTHX_ SV *tmpglob, IO *io) assert(tmpglob); assert(io) PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags); -PERL_CALLCONV bool Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv) - __attribute__warn_unused_result__ - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH \ - assert(c); assert(hv) - PERL_CALLCONV NV Perl_str_to_version(pTHX_ SV *sv) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); @@ -7473,6 +7466,11 @@ PERL_CALLCONV I32 Perl_unlnk(pTHX_ const char* f) #endif #if defined(USE_ITHREADS) +PERL_CALLCONV PADOFFSET Perl_alloccopstash(pTHX_ HV *hv) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_ALLOCCOPSTASH \ + assert(hv) + PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, const PerlInterpreter* proto_perl) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2); diff --git a/scope.h b/scope.h index 09a91f5..74ebed9 100644 --- a/scope.h +++ b/scope.h @@ -235,15 +235,12 @@ scope has the given name. Name must be a literal string. #define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER) #ifdef USE_ITHREADS -# define SAVECOPSTASH(c) (SAVEPPTR(CopSTASHPV(c)), \ - SAVEI32(CopSTASH_len(c))) -# define SAVECOPSTASH_FREE(c) (SAVESHAREDPV(CopSTASHPV(c)), \ - SAVEI32(CopSTASH_len(c))) +# define SAVECOPSTASH_FREE(c) SAVEIV((c)->cop_stashoff) # define SAVECOPFILE(c) SAVEPPTR(CopFILE(c)) # define SAVECOPFILE_FREE(c) SAVESHAREDPV(CopFILE(c)) #else -# define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c)) -# define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */ +# /* XXX not refcounted */ +# define SAVECOPSTASH_FREE(c) SAVESPTR(CopSTASH(c)) # define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) # define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) #endif diff --git a/sv.c b/sv.c index 56f4407..b4716db 100644 --- a/sv.c +++ b/sv.c @@ -13210,10 +13210,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab)); ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab); - /* These two PVs will be free'd special way so must set them same way op.c does */ - PL_compiling.cop_stashpv = savesharedpv(PL_compiling.cop_stashpv); - ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_stashpv, PL_compiling.cop_stashpv); - + /* This PV will be free'd special way so must set it same way op.c does */ PL_compiling.cop_file = savesharedpv(PL_compiling.cop_file); ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file); @@ -13271,6 +13268,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_regex_padav = av_dup_inc(proto_perl->Iregex_padav, param); PL_regex_pad = AvARRAY(PL_regex_padav); + PL_stashpadmax = proto_perl->Istashpadmax; + PL_stashpadix = proto_perl->Istashpadix ; + Newx(PL_stashpad, PL_stashpadmax, HV *); + { + PADOFFSET o = 0; + for (; o < PL_stashpadmax; ++o) + PL_stashpad[o] = hv_dup(proto_perl->Istashpad[o], param); + } + /* shortcuts to various I/O objects */ PL_ofsgv = gv_dup_inc(proto_perl->Iofsgv, param); PL_stdingv = gv_dup(proto_perl->Istdingv, param); diff --git a/t/op/stash.t b/t/op/stash.t index 3c31525..99e44da 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -280,11 +280,8 @@ fresh_perl_is( 'ref() returns the same thing when an objectâs stash is moved'; ::like "$obj", qr "^rile=ARRAY\(0x[\da-f]+\)\z", 'objects stringify the same way when their stashes are moved'; - { - local $::TODO = $Config{useithreads} ? "fails under threads" : undef; - ::is eval '__PACKAGE__', 'rile', + ::is eval '__PACKAGE__', 'rile', '__PACKAGE__ returns the same when the current stash is moved'; - } # Now detach it completely from the symtab, making it effect- # ively anonymous diff --git a/t/uni/stash.t b/t/uni/stash.t index 168b93c..bacd69d 100644 --- a/t/uni/stash.t +++ b/t/uni/stash.t @@ -266,11 +266,8 @@ plan( tests => 58 ); 'ref() returns the same thing when an objectâs stash is moved'; ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z", 'objects stringify the same way when their stashes are moved'; - { - local $::TODO = $Config{useithreads} ? "fails under threads" : undef; - ::is eval '__PACKAGE__', 'rìle', + ::is eval '__PACKAGE__', 'rìle', '__PACKAGE__ returns the same when the current stash is moved'; - } # Now detach it completely from the symtab, making it effect- # ively anonymous diff --git a/util.c b/util.c index 6512160..d0fea67 100644 --- a/util.c +++ b/util.c @@ -5694,40 +5694,6 @@ Perl_get_hash_seed(pTHX) return myseed; } -#ifdef USE_ITHREADS -bool -Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv) -{ - const char * stashpv = CopSTASHPV(c); - const char * name = HvNAME_get(hv); - const bool utf8 = CopSTASH_len(c) < 0; - const I32 len = utf8 ? -CopSTASH_len(c) : CopSTASH_len(c); - PERL_UNUSED_CONTEXT; - PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH; - - if (!stashpv || !name) - return stashpv == name; - if ( !HvNAMEUTF8(hv) != !utf8 ) { - if (utf8) { - return (bytes_cmp_utf8( - (const U8*)stashpv, len, - (const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0); - } else { - return (bytes_cmp_utf8( - (const U8*)name, HEK_LEN(HvNAME_HEK(hv)), - (const U8*)stashpv, len) == 0); - } - } - else - return (stashpv == name - || (HEK_LEN(HvNAME_HEK(hv)) == len - && memEQ(stashpv, name, len))); - /*NOTREACHED*/ - return FALSE; -} -#endif - - #ifdef PERL_GLOBAL_STRUCT #define PERL_GLOBAL_STRUCT_INIT -- Perl5 Master Repository
