From: Stephen McCamant Date: Sat, 20 Dec 1997 15:16:14 +0000 (-0600) Subject: [win32] this one with adjusted test numbers X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=161b7d1635bc830b9c733355ab423626eadf9ae9;p=p5sagit%2Fp5-mst-13.2.git [win32] this one with adjusted test numbers Message-Id: Subject: [PERL] [PATCH] Fix local $a[0] and local $h{a} p4raw-id: //depot/win32/perl@614 --- diff --git a/embed.h b/embed.h index 4f0a832..caea84b 100644 --- a/embed.h +++ b/embed.h @@ -846,6 +846,7 @@ #define same_dirent Perl_same_dirent #define save_I16 Perl_save_I16 #define save_I32 Perl_save_I32 +#define save_aelem Perl_save_aelem #define save_aptr Perl_save_aptr #define save_ary Perl_save_ary #define save_clearsv Perl_save_clearsv @@ -856,6 +857,7 @@ #define save_freesv Perl_save_freesv #define save_gp Perl_save_gp #define save_hash Perl_save_hash +#define save_helem Perl_save_helem #define save_hptr Perl_save_hptr #define save_int Perl_save_int #define save_item Perl_save_item diff --git a/global.sym b/global.sym index f908d3c..a2edeef 100644 --- a/global.sym +++ b/global.sym @@ -902,6 +902,7 @@ safexrealloc same_dirent save_I16 save_I32 +save_aelem save_aptr save_ary save_clearsv @@ -912,6 +913,7 @@ save_freepv save_freesv save_gp save_hash +save_helem save_hptr save_int save_item diff --git a/pp.c b/pp.c index 4264e9b..ac297ee 100644 --- a/pp.c +++ b/pp.c @@ -2234,7 +2234,7 @@ PP(pp_aslice) if (!svp || *svp == &sv_undef) DIE(no_aelem, elem); if (op->op_private & OPpLVAL_INTRO) - save_svref(svp); + save_aelem(av, elem, svp); } *MARK = svp ? *svp : &sv_undef; } @@ -2376,7 +2376,7 @@ PP(pp_hslice) if (!he || HeVAL(he) == &sv_undef) DIE(no_helem, SvPV(keysv, na)); if (op->op_private & OPpLVAL_INTRO) - save_svref(&HeVAL(he)); + save_helem(hv, keysv, &HeVAL(he)); } *MARK = he ? HeVAL(he) : &sv_undef; } diff --git a/pp_hot.c b/pp_hot.c index 2bb1cb7..4529f8e 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1310,7 +1310,7 @@ PP(pp_helem) if (HvNAME(hv) && isGV(*svp)) save_gp((GV*)*svp, !(op->op_flags & OPf_SPECIAL)); else - save_svref(svp); + save_helem(hv, keysv, svp); } else if (op->op_private & OPpDEREF) vivify_ref(*svp, op->op_private & OPpDEREF); @@ -2261,7 +2261,7 @@ PP(pp_aelem) RETURN; } if (op->op_private & OPpLVAL_INTRO) - save_svref(svp); + save_aelem(av, elem, svp); else if (op->op_private & OPpDEREF) vivify_ref(*svp, op->op_private & OPpDEREF); } diff --git a/scope.c b/scope.c index 8a7d0ce..33569da 100644 --- a/scope.c +++ b/scope.c @@ -434,6 +434,34 @@ save_delete(HV *hv, char *key, I32 klen) void save_list(register SV **sarg, I32 maxsarg) +save_aelem(av,idx,sptr) +AV *av; +I32 idx; +SV **sptr; +{ + SSCHECK(4); + SSPUSHPTR(av); + SSPUSHINT(idx); + SSPUSHPTR(*sptr); + SSPUSHINT(SAVEt_AELEM); + save_scalar_at(sptr); +} + +void +save_helem(hv,key,sptr) +HV *hv; +SV *key; +SV **sptr; +{ + SSCHECK(4); + SSPUSHPTR(hv); + SSPUSHPTR(key); + SSPUSHPTR(*sptr); + SSPUSHINT(SAVEt_HELEM); + save_scalar_at(sptr); +} + +void { dTHR; register SV *sv; @@ -478,6 +506,7 @@ leave_scope(I32 base) register AV *av; register HV *hv; register void* ptr; + I32 i; if (base < -1) croak("panic: corrupt saved stack index"); @@ -689,17 +718,26 @@ leave_scope(I32 base) (*SSPOPDPTR)(ptr); break; case SAVEt_REGCONTEXT: - { - I32 delta = SSPOPINT; - savestack_ix -= delta; /* regexp must have croaked */ - } + i = SSPOPINT; + savestack_ix -= i; /* regexp must have croaked */ break; case SAVEt_STACK_POS: /* Position on Perl stack */ - { - I32 delta = SSPOPINT; - stack_sp = stack_base + delta; - } + i = SSPOPINT; + stack_sp = stack_base + i; break; + case SAVEt_AELEM: /* array element */ + value = (SV*)SSPOPPTR; + i = SSPOPINT; + av = (AV*)SSPOPPTR; + ptr = av_fetch(av,i,1); + goto restore_sv; + case SAVEt_HELEM: /* hash element */ + value = (SV*)SSPOPPTR; + sv = (SV*)SSPOPINT; + hv = (HV*)SSPOPPTR; + ptr = hv_fetch_ent(hv, sv, 1, 0); + ptr = &HeVAL((HE*)ptr); + goto restore_sv; case SAVEt_OP: op = (OP*)SSPOPPTR; break; diff --git a/scope.h b/scope.h index 3c38a1f..580a730 100644 --- a/scope.h +++ b/scope.h @@ -22,6 +22,8 @@ #define SAVEt_REGCONTEXT 21 #define SAVEt_STACK_POS 22 #define SAVEt_I16 23 +#define SAVEt_AELEM 24 +#define SAVEt_HELEM 25 #define SAVEt_OP 24 #define SSCHECK(need) if (savestack_ix + need > savestack_max) savestack_grow() diff --git a/t/op/local.t b/t/op/local.t index a034539..1a8daac 100755 --- a/t/op/local.t +++ b/t/op/local.t @@ -2,7 +2,7 @@ # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $ -print "1..25\n"; +print "1..36\n"; sub foo { local($a, $b) = @_; @@ -54,6 +54,7 @@ eval 'local(%$e)'; print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n"; # check for scope leakage + $a = 'outer'; if (1) { local $a = 'inner' } print +($a eq 'outer') ? "" : "not ", "ok 24\n"; @@ -68,3 +69,37 @@ eval { } }; print $m == 5 ? "" : "not ", "ok 25\n"; + +# Array and hash elements + +@a = ('a', 'b', 'c'); +{ + local($a[1]) = 'foo'; + local($a[2]) = $a[2]; + print +($a[1] eq 'foo') ? "" : "not ", "ok 26\n"; + print +($a[2] eq 'c') ? "" : "not ", "ok 27\n"; + undef @a; +} +print +($a[1] eq 'b') ? "" : "not ", "ok 28\n"; +print +($a[2] eq 'c') ? "" : "not ", "ok 29\n"; +print +(!defined $a[0]) ? "" : "not ", "ok 30\n"; + +@a = ('a', 'b', 'c'); +{ + local($a[1]) = "X"; + shift @a; +} +print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 31\n"; + +%h = ('a' => 1, 'b' => 2, 'c' => 3); +{ + local($h{'a'}) = 'foo'; + local($h{'b'}) = $h{'b'}; + print +($h{'a'} eq 'foo') ? "" : "not ", "ok 32\n"; + print +($h{'b'} == 2) ? "" : "not ", "ok 33\n"; + local($h{'c'}); + delete $h{'c'}; +} +print +($h{'a'} == 1) ? "" : "not ", "ok 34\n"; +print +($h{'b'} == 2) ? "" : "not ", "ok 35\n"; +print +($h{'c'} == 3) ? "" : "not ", "ok 36\n";