[win32] Support case-tolerant %ENV

 - underlying system calls see the case-as-supplied by user
 - added tests to verify addition/deletion/enumeration case-tolerance
 - hv.c touched, but changes are fully conditional on -DENV_IS_CASELESS,
   which is default on win32 now

p4raw-id: //depot/win32/perl@393

diff --git a/hv.c b/hv.c
index 079e952..21792bd 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -84,6 +84,7 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
     register XPVHV* xhv;
     register U32 hash;
     register HE *entry;
+    char *origkey = key;
     SV *sv;
 
     if (!hv)
@@ -97,6 +98,12 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
            Sv = sv;
            return &Sv;
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           sv = sv_2mortal(newSVpv(key,klen));
+           key = strupr(SvPVX(sv));
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -130,13 +137,13 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
       if ((gotenv = ENV_getenv(key)) != Nullch) {
         sv = newSVpv(gotenv,strlen(gotenv));
         SvTAINTED_on(sv);
-        return hv_store(hv,key,klen,sv,hash);
+        return hv_store(hv,origkey,klen,sv,hash);
       }
     }
 #endif
     if (lval) {                /* gonna assign to this, so it better be there */
        sv = NEWSV(61,0);
-       return hv_store(hv,key,klen,sv,hash);
+       return hv_store(hv,origkey,klen,sv,hash);
     }
     return 0;
 }
@@ -150,25 +157,36 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     register char *key;
     STRLEN klen;
     register HE *entry;
+    SV *origkeysv = keysv;
     SV *sv;
 
     if (!hv)
        return 0;
 
-    if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
-       static HE mh;
+    if (SvRMAGICAL(hv)) {
+       if (mg_find((SV*)hv,'P')) {
+           static HE mh;
 
-       sv = sv_newmortal();
-       keysv = sv_2mortal(newSVsv(keysv));
-       mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-       if (!HeKEY_hek(&mh)) {
-           char *k;
-           New(54, k, HEK_BASESIZE + sizeof(SV*), char);
-           HeKEY_hek(&mh) = (HEK*)k;
+           sv = sv_newmortal();
+           keysv = sv_2mortal(newSVsv(keysv));
+           mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
+           if (!HeKEY_hek(&mh)) {
+               char *k;
+               New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+               HeKEY_hek(&mh) = (HEK*)k;
+           }
+           HeSVKEY_set(&mh, keysv);
+           HeVAL(&mh) = sv;
+           return &mh;
+       }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           key = SvPV(keysv, klen);
+           keysv = sv_2mortal(newSVpv(key,klen));
+           (void)strupr(SvPVX(keysv));
+           hash = 0;
        }
-       HeSVKEY_set(&mh, keysv);
-       HeVAL(&mh) = sv;
-       return &mh;
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -205,13 +223,13 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
       if ((gotenv = ENV_getenv(key)) != Nullch) {
         sv = newSVpv(gotenv,strlen(gotenv));
         SvTAINTED_on(sv);
-        return hv_store_ent(hv,keysv,sv,hash);
+        return hv_store_ent(hv,origkeysv,sv,hash);
       }
     }
 #endif
     if (lval) {                /* gonna assign to this, so it better be there */
        sv = NEWSV(61,0);
-       return hv_store_ent(hv,keysv,sv,hash);
+       return hv_store_ent(hv,origkeysv,sv,hash);
     }
     return 0;
 }
@@ -256,6 +274,13 @@ hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
            mg_copy((SV*)hv, val, key, klen);
            if (!xhv->xhv_array && !needs_store)
                return 0;
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               SV *sv = sv_2mortal(newSVpv(key,klen));
+               key = strupr(SvPVX(sv));
+               hash = 0;
+           }
+#endif
        }
     }
     if (!hash)
@@ -326,11 +351,19 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
            TAINT_IF(save_taint);
            if (!xhv->xhv_array && !needs_store)
                return Nullhe;
-       }
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               key = SvPV(keysv, klen);
+               keysv = sv_2mortal(newSVpv(key,klen));
+               (void)strupr(SvPVX(keysv));
+               hash = 0;
+           }
+#endif
+       }
     }
 
     key = SvPV(keysv, klen);
-    
+
     if (!hash)
        PERL_HASH(hash, key, klen);
 
@@ -389,10 +422,16 @@ hv_delete(HV *hv, char *key, U32 klen, I32 flags)
        if (mg_find(sv, 's')) {
            return Nullsv;              /* %SIG elements cannot be deleted */
        }
-       if (mg_find(sv, 'p')) {
+       else if (mg_find(sv, 'p')) {
            sv_unmagic(sv, 'p');        /* No longer an element */
            return sv;
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           sv = sv_2mortal(newSVpv(key,klen));
+           key = strupr(SvPVX(sv));
+       }
+#endif
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array)
@@ -448,6 +487,14 @@ hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
            sv_unmagic(sv, 'p');        /* No longer an element */
            return sv;
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           key = SvPV(keysv, klen);
+           keysv = sv_2mortal(newSVpv(key,klen));
+           (void)strupr(SvPVX(keysv));
+           hash = 0; 
+       }
+#endif
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array)
@@ -504,6 +551,12 @@ hv_exists(HV *hv, char *key, U32 klen)
            magic_existspack(sv, mg_find(sv, 'p'));
            return SvTRUE(sv);
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           sv = sv_2mortal(newSVpv(key,klen));
+           key = strupr(SvPVX(sv));
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -547,6 +600,14 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
            magic_existspack(sv, mg_find(sv, 'p'));
            return SvTRUE(sv);
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           key = SvPV(keysv, klen);
+           keysv = sv_2mortal(newSVpv(key,klen));
+           (void)strupr(SvPVX(keysv));
+           hash = 0; 
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);

diff --git a/t/op/magic.t b/t/op/magic.t
index 80361ba..ace49b5 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -24,7 +24,7 @@ $Is_VMS     = $^O eq 'VMS';
 $Is_Dos   = $^O eq 'dos';
 $PERL = ($Is_MSWin32 ? '.\perl' : './perl');
 
-print "1..30\n";
+print "1..34\n";
 
 eval '$ENV{"FOO"} = "hi there";';      # check that ENV is inited inside eval
 if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
@@ -37,8 +37,8 @@ ok 2, $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
 if ($Is_MSWin32 || $Is_Dos) {
-    ok 3,1;
-    ok 4,1;
+    ok "3 # skipped",1;
+    ok "4 # skipped",1;
 }
 else {
   # the next tests are embedded inside system simply because sh spits out
@@ -165,8 +165,8 @@ ok 27, $^O;
 ok 28, $^T > 850000000, $^T;
 
 if ($Is_VMS || $Is_Dos) {
-       ok 29, 1;
-       ok 30, 1;
+       ok "29 # skipped", 1;
+       ok "30 # skipped", 1;
 }
 else {
        $PATH = $ENV{PATH};
@@ -182,3 +182,20 @@ else {
                                                : (`echo \$NoNeSuCh` eq "foo\n") );
 }
 
+# test case-insignificance of %ENV (these tests must be enabled only
+# when perl is compiled with -DENV_IS_CASELESS)
+if ($Is_MSWin32) {
+    %ENV = ();
+    $ENV{'Foo'} = 'bar';
+    $ENV{'fOo'} = 'baz';
+    ok 31, (scalar(keys(%ENV)) == 1);
+    ok 32, exists($ENV{'FOo'});
+    ok 33, (delete($ENV{'foO'}) eq 'baz');
+    ok 34, (scalar(keys(%ENV)) == 0);
+}
+else {
+    ok "31 # skipped",1;
+    ok "32 # skipped",1;
+    ok "33 # skipped",1;
+    ok "34 # skipped",1;
+}

diff --git a/win32/win32.h b/win32/win32.h
index 0edaad9..5a7c89b 100644 (file)
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -91,6 +91,8 @@ struct tms {
 #define USE_FIXED_OSFHANDLE
 #endif
 
+#define ENV_IS_CASELESS
+
 #ifndef VER_PLATFORM_WIN32_WINDOWS     /* VC-2.0 headers dont have this */
 #define VER_PLATFORM_WIN32_WINDOWS     1
 #endif