Search for extensions in cpan/ as well as ext/

[perl5.git] / pp.h

diff --git a/pp.h b/pp.h
index 8345af4..f3da1a7 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -1,7 +1,7 @@
 /*    pp.h
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000,
- *    2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+ *    2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -471,6 +471,36 @@ Does not use C<TARG>.  See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
 #define tryAMAGICunDEREF_var(meth_enum) \
        tryAMAGICunW_var(meth_enum,setAGAIN,0,(void)0)
 
+#define tryAMAGICftest(chr)                            \
+    STMT_START {                                       \
+       assert(chr != '?');                             \
+       if (SvAMAGIC(TOPs)) {                           \
+           const char tmpchr = (chr);                  \
+           SV * const tmpsv = amagic_call(TOPs,        \
+               newSVpvn_flags(&tmpchr, 1, SVs_TEMP),   \
+               ftest_amg, AMGf_unary);                 \
+                                                       \
+           if (tmpsv) {                                \
+               const OP *next = PL_op->op_next;        \
+                                                       \
+               SPAGAIN;                                \
+                                                       \
+               if (next->op_type >= OP_FTRREAD &&      \
+                   next->op_type <= OP_FTBINARY &&     \
+                   next->op_private & OPpFT_STACKED    \
+               ) {                                     \
+                   if (SvTRUE(tmpsv))                  \
+                       /* leave the object alone */    \
+                       RETURN;                         \
+               }                                       \
+                                                       \
+               SETs(tmpsv);                            \
+               RETURN;                                 \
+           }                                           \
+       }                                               \
+    } STMT_END
+
+
 #define opASSIGN (PL_op->op_flags & OPf_STACKED)
 #define SETsv(sv)      STMT_START {                                    \
                if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY))            \
@@ -500,6 +530,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