diff options
| -rw-r--r-- | hv.c | 99 | ||||
| -rwxr-xr-x | t/op/magic.t | 27 | ||||
| -rw-r--r-- | win32/win32.h | 2 |
3 files changed, 104 insertions, 24 deletions
@@ -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 80361ba0b7..ace49b546d 100755 --- 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 0edaad9d52..5a7c89bf97 100644 --- 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 |