diff options
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | scope.c | 19 | ||||
| -rw-r--r-- | scope.h | 2 | ||||
| -rw-r--r-- | sv.c | 8 | ||||
| -rwxr-xr-x | t/op/fork.t | 22 |
11 files changed, 72 insertions, 1 deletions
@@ -597,6 +597,7 @@ #define save_pptr Perl_save_pptr #define save_vptr Perl_save_vptr #define save_re_context Perl_save_re_context +#define save_padsv Perl_save_padsv #define save_sptr Perl_save_sptr #define save_svref Perl_save_svref #define save_threadsv Perl_save_threadsv @@ -2061,6 +2062,7 @@ #define save_pptr(a) Perl_save_pptr(aTHX_ a) #define save_vptr(a) Perl_save_vptr(aTHX_ a) #define save_re_context() Perl_save_re_context(aTHX) +#define save_padsv(a) Perl_save_padsv(aTHX_ a) #define save_sptr(a) Perl_save_sptr(aTHX_ a) #define save_svref(a) Perl_save_svref(aTHX_ a) #define save_threadsv(a) Perl_save_threadsv(aTHX_ a) @@ -4038,6 +4040,8 @@ #define save_vptr Perl_save_vptr #define Perl_save_re_context CPerlObj::Perl_save_re_context #define save_re_context Perl_save_re_context +#define Perl_save_padsv CPerlObj::Perl_save_padsv +#define save_padsv Perl_save_padsv #define Perl_save_sptr CPerlObj::Perl_save_sptr #define save_sptr Perl_save_sptr #define Perl_save_svref CPerlObj::Perl_save_svref @@ -1933,6 +1933,7 @@ Ap |SV* |save_scalar |GV* gv Ap |void |save_pptr |char** pptr Ap |void |save_vptr |void* pptr Ap |void |save_re_context +Ap |void |save_padsv |PADOFFSET off Ap |void |save_sptr |SV** sptr Ap |SV* |save_svref |SV** sptr Ap |SV** |save_threadsv |PADOFFSET i diff --git a/global.sym b/global.sym index c5e527b9bd..b5c367d651 100644 --- a/global.sym +++ b/global.sym @@ -358,6 +358,7 @@ Perl_save_scalar Perl_save_pptr Perl_save_vptr Perl_save_re_context +Perl_save_padsv Perl_save_sptr Perl_save_svref Perl_save_threadsv @@ -1433,6 +1433,10 @@ #define Perl_save_re_context pPerl->Perl_save_re_context #undef save_re_context #define save_re_context Perl_save_re_context +#undef Perl_save_padsv +#define Perl_save_padsv pPerl->Perl_save_padsv +#undef save_padsv +#define save_padsv Perl_save_padsv #undef Perl_save_sptr #define Perl_save_sptr pPerl->Perl_save_sptr #undef save_sptr @@ -2615,6 +2615,13 @@ Perl_save_re_context(pTHXo) ((CPerlObj*)pPerl)->Perl_save_re_context(); } +#undef Perl_save_padsv +void +Perl_save_padsv(pTHXo_ PADOFFSET off) +{ + ((CPerlObj*)pPerl)->Perl_save_padsv(off); +} + #undef Perl_save_sptr void Perl_save_sptr(pTHXo_ SV** sptr) @@ -1776,9 +1776,11 @@ PP(pp_enteriter) else #endif /* USE_THREADS */ if (PL_op->op_targ) { +#ifndef USE_ITHREADS svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ SAVESPTR(*svp); -#ifdef USE_ITHREADS +#else + SAVEPADSV(PL_op->op_targ); iterdata = (void*)PL_op->op_targ; cxtype |= CXp_PADVAR; #endif @@ -669,6 +669,7 @@ PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv); PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr); PERL_CALLCONV void Perl_save_vptr(pTHX_ void* pptr); PERL_CALLCONV void Perl_save_re_context(pTHX); +PERL_CALLCONV void Perl_save_padsv(pTHX_ PADOFFSET off); PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr); PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr); PERL_CALLCONV SV** Perl_save_threadsv(pTHX_ PADOFFSET i); @@ -470,6 +470,17 @@ Perl_save_sptr(pTHX_ SV **sptr) SSPUSHINT(SAVEt_SPTR); } +void +Perl_save_padsv(pTHX_ PADOFFSET off) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(PL_curpad[off]); + SSPUSHPTR(PL_curpad); + SSPUSHLONG((long)off); + SSPUSHINT(SAVEt_PADSV); +} + SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { @@ -961,6 +972,14 @@ Perl_leave_scope(pTHX_ I32 base) else PL_curpad = Null(SV**); break; + case SAVEt_PADSV: + { + PADOFFSET off = (PADOFFSET)SSPOPLONG; + ptr = SSPOPPTR; + if (ptr) + ((SV**)ptr)[off] = (SV*)SSPOPPTR; + } + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } @@ -33,6 +33,7 @@ #define SAVEt_I8 32 #define SAVEt_COMPPAD 33 #define SAVEt_GENERIC_PVREF 34 +#define SAVEt_PADSV 35 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -101,6 +102,7 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>. #define SAVESPTR(s) save_sptr((SV**)&(s)) #define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s)) #define SAVEVPTR(s) save_vptr((void*)&(s)) +#define SAVEPADSV(s) save_padsv(s) #define SAVEFREESV(s) save_freesv((SV*)(s)) #define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o)) #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) @@ -7656,6 +7656,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) av = (AV*)POPPTR(ss,ix); TOPPTR(nss,ix) = av_dup(av); break; + case SAVEt_PADSV: + longval = (long)POPLONG(ss,ix); + TOPLONG(nss,ix) = longval; + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup(sv); + break; default: Perl_croak(aTHX_ "panic: ss_dup inconsistency"); } diff --git a/t/op/fork.t b/t/op/fork.t index 93cf673228..88b6b4b74c 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -184,6 +184,28 @@ child 3 [1] -2- -3- -1- -2- -3- ######## +$| = 1; +foreach my $c (1,2,3) { + if (fork) { + print "parent $c\n"; + } + else { + print "child $c\n"; + exit; + } +} +while (wait() != -1) { print "waited\n" } +EXPECT +child 1 +child 2 +child 3 +parent 1 +parent 2 +parent 3 +waited +waited +waited +######## use Config; $| = 1; $\ = "\n"; |