This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "PATCH: (perl #132227 CVE-2018-6797] heap-buffer-overflow"
[perl5.git] / sv.h
diff --git a/sv.h b/sv.h
index b7690c2..1c72242 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1649,7 +1649,7 @@ Like C<sv_setsv> but doesn't process magic.
 =for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv
 Like C<sv_catsv> but doesn't process magic.
 
-=for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|NN SV *sv
+=for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|SV *sv
 
 Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 
@@ -1768,13 +1768,17 @@ Like C<sv_utf8_upgrade>, but doesn't do magic on C<sv>.
 #define SvTRUE_nomg_NN(sv) (SvTRUE_common(sv, sv_2bool_nomg(sv)))
 
 #define SvTRUE_common(sv,fallback) (                   \
-      !SvOK(sv)                                                \
+      SvIMMORTAL_INTERP(sv)                             \
+        ? SvIMMORTAL_TRUE(sv)                           \
+    : !SvOK(sv)                                                \
        ? 0                                             \
     : SvPOK(sv)                                                \
        ? SvPVXtrue(sv)                                 \
-    : (SvFLAGS(sv) & (SVf_IOK|SVf_NOK))                        \
-       ? (   (SvIOK(sv) && SvIVX(sv) != 0)             \
-          || (SvNOK(sv) && SvNVX(sv) != 0.0))          \
+    : SvIOK(sv)                                                \
+        ? (SvIVX(sv) != 0 /* cast to bool */)           \
+    : (SvROK(sv) && !(   SvOBJECT(SvRV(sv))             \
+                      && HvAMAGIC(SvSTASH(SvRV(sv)))))  \
+        ? TRUE                                          \
     : (fallback))
 
 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
@@ -2090,7 +2094,20 @@ properly null terminated. Equivalent to sv_setpvs(""), but more efficient.
 #define SvPEEK(sv) ""
 #endif
 
-#define SvIMMORTAL(sv) (SvREADONLY(sv) && ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_zero || (sv)==&PL_sv_placeholder))
+/* Is this a per-interpreter immortal SV (rather than global)?
+ * These should either occupy adjacent entries in the interpreter struct
+ * (MULTIPLICITY) or adjacent elements of PL_sv_immortals[] otherwise.
+ * The unsigned (Size_t) cast avoids the need for a second < 0 condition.
+ */
+#define SvIMMORTAL_INTERP(sv) ((Size_t)((sv) - &PL_sv_yes) < 4)
+
+/* Does this immortal have a true value? Currently only PL_sv_yes does. */
+#define SvIMMORTAL_TRUE(sv)   ((sv) == &PL_sv_yes)
+
+/* the SvREADONLY() test is to quickly reject most SVs */
+#define SvIMMORTAL(sv) \
+                (  SvREADONLY(sv) \
+                && (SvIMMORTAL_INTERP(sv) || (sv) == &PL_sv_placeholder))
 
 #ifdef DEBUGGING
    /* exercise the immortal resurrection code in sv_free2() */
@@ -2129,6 +2146,10 @@ See also C<L</PL_sv_yes>> and C<L</PL_sv_no>>.
        assert (!SvIOKp(sv));                                          \
        (SvFLAGS(sv) &= ~SVpgv_GP);                                    \
     } STMT_END
+#ifdef PERL_CORE
+# define isGV_or_RVCV(kadawp) \
+    (isGV(kadawp) || (SvROK(kadawp) && SvTYPE(SvRV(kadawp)) == SVt_PVCV))
+#endif
 #define isREGEXP(sv) \
     (SvTYPE(sv) == SVt_REGEXP                                \
      || (SvFLAGS(sv) & (SVTYPEMASK|SVpgv_GP|SVf_FAKE))        \
@@ -2159,7 +2180,7 @@ struct clone_params {
 };
 
 /*
-=for apidoc Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8
+=for apidoc Am|SV*|newSVpvn_utf8|const char* s|STRLEN len|U32 utf8
 
 Creates a new SV and copies a string (which may contain C<NUL> (C<\0>)
 characters) into it.  If C<utf8> is true, calls
@@ -2181,7 +2202,7 @@ Creates a new SV containing the pad name.
 #define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE)
 
 /*
-=for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len
+=for apidoc Am|void|SvOOK_offset|SV*sv|STRLEN len
 
 Reads into C<len> the offset from C<SvPVX> back to the true start of the
 allocated buffer, which will be non-zero if C<sv_chop> has been used to