SV *e = TOPs; /* e is for 'expression' */
SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */
+ /* First of all, handle overload magic of the rightmost argument */
if (SvAMAGIC(e)) {
SV * const tmpsv = amagic_call(d, e, smart_amg, 0);
if (tmpsv) {
to check that one is a subset of the other. */
(void) hv_iterinit(hv);
while ( (he = hv_iternext(hv)) ) {
- I32 key_len;
- char * const key = hv_iterkey(he, &key_len);
+ SV *key = hv_iterkeysv(he);
++ this_key_count;
- if(!hv_exists(other_hv, key, key_len)) {
+ if(!hv_exists_ent(other_hv, key, 0)) {
(void) hv_iterinit(hv); /* reset iterator */
RETPUSHNO;
}
for (i = 0; i < other_len; ++i) {
SV ** const svp = av_fetch(other_av, i, FALSE);
- char *key;
- STRLEN key_len;
-
if (svp) { /* ??? When can this not happen? */
- key = SvPV(*svp, key_len);
- if (hv_exists(hv, key, key_len))
+ if (hv_exists_ent(hv, *svp, 0))
RETPUSHYES;
}
}
RETPUSHNO;
}
else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) {
- PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
- HE *he;
- HV *hv = MUTABLE_HV(SvRV(e));
-
- (void) hv_iterinit(hv);
- while ( (he = hv_iternext(hv)) ) {
- if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
- (void) hv_iterinit(hv);
- destroy_matcher(matcher);
- RETPUSHYES;
+ sm_regex_hash:
+ {
+ PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
+ HE *he;
+ HV *hv = MUTABLE_HV(SvRV(e));
+
+ (void) hv_iterinit(hv);
+ while ( (he = hv_iternext(hv)) ) {
+ if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
+ (void) hv_iterinit(hv);
+ destroy_matcher(matcher);
+ RETPUSHYES;
+ }
}
+ destroy_matcher(matcher);
+ RETPUSHNO;
}
- destroy_matcher(matcher);
- RETPUSHNO;
}
else {
sm_any_hash:
for (i = 0; i < other_len; ++i) {
SV ** const svp = av_fetch(other_av, i, FALSE);
- char *key;
- STRLEN key_len;
-
if (svp) { /* ??? When can this not happen? */
- key = SvPV(*svp, key_len);
- if (hv_exists(MUTABLE_HV(SvRV(d)), key, key_len))
+ if (hv_exists_ent(MUTABLE_HV(SvRV(d)), *svp, 0))
RETPUSHYES;
}
}
}
}
else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) {
- PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
- const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
- I32 i;
+ sm_regex_array:
+ {
+ PMOP * const matcher = make_matcher((REGEXP*) SvRV(d));
+ const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
+ I32 i;
- for(i = 0; i <= this_len; ++i) {
- SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
- if (svp && matcher_matches_sv(matcher, *svp)) {
- destroy_matcher(matcher);
- RETPUSHYES;
+ for(i = 0; i <= this_len; ++i) {
+ SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+ if (svp && matcher_matches_sv(matcher, *svp)) {
+ destroy_matcher(matcher);
+ RETPUSHYES;
+ }
}
+ destroy_matcher(matcher);
+ RETPUSHNO;
}
- destroy_matcher(matcher);
- RETPUSHNO;
}
else if (!SvOK(d)) {
/* undef ~~ array */
}
/* ~~ qr// */
else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_REGEXP) {
- PMOP * const matcher = make_matcher((REGEXP*) SvRV(e));
+ if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+ SV *t = d; d = e; e = t;
+ goto sm_regex_hash;
+ }
+ else if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+ SV *t = d; d = e; e = t;
+ goto sm_regex_array;
+ }
+ else {
+ PMOP * const matcher = make_matcher((REGEXP*) SvRV(e));
- PUTBACK;
- PUSHs(matcher_matches_sv(matcher, d)
- ? &PL_sv_yes
- : &PL_sv_no);
- destroy_matcher(matcher);
- RETURN;
+ PUTBACK;
+ PUSHs(matcher_matches_sv(matcher, d)
+ ? &PL_sv_yes
+ : &PL_sv_no);
+ destroy_matcher(matcher);
+ RETURN;
+ }
}
- /* ~~ X..Y TODO */
/* ~~ scalar */
- else if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) {
+ /* See if there is overload magic on left */
+ else if (object_on_left && SvAMAGIC(d)) {
+ SV *tmpsv;
+ PUSHs(d); PUSHs(e);
+ PUTBACK;
+ tmpsv = amagic_call(d, e, smart_amg, AMGf_noright);
+ if (tmpsv) {
+ SPAGAIN;
+ (void)POPs;
+ SETs(tmpsv);
+ RETURN;
+ }
+ SP -= 2;
+ goto sm_any_scalar;
+ }
+ else
+ sm_any_scalar:
+ if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) {
/* numeric comparison */
PUSHs(d); PUSHs(e);
PUTBACK;
PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
if (PERL_FILE_IS_ABSOLUTE(name)
+#ifdef WIN32
+ || (*name == '.' && ((name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))
+ || (name[1] == '\\' ||
+ ( name[1] == '.' && name[2] == '\\')))
+ )
+#else
|| (*name == '.' && (name[1] == '/' ||
(name[1] == '.' && name[2] == '/')))
+#endif
)
{
return TRUE;