[win32] this one with adjusted test numbers

	Message-Id: <m0xjWFq-000EZeC@alias-2.pr.mcs.net>
	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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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";