Implement distributivity in $scalar ~~ @array

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index a8a3610..46636f7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1251,9 +1251,9 @@ PP(pp_flop)
 
 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" */
@@ -1280,8 +1280,6 @@ S_dopoptolabel(pTHX_ const char *label)
        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));
@@ -3304,17 +3302,6 @@ PP(pp_require)
        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;
@@ -3445,12 +3432,6 @@ PP(pp_require)
                }
                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;
@@ -3462,21 +3443,14 @@ PP(pp_require)
                        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] == ':'))
@@ -3488,7 +3462,7 @@ PP(pp_require)
                        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
@@ -3509,7 +3483,6 @@ PP(pp_require)
                        /* Don't even actually have to turn SvPOK_on() as we
                           access it directly with SvPVX() below.  */
                    }
-#    endif
 #  endif
 #endif
                    TAINT_PROPER("require");
@@ -4027,13 +4000,15 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     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 */
 
@@ -4058,8 +4033,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            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");
 
     /* ~~ sub */
@@ -4285,8 +4259,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                        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;
@@ -4327,28 +4303,19 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            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)) {
+       else {
            const I32 this_len = av_len(MUTABLE_AV(SvRV(e)));
            I32 i;
 
@@ -4356,11 +4323,12 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE);
                if (!svp)
                    continue;
-               
+
                PUSHs(d);
                PUSHs(*svp);
                PUTBACK;
-               (void) pp_seq();
+               /* infinite recursion isn't supposed to happen here */
+               (void) do_smartmatch(NULL, NULL);
                SPAGAIN;
                if (SvTRUEx(POPs))
                    RETPUSHYES;
@@ -4934,12 +4902,8 @@ S_path_is_absolute(const char *name)
     PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
 
     if (PERL_FILE_IS_ABSOLUTE(name)
-#ifdef MACOS_TRADITIONAL
-       || (*name == ':')
-#else
        || (*name == '.' && (name[1] == '/' ||
                             (name[1] == '.' && name[2] == '/')))
-#endif
         )
     {
        return TRUE;