static const char * const context_name[] = {
"pseudo-block",
- "when",
+ NULL, /* CXt_WHEN never actually needs "block" */
NULL, /* CXt_BLOCK never actually needs "block" */
- "given",
+ NULL, /* CXt_GIVEN never actually needs "block" */
NULL, /* CXt_LOOP_FOR never actually needs "loop" */
NULL, /* CXt_LOOP_PLAIN never actually needs "loop" */
NULL, /* CXt_LOOP_LAZYSV never actually needs "loop" */
case CXt_FORMAT:
case CXt_EVAL:
case CXt_NULL:
- case CXt_GIVEN:
- case CXt_WHEN:
if (ckWARN(WARN_EXITING))
Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
context_name[CxTYPE(cx)], OP_NAME(PL_op));
tryname = name;
tryrsfp = doopen_pm(name, len);
}
-#ifdef MACOS_TRADITIONAL
- if (!tryrsfp) {
- char newname[256];
-
- MacPerl_CanonDir(name, newname, 1);
- if (path_is_absolute(newname)) {
- tryname = newname;
- tryrsfp = doopen_pm(newname, strlen(newname));
- }
- }
-#endif
if (!tryrsfp) {
AV * const ar = GvAVn(PL_incgv);
I32 i;
}
else {
if (!path_is_absolute(name)
-#ifdef MACOS_TRADITIONAL
- /* We consider paths of the form :a:b ambiguous and interpret them first
- as global then as local
- */
- || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
-#endif
) {
const char *dir;
STRLEN dirlen;
dirlen = 0;
}
-#ifdef MACOS_TRADITIONAL
- char buf1[256];
- char buf2[256];
-
- MacPerl_CanonDir(name, buf2, 1);
- Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
-#else
-# ifdef VMS
+#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, NULL)) == NULL)
continue;
sv_setpv(namesv, unixdir);
sv_catpv(namesv, unixname);
-# else
-# ifdef __SYMBIAN32__
+#else
+# ifdef __SYMBIAN32__
if (PL_origfilename[0] &&
PL_origfilename[1] == ':' &&
!(dir[0] && dir[1] == ':'))
Perl_sv_setpvf(aTHX_ namesv,
"%s\\%s",
dir, name);
-# else
+# else
/* The equivalent of
Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
but without the need to parse the format string, or
/* Don't even actually have to turn SvPOK_on() as we
access it directly with SvPVX() below. */
}
-# endif
# endif
#endif
TAINT_PROPER("require");
dVAR;
dSP;
+ bool object_on_left = FALSE;
SV *e = TOPs; /* e is for 'expression' */
SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */
-# define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
- sv_2mortal(newSViv(PTR2IV(sv))), 0)
-
-# define SM_SEEN_OTHER(sv) hv_exists_ent(seen_other, \
- sv_2mortal(newSViv(PTR2IV(sv))), 0)
-
- tryAMAGICbinSET(smart, 0);
+ if (SvAMAGIC(e)) {
+ SV * const tmpsv = amagic_call(d, e, smart_amg, 0);
+ if (tmpsv) {
+ SPAGAIN;
+ (void)POPs;
+ SETs(tmpsv);
+ RETURN;
+ }
+ }
SP -= 2; /* Pop the values */
RETPUSHYES;
}
- if ((sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
- || (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)))
+ if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP))
Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+ if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+ object_on_left = TRUE;
/* ~~ sub */
if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) {
I32 c;
- if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+ if (object_on_left) {
+ goto sm_any_sub; /* Treat objects like scalars */
+ }
+ else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
/* Test sub truth for each key */
HE *he;
bool andedresults = TRUE;
RETPUSHNO;
}
else {
+ sm_any_sub:
ENTER;
SAVETMPS;
PUSHMARK(SP);
}
/* ~~ %hash */
else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) {
- if (!SvOK(d)) {
+ if (object_on_left) {
+ goto sm_any_hash; /* Treat objects like scalars */
+ }
+ else if (!SvOK(d)) {
RETPUSHNO;
}
else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
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:
if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0))
RETPUSHYES;
else
}
/* ~~ @array */
else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) {
- if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+ if (object_on_left) {
+ goto sm_any_array; /* Treat objects like scalars */
+ }
+ else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
AV * const other_av = MUTABLE_AV(SvRV(e));
const I32 other_len = av_len(other_av) + 1;
I32 i;
if (this_elem || other_elem)
RETPUSHNO;
}
- else if (SM_SEEN_THIS(*this_elem)
- || SM_SEEN_OTHER(*other_elem))
+ else if (hv_exists_ent(seen_this,
+ sv_2mortal(newSViv(PTR2IV(*this_elem))), 0) ||
+ hv_exists_ent(seen_other,
+ sv_2mortal(newSViv(PTR2IV(*other_elem))), 0))
{
if (*this_elem != *other_elem)
RETPUSHNO;
}
}
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;
-
- 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;
+ 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;
+ }
}
+ destroy_matcher(matcher);
+ RETPUSHNO;
}
- destroy_matcher(matcher);
- RETPUSHNO;
}
- else if (SvNIOK(d)) {
+ else if (!SvOK(d)) {
+ /* undef ~~ array */
+ const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
I32 i;
- for(i = 0; i <= AvFILL(MUTABLE_AV(SvRV(e))); ++i) {
+ for (i = 0; i <= this_len; ++i) {
SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
- if (!svp)
- continue;
-
- PUSHs(d);
- PUSHs(*svp);
- PUTBACK;
- if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
- (void) pp_i_eq();
- else
- (void) pp_eq();
- SPAGAIN;
- if (SvTRUEx(POPs))
+ if (!svp || !SvOK(*svp))
RETPUSHYES;
}
RETPUSHNO;
}
- else if (SvPOK(d)) {
- const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
- I32 i;
+ else {
+ sm_any_array:
+ {
+ I32 i;
+ const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
- for(i = 0; i <= this_len; ++i) {
- SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
- if (!svp)
- continue;
-
- PUSHs(d);
- PUSHs(*svp);
- PUTBACK;
- (void) pp_seq();
- SPAGAIN;
- if (SvTRUEx(POPs))
- RETPUSHYES;
+ for (i = 0; i <= this_len; ++i) {
+ SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
+ if (!svp)
+ continue;
+
+ PUSHs(d);
+ PUSHs(*svp);
+ PUTBACK;
+ /* infinite recursion isn't supposed to happen here */
+ (void) do_smartmatch(NULL, NULL);
+ SPAGAIN;
+ if (SvTRUEx(POPs))
+ RETPUSHYES;
+ }
+ RETPUSHNO;
}
- RETPUSHNO;
}
}
/* ~~ 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 */
PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
if (PERL_FILE_IS_ABSOLUTE(name)
-#ifdef MACOS_TRADITIONAL
- || (*name == ':')
+#if WIN32
+ || (*name == '.' && ((name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))
+ || (name[1] == '\\' ||
+ ( name[1] == '.' && name[2] == '\\')))
+ )
#else
|| (*name == '.' && (name[1] == '/' ||
(name[1] == '.' && name[2] == '/')))
projects / p5sagit/p5-mst-13.2.git / blobdiff