hv_fetchs() support
Andy Lester [Fri, 6 Jan 2006 09:57:19 +0000 (03:57 -0600)]
Message-ID: <20060106155719.GB9035@petdance.com>

p4raw-id: //depot/perl@26676

doop.c
handy.h
hv.c
malloc.c
op.c
pp_sys.c
taint.c

diff --git a/doop.c b/doop.c
index 7fbc23b..1d81ca0 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -313,7 +313,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)
 
     SV* const  rv = (SV*)cSVOP->op_sv;
     HV* const  hv = (HV*)SvRV(rv);
-    SV* const * svp = hv_fetch(hv, "NONE", 4, FALSE);
+    SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
     const UV extra = none + 1;
     UV final = 0;
@@ -337,7 +337,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)
     send = s + len;
     start = s;
 
-    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    svp = hv_fetchs(hv, "FINAL", FALSE);
     if (svp)
        final = SvUV(*svp);
 
@@ -411,7 +411,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)
 
     SV* const rv = (SV*)cSVOP->op_sv;
     HV* const hv = (HV*)SvRV(rv);
-    SV* const * const svp = hv_fetch(hv, "NONE", 4, FALSE);
+    SV* const * const svp = hv_fetchs(hv, "NONE", FALSE);
     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
     const UV extra = none + 1;
     U8 hibit = 0;
@@ -455,7 +455,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv)
     const I32 grows    = PL_op->op_private & OPpTRANS_GROWS;
     SV * const rv = (SV*)cSVOP->op_sv;
     HV * const hv = (HV*)SvRV(rv);
-    SV * const *svp = hv_fetch(hv, "NONE", 4, FALSE);
+    SV * const *svp = hv_fetchs(hv, "NONE", FALSE);
     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
     const UV extra = none + 1;
     UV final = 0;
@@ -481,7 +481,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv)
     send = s + len;
     start = s;
 
-    svp = hv_fetch(hv, "FINAL", 5, FALSE);
+    svp = hv_fetchs(hv, "FINAL", FALSE);
     if (svp) {
        final = SvUV(*svp);
        havefinal = TRUE;
diff --git a/handy.h b/handy.h
index cb5de19..3c3e443 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -250,6 +250,7 @@ typedef U64TYPE U64;
 #define sv_catpvs(sv, str) Perl_sv_catpvn_flags(aTHX_ sv, STR_WITH_LEN(str), SV_GMAGIC)
 #define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str))
 #define gv_stashpvs(str, create) Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create)
+#define hv_fetchs(hv,key,lval) Perl_hv_fetch(aTHX_ hv, STR_WITH_LEN(key), lval)
 
 /*
 =head1 Miscellaneous Functions
diff --git a/hv.c b/hv.c
index 8a2449a..69bbdcf 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -433,7 +433,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     int masked_flags;
 
     if (!hv)
-       return 0;
+       return NULL;
 
     if (keysv) {
        if (flags & HVhek_FREEKEY)
index a331550..63f6630 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1156,11 +1156,11 @@ perl_get_emergency_buffer(IV *size)
     dTHX;
     /* First offense, give a possibility to recover by dieing. */
     /* No malloc involved here: */
-    GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0);
     SV *sv;
     char *pv;
+    GV **gvp = (GV**)hv_fetchs(PL_defstash, "^M", FALSE);
 
-    if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
+    if (!gvp) gvp = (GV**)hv_fetchs(PL_defstash, "\015", FALSE);
     if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) 
         || (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD))
         return NULL;           /* Now die die die... */
diff --git a/op.c b/op.c
index baf207f..20c0831 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1577,8 +1577,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 
     if (for_my) {
        /* Don't force the C<use> if we don't need it. */
-       SV * const * const svp = hv_fetch(GvHVn(PL_incgv), ATTRSMODULE_PM,
-                      sizeof(ATTRSMODULE_PM)-1, 0);
+       SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
        if (svp && *svp != &PL_sv_undef)
            ;           /* already in %INC */
        else
@@ -3243,7 +3242,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
     if (!force_builtin) {
        gv = gv_fetchpv("do", 0, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
-           GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "do", 2, FALSE);
+           GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "do", FALSE);
            gv = gvp ? *gvp : Nullgv;
        }
     }
@@ -5350,7 +5349,7 @@ Perl_ck_exit(pTHX_ OP *o)
 #ifdef VMS
     HV * const table = GvHV(PL_hintgv);
     if (table) {
-       SV * const * const svp = hv_fetch(table, "vmsish_exit", 11, FALSE);
+       SV * const * const svp = hv_fetchs(table, "vmsish_exit", FALSE);
        if (svp && *svp && SvTRUE(*svp))
            o->op_private |= OPpEXIT_VMSISH;
     }
@@ -5707,7 +5706,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                     || kid->op_type == OP_HELEM)
                            {
                                 OP *op = ((BINOP*)kid)->op_first;
-                                name = 0;
+                                name = NULL;
                                 if (op) {
                                      SV *tmpstr = Nullsv;
                                      const char * const a =
@@ -6105,10 +6104,11 @@ Perl_ck_method(pTHX_ OP *o)
     OP * const kid = cUNOPo->op_first;
     if (kid->op_type == OP_CONST) {
        SV* sv = kSVOP->op_sv;
-       if (!(strchr(SvPVX_const(sv), ':') || strchr(SvPVX_const(sv), '\''))) {
+       const char * const method = SvPVX_const(sv);
+       if (!(strchr(method, ':') || strchr(method, '\''))) {
            OP *cmop;
            if (!SvREADONLY(sv) || !SvFAKE(sv)) {
-               sv = newSVpvn_share(SvPVX_const(sv), SvCUR(sv), 0);
+               sv = newSVpvn_share(method, SvCUR(sv), 0);
            }
            else {
                kSVOP->op_sv = Nullsv;
@@ -6133,7 +6133,7 @@ Perl_ck_open(pTHX_ OP *o)
     dVAR;
     HV * const table = GvHV(PL_hintgv);
     if (table) {
-       SV **svp = hv_fetch(table, "open_IN", 7, FALSE);
+       SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
            const I32 mode = mode_from_discipline(*svp);
            if (mode & O_BINARY)
@@ -6142,7 +6142,7 @@ Perl_ck_open(pTHX_ OP *o)
                o->op_private |= OPpOPEN_IN_CRLF;
        }
 
-       svp = hv_fetch(table, "open_OUT", 8, FALSE);
+       svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
            const I32 mode = mode_from_discipline(*svp);
            if (mode & O_BINARY)
@@ -6229,7 +6229,7 @@ Perl_ck_require(pTHX_ OP *o)
        /* handle override, if any */
        gv = gv_fetchpv("require", 0, SVt_PVCV);
        if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
-           GV * const * const gvp = (GV**)hv_fetch(PL_globalstash, "require", 7, FALSE);
+           GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "require", FALSE);
            gv = gvp ? *gvp : Nullgv;
        }
     }
@@ -6306,11 +6306,11 @@ Perl_ck_sort(pTHX_ OP *o)
 
     if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0)
     {
-       HV *hinthv = GvHV(PL_hintgv);
+       HV * const hinthv = GvHV(PL_hintgv);
        if (hinthv) {
-           SV **svp = hv_fetch(hinthv, "sort", 4, 0);
+           SV ** const svp = hv_fetchs(hinthv, "sort", FALSE);
            if (svp) {
-               I32 sorthints = (I32)SvIV(*svp);
+               const I32 sorthints = (I32)SvIV(*svp);
                if ((sorthints & HINT_SORT_QUICKSORT) != 0)
                    o->op_private |= OPpSORT_QSORT;
                if ((sorthints & HINT_SORT_STABLE) != 0)
@@ -7097,7 +7097,7 @@ Perl_peep(pTHX_ register OP *o)
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
            if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
-           fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+           fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
                break;
            key = SvPV_const(*svp, keylen);
@@ -7146,7 +7146,7 @@ Perl_peep(pTHX_ register OP *o)
            lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE);
            if (!(SvFLAGS(lexname) & SVpad_TYPED))
                break;
-           fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
+           fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
                break;
            /* Again guessing that the pushmark can be jumped over.... */
index c37c213..e1c6125 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3331,10 +3331,10 @@ PP(pp_chdir)
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
-        if (    (svp = hv_fetch(table, "HOME", 4, FALSE))
-             || (svp = hv_fetch(table, "LOGDIR", 6, FALSE))
+        if (    (svp = hv_fetchs(table, "HOME", FALSE))
+             || (svp = hv_fetchs(table, "LOGDIR", FALSE))
 #ifdef VMS
-             || (svp = hv_fetch(table, "SYS$LOGIN", 9, FALSE))
+             || (svp = hv_fetchs(table, "SYS$LOGIN", FALSE))
 #endif
            )
         {
diff --git a/taint.c b/taint.c
index efe5dc4..bf42ddf 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -130,7 +130,7 @@ Perl_taint_env(pTHX)
   }
 #endif /* VMS */
 
-    svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
+    svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE);
     if (svp && *svp) {
        if (SvTAINTED(*svp)) {
            TAINT;
@@ -144,7 +144,7 @@ Perl_taint_env(pTHX)
 
 #ifndef VMS
     /* tainted $TERM is okay if it contains no metachars */
-    svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
+    svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE);
     if (svp && *svp && SvTAINTED(*svp)) {
        STRLEN len;
        const bool was_tainted = PL_tainted;