diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | perlapi.c | 4 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | sv.c | 121 |
5 files changed, 109 insertions, 23 deletions
@@ -2352,7 +2352,7 @@ #define ss_dup(a,b) Perl_ss_dup(aTHX_ a,b) #define any_dup(a,b) Perl_any_dup(aTHX_ a,b) #define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c) -#define re_dup(a) Perl_re_dup(aTHX_ a) +#define re_dup(a,b) Perl_re_dup(aTHX_ a,b) #define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b) #define dirp_dup(a) Perl_dirp_dup(aTHX_ a) #define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b) @@ -2228,7 +2228,7 @@ Ap |PERL_SI*|si_dup |PERL_SI* si|clone_params* param Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|clone_params* param Ap |void* |any_dup |void* v|PerlInterpreter* proto_perl Ap |HE* |he_dup |HE* e|bool shared|clone_params* param -Ap |REGEXP*|re_dup |REGEXP* r +Ap |REGEXP*|re_dup |REGEXP* r|clone_params* param Ap |PerlIO*|fp_dup |PerlIO* fp|char type Ap |DIR* |dirp_dup |DIR* dp Ap |GP* |gp_dup |GP* gp|clone_params* param @@ -4082,9 +4082,9 @@ Perl_he_dup(pTHXo_ HE* e, bool shared, clone_params* param) #undef Perl_re_dup REGEXP* -Perl_re_dup(pTHXo_ REGEXP* r) +Perl_re_dup(pTHXo_ REGEXP* r, clone_params* param) { - return ((CPerlObj*)pPerl)->Perl_re_dup(r); + return ((CPerlObj*)pPerl)->Perl_re_dup(r, param); } #undef Perl_fp_dup @@ -961,7 +961,7 @@ PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si, clone_params* param); PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, clone_params* param); PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl); PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared, clone_params* param); -PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r); +PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r, clone_params* param); PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type); PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp); PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, clone_params* param); @@ -1313,6 +1313,7 @@ STATIC char* S_stdize_locale(pTHX_ char* locs); #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +STATIC COP* S_closest_cop(pTHX_ COP *cop, OP *o); STATIC SV* S_mess_alloc(pTHX); # if defined(LEAKTEST) STATIC void S_xstat(pTHX_ int); @@ -19,6 +19,7 @@ #include "EXTERN.h" #define PERL_IN_SV_C #include "perl.h" +#include "regcomp.h" #define FCALL *f #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv) @@ -8339,14 +8340,99 @@ ptr_table_* functions. #define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch) - -/* duplicate a regexp */ +/* Duplicate a regexp. Required reading: pregcomp() and pregfree() in + regcomp.c. AMS 20010712 */ REGEXP * -Perl_re_dup(pTHX_ REGEXP *r) +Perl_re_dup(pTHX_ REGEXP *r, clone_params *param) { - /* XXX fix when pmop->op_pmregexp becomes shared */ - return ReREFCNT_inc(r); + REGEXP *ret; + int i, len, npar; + struct reg_substr_datum *s; + + if (!r) + return (REGEXP *)NULL; + + if ((ret = (REGEXP *)ptr_table_fetch(PL_ptr_table, r))) + return ret; + + len = r->offsets[0]; + npar = r->nparens+1; + + Newc(0, ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp); + Copy(r->program, ret->program, len+1, regnode); + + New(0, ret->startp, npar, I32); + Copy(r->startp, ret->startp, npar, I32); + New(0, ret->endp, npar, I32); + Copy(r->startp, ret->startp, npar, I32); + + if (r->regstclass) { + New(0, ret->regstclass, 1, regnode); + ret->regstclass->flags = r->regstclass->flags; + } + else + ret->regstclass = NULL; + + New(0, ret->substrs, 1, struct reg_substr_data); + for (s = ret->substrs->data, i = 0; i < 3; i++, s++) { + s->min_offset = r->substrs->data[i].min_offset; + s->max_offset = r->substrs->data[i].max_offset; + s->substr = sv_dup_inc(r->substrs->data[i].substr, param); + } + + if (r->data) { + struct reg_data *d; + int count = r->data->count; + + Newc(0, d, sizeof(struct reg_data) + count*sizeof(void *), + char, struct reg_data); + New(0, d->what, count, U8); + + d->count = count; + for (i = 0; i < count; i++) { + d->what[i] = r->data->what[i]; + switch (d->what[i]) { + case 's': + d->data[i] = sv_dup_inc((SV *)r->data->data[i], param); + break; + case 'p': + d->data[i] = av_dup_inc((AV *)r->data->data[i], param); + break; + case 'f': + /* This is cheating. */ + New(0, d->data[i], 1, struct regnode_charclass_class); + StructCopy(r->data->data[i], d->data[i], + struct regnode_charclass_class); + break; + case 'o': + case 'n': + d->data[i] = r->data->data[i]; + break; + } + } + + ret->data = d; + } + else + ret->data = NULL; + + New(0, ret->offsets, 2*len+1, U32); + Copy(r->offsets, ret->offsets, 2*len+1, U32); + + ret->precomp = SAVEPV(r->precomp); + ret->subbeg = SAVEPV(r->subbeg); + ret->sublen = r->sublen; + ret->refcnt = r->refcnt; + ret->minlen = r->minlen; + ret->prelen = r->prelen; + ret->nparens = r->nparens; + ret->lastparen = r->lastparen; + ret->lastcloseparen = r->lastcloseparen; + ret->reganch = r->reganch; + + ptr_table_store(PL_ptr_table, r, ret); + return ret; } /* duplicate a file handle */ @@ -8439,7 +8525,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg, clone_params* param) nmg->mg_type = mg->mg_type; nmg->mg_flags = mg->mg_flags; if (mg->mg_type == PERL_MAGIC_qr) { - nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj); + nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj, param); } else if(mg->mg_type == PERL_MAGIC_backref) { AV *av = (AV*) mg->mg_obj; @@ -9698,18 +9784,17 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_statusvalue_vms = proto_perl->Istatusvalue_vms; #endif - /* Clone the regex array */ - PL_regex_padav = newAV(); - { - I32 len = av_len((AV*)proto_perl->Iregex_padav); - SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav); - for(i = 0; i <= len; i++) { - av_push(PL_regex_padav, - newSViv((IV)re_dup((REGEXP*) SvIV(regexen[i])) )); - } - } - PL_regex_pad = AvARRAY(PL_regex_padav); - + /* Clone the regex array */ + PL_regex_padav = newAV(); + { + I32 len = av_len((AV*)proto_perl->Iregex_padav); + SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav); + for(i = 0; i <= len; i++) { + av_push(PL_regex_padav, + newSViv((IV)re_dup((REGEXP *)SvIV(regexen[i]), param))); + } + } + PL_regex_pad = AvARRAY(PL_regex_padav); /* shortcuts to various I/O objects */ PL_stdingv = gv_dup(proto_perl->Istdingv, param); |