summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVincent Pit <perl@profvince.com>2008-12-28 11:16:54 +0100
committerVincent Pit <perl@profvince.com>2008-12-28 15:46:41 +0100
commitd30e492cced9a7022652176a253f8f900679d9b0 (patch)
tree0a033351bd5ea72f0b3c4461ca73690fa18da76c
parent3f0c5693d0a2100faf1b56983c7325096fcb0bda (diff)
downloadperl-d30e492cced9a7022652176a253f8f900679d9b0.tar.gz
Introduce SvCANEXISTDELETE in pp.h, which simplify the logic in pp_helem and pp_hslice
-rw-r--r--pp.c25
-rw-r--r--pp.h9
-rw-r--r--pp_hot.c23
3 files changed, 29 insertions, 28 deletions
diff --git a/pp.c b/pp.c
index 0fbc6e48e8..bdbe010f3e 100644
--- a/pp.c
+++ b/pp.c
@@ -4143,31 +4143,28 @@ PP(pp_hslice)
register HV * const hv = MUTABLE_HV(POPs);
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
- bool other_magic = FALSE;
+ bool can_preserve = FALSE;
if (localizing) {
MAGIC *mg;
HV *stash;
- other_magic = mg_find((const SV *)hv, PERL_MAGIC_env) ||
- ((mg = mg_find((const SV *)hv, PERL_MAGIC_tied))
- /* Try to preserve the existenceness of a tied hash
- * element by using EXISTS and DELETE if possible.
- * Fallback to FETCH and STORE otherwise */
- && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(hv), mg))))
- && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
- && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+ if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+ can_preserve = TRUE;
}
while (++MARK <= SP) {
SV * const keysv = *MARK;
SV **svp;
HE *he;
- bool preeminent = FALSE;
-
- if (localizing) {
- preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
- hv_exists_ent(hv, keysv, 0);
+ bool preeminent = TRUE;
+
+ if (localizing && can_preserve) {
+ /* If we can determine whether the element exist,
+ * try to preserve the existenceness of a tied hash
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ preeminent = hv_exists_ent(hv, keysv, 0);
}
he = hv_fetch_ent(hv, keysv, lval, 0);
diff --git a/pp.h b/pp.h
index 6f0f258278..118c027201 100644
--- a/pp.h
+++ b/pp.h
@@ -500,6 +500,15 @@ True if this op will be the return value of an lvalue subroutine
=cut */
#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())
+#define SvCANEXISTDELETE(sv) \
+ (!SvRMAGICAL(sv) \
+ || ((mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \
+ && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \
+ && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \
+ && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \
+ ) \
+ )
+
/*
* Local variables:
* c-indentation-style: bsd
diff --git a/pp_hot.c b/pp_hot.c
index f0c56cf9f5..88fe83814e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1783,7 +1783,7 @@ PP(pp_helem)
const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
- I32 preeminent = 0;
+ bool preeminent = TRUE;
if (SvTYPE(hv) != SVt_PVHV)
RETPUSHUNDEF;
@@ -1791,20 +1791,15 @@ PP(pp_helem)
if (PL_op->op_private & OPpLVAL_INTRO) {
MAGIC *mg;
HV *stash;
- /* does the element we're localizing already exist? */
- preeminent = /* can we determine whether it exists? */
- ( !SvRMAGICAL(hv)
- || mg_find((const SV *)hv, PERL_MAGIC_env)
- || ( (mg = mg_find((const SV *)hv, PERL_MAGIC_tied))
- /* Try to preserve the existenceness of a tied hash
- * element by using EXISTS and DELETE if possible.
- * Fallback to FETCH and STORE otherwise */
- && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(hv), mg))))
- && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
- && gv_fetchmethod_autoload(stash, "DELETE", TRUE)
- )
- ) ? hv_exists_ent(hv, keysv, 0) : 1;
+
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied hash
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+ preeminent = hv_exists_ent(hv, keysv, 0);
}
+
he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
svp = he ? &HeVAL(he) : NULL;
if (lval) {