#define SVp_IOK 0x00001000 /* has valid non-public integer value */
#define SVp_NOK 0x00002000 /* has valid non-public numeric value */
#define SVp_POK 0x00004000 /* has valid non-public pointer value */
-#define SVp_SCREAM 0x00008000 /* has been studied? */
+#define SVp_SCREAM 0x00008000 /* method name is DOES */
#define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */
#define SVpgv_GP SVp_SCREAM /* GV has a valid GP */
#define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant
subroutine in another package. Set the
- CvIMPORTED_CV_ON() if it needs to be
+ GvIMPORTED_CV_on() if it needs to be
expanded to a real GV */
/* 0x00010000 *** FREE SLOT */
#define SVs_PADTMP 0x00020000 /* in use as tmp; only if ! SVs_PADMY */
#define SVs_SMG 0x00400000 /* has magical set method */
#define SVs_RMG 0x00800000 /* has random magical methods */
-#define SVf_FAKE 0x01000000 /* 0: glob or lexical is just a copy
+#define SVf_FAKE 0x01000000 /* 0: glob is just a copy
1: SV head arena wasn't malloc()ed
2: in conjunction with SVf_READONLY
marks a shared hash key scalar
-#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE)
+#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG)
#define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP)
SVf_POK, SVp_POK also set:
0x00004400 Normal
- 0x0000C400 Studied (SvSCREAM)
+ 0x0000C400 method name for DOES (SvSCREAM)
0x40004400 FBM compiled (SvVALID)
0x4000C400 pad name.
union _xmgu {
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
+ STRLEN xmg_hash_index; /* used while freeing hash entries */
};
struct xpv {
SV* xlv_targ;
char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re
* y=alem/helem/iter t=tie T=tied HE */
+ char xlv_flags; /* 1 = negative offset 2 = negative len */
};
/* This structure works in 3 ways - regular scalar, GV with GP, or fast
union _xnvu xnv_u;
};
-/* This structure must match XPVCV in cv.h */
-
typedef U16 cv_flags_t;
#define _XPVCV_COMMON \
* sub */ \
cv_flags_t xcv_flags
+/* This structure must match XPVCV in cv.h */
+
struct xpvfm {
_XPV_HEAD;
_XPVCV_COMMON;
=for apidoc Am|IV|SvIVX|SV* sv
Returns the raw value in the SV's IV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvIV()>.
+Only use when you are sure SvIOK is true. See also C<SvIV()>.
=for apidoc Am|UV|SvUVX|SV* sv
Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
=for apidoc Am|NV|SvNVX|SV* sv
Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
=for apidoc Am|char*|SvPVX|SV* sv
Returns a pointer to the physical string in the SV. The SV must contain a
string.
+This is also used to store the name of an autoloaded subroutine in an XS
+AUTOLOAD routine. See L<perlguts/Autoloading with XSUBs>.
+
=for apidoc Am|STRLEN|SvCUR|SV* sv
Returns the length of the string which is in the SV. See C<SvLEN>.
attributable to C<SvOOK>. See C<SvCUR>.
=for apidoc Am|char*|SvEND|SV* sv
-Returns a pointer to the last character in the string which is in the SV.
+Returns a pointer to the spot just after the last character in
+the string which is in the SV, where there is usually a trailing
+null (even though Perl scalars do not strictly require it).
See C<SvCUR>. Access the character as *(SvEND(sv)).
+Warning: If C<SvCUR> is equal to C<SvLEN>, then C<SvEND> points to
+unallocated memory.
+
=for apidoc Am|HV*|SvSTASH|SV* sv
Returns the stash of the SV.
/*
=for apidoc Am|U32|SvUTF8|SV* sv
-Returns a U32 value indicating whether the SV contains UTF-8 encoded data.
+Returns a U32 value indicating the UTF-8 status of an SV. If things are set-up
+properly, this indicates whether or not the SV contains UTF-8 encoded data.
Call this after SvPV() in case any call to string overloading updates the
internal flag.
Do not use frivolously.
=for apidoc Am|void|SvUTF8_off|SV *sv
-Unsets the UTF-8 status of an SV.
+Unsets the UTF-8 status of an SV (the data is not changed, just the flag).
+Do not use frivolously.
=for apidoc Am|void|SvPOK_only_UTF8|SV* sv
Tells an SV that it is a string and disables all other OK bits,
? mg_find(sv,PERL_MAGIC_vstring) : NULL)
#define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK)
-#define SvOOK_on(sv) ((void)SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK)
+#define SvOOK_on(sv) (SvFLAGS(sv) |= SVf_OOK)
#define SvOOK_off(sv) ((void)(SvOOK(sv) && sv_backoff(sv)))
#define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE)
#define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG)
#define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG)
-#define SvAMAGIC(sv) (SvROK(sv) && (SvFLAGS(SvRV(sv)) & SVf_AMAGIC))
+#define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \
+ HvAMAGIC(SvSTASH(SvRV(sv))))
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define SvAMAGIC_on(sv) ({ SV * const kloink = sv; \
assert(SvROK(kloink)); \
- SvFLAGS(SvRV(kloink)) |= SVf_AMAGIC; \
+ if (SvOBJECT(SvRV(kloink))) \
+ HvAMAGIC_on(SvSTASH(SvRV(kloink))); \
})
# define SvAMAGIC_off(sv) ({ SV * const kloink = sv; \
- if(SvROK(kloink)) \
- SvFLAGS(SvRV(kloink)) &= ~SVf_AMAGIC;\
+ if(SvROK(kloink) \
+ && SvOBJECT(SvRV(kloink))) \
+ HvAMAGIC_off(SvSTASH(SvRV(kloink))); \
})
#else
-# define SvAMAGIC_on(sv) (SvFLAGS(SvRV(sv)) |= SVf_AMAGIC)
+# define SvAMAGIC_on(sv) \
+ SvOBJECT(SvRV(sv)) && (SvFLAGS(SvSTASH(SvRV(sv))) |= SVf_AMAGIC)
# define SvAMAGIC_off(sv) \
- (SvROK(sv) && (SvFLAGS(SvRV(sv)) &= ~SVf_AMAGIC))
+ (SvROK(sv) && SvOBJECT(SvRV(sv)) \
+ && (SvFLAGS(SvSTASH(SvRV(sv))) &= ~SVf_AMAGIC))
#endif
+/* To be used on the stashes themselves: */
+#define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC)
+#define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC)
+#define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC)
+
+
+#define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK)
+#define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK)
+#define SvUOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV))
+#define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK)
+#define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG))
+
+#define SvPOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+#define SvIOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK)
+#define SvUOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV))
+#define SvNOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK)
+#define SvNIOK_nogthink(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG)))
+
+#define SvPOK_utf8_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8))
+#define SvPOK_utf8_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8))
+
+#define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK)
+#define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+
+#define SvPOK_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+#define SvPOK_utf8_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8))
+#define SvPOK_byte_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+
/*
=for apidoc Am|U32|SvGAMAGIC|SV* sv
-Returns true if the SV has get magic or overloading. If either is true then
+Returns true if the SV has get magic or
+overloading. If either is true then
the scalar is active data, and has the potential to return a new value every
-time it is accessed. Hence you must be careful to only read it once per user
-logical operation and work with that returned value. If neither is true then
+time it is accessed. Hence you must be careful to
+only read it once per user logical operation and work
+with that returned value. If neither is true then
the scalar's value cannot change unless written to.
=cut
#define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv))
-#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash, FALSE))
+#define Gv_AMG(stash) \
+ (HvNAME(stash) && Gv_AMupdate(stash,FALSE) \
+ ? 1 \
+ : (HvAMAGIC_off(stash), 0))
#define SvWEAKREF(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \
== (SVf_ROK|SVprv_WEAKREF))
#define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED))
#define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED))
+/*
+=for apidoc m|U32|SvTHINKFIRST|SV *sv
+
+A quick flag check to see whether an sv should be passed to sv_force_normal
+to be "downgraded" before SvIVX or SvPVX can be modified directly.
+
+For example, if your scalar is a reference and you want to modify the SvIVX
+slot, you can't just do SvROK_off, as that will leak the referent.
+
+This is used internally by various sv-modifying functions, such as
+sv_setsv, sv_setiv and sv_pvn_force.
+
+One case that this does not handle is a gv without SvFAKE set. After
+
+ if (SvTHINKFIRST(gv)) sv_force_normal(gv);
+
+it will still be a gv.
+
+SvTHINKFIRST sometimes produces false positives. In those cases
+sv_force_normal does nothing.
+
+=cut
+*/
+
#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST)
#define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY)
STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \
(void) SvIV(sv); } STMT_END
#define SvIV_please_nomg(sv) \
- STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \
- (void) SvIV_nomg(sv); } STMT_END
+ (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv)) \
+ ? (SvIV_nomg(sv), SvIOK(sv)) \
+ : SvIOK(sv))
#define SvIV_set(sv, val) \
STMT_START { \
assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \
} STMT_END
#endif
-/* SvPOKp not SvPOK in the assertion because the string can be tainted! eg
- perl -T -e '/$^X/'
-*/
-
#ifndef PERL_CORE
# define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0)
#endif
#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ
#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff
#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen
+#define LvFLAGS(sv) ((XPVLV*) SvANY(sv))->xlv_flags
#define IoIFP(sv) (sv)->sv_u.svu_fp
#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp
/*
=for apidoc Am|bool|SvTAINTED|SV* sv
-Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if
+Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if
not.
=for apidoc Am|void|SvTAINTED_on|SV* sv
Marks an SV as tainted if tainting is enabled.
=for apidoc Am|void|SvTAINTED_off|SV* sv
-Untaints an SV. Be I<very> careful with this routine, as it short-circuits
-some of Perl's fundamental security features. XS module authors should not
+Untaints an SV. Be I<very> careful with this routine, as it short-circuits
+some of Perl's fundamental security features. XS module authors should not
use this function unless they fully understand all the implications of
unconditionally untainting the value. Untainting should be done in the
standard perl fashion, via a carefully crafted regexp, rather than directly
untainting variables.
=for apidoc Am|void|SvTAINT|SV* sv
-Taints an SV if tainting is enabled.
+Taints an SV if tainting is enabled, and if some input to the current
+expression is tainted--usually a variable, but possibly also implicit
+inputs such as locale settings. C<SvTAINT> propagates that taintedness to
+the outputs of an expression in a pessimistic fashion; i.e., without paying
+attention to precisely which outputs are influenced by which inputs.
=cut
*/
/*
=for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len
-Like C<SvPV> but will force the SV into containing just a string
-(C<SvPOK_only>). You want force if you are going to update the C<SvPVX>
-directly.
+Like C<SvPV> but will force the SV into containing a string (C<SvPOK>), and
+only a (C<SvPOK_only>), by hook or by crook. You want force if you are
+going to update the C<SvPVX> directly. Processes get magic.
=for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len
-Like C<SvPV> but will force the SV into containing just a string
-(C<SvPOK_only>). You want force if you are going to update the C<SvPVX>
-directly. Doesn't process magic.
+Like C<SvPV> but will force the SV into containing a string (C<SvPOK>), and
+only a (C<SvPOK_only>), by hook or by crook. You want force if you are
+going to update the C<SvPVX> directly. Doesn't process get magic.
=for apidoc Am|char*|SvPV|SV* sv|STRLEN len
Returns a pointer to the string in the SV, or a stringified form of
the SV if the SV does not contain a string. The SV may cache the
-stringified version becoming C<SvPOK>. Handles 'get' magic. See also
+stringified version becoming C<SvPOK>. Handles 'get' magic. See also
C<SvPVx> for a version which guarantees to evaluate sv only once.
=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
A version of C<SvPV> which guarantees to evaluate C<sv> only once.
Only use this if C<sv> is an expression with side effects, otherwise use the
-more efficient C<SvPVX>.
+more efficient C<SvPV>.
=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
Like C<SvPV> but doesn't process magic.
Like C<SvPV_nolen> but doesn't process magic.
=for apidoc Am|IV|SvIV|SV* sv
-Coerces the given SV to an integer and returns it. See C<SvIVx> for a
+Coerces the given SV to an integer and returns it. See C<SvIVx> for a
version which guarantees to evaluate sv only once.
=for apidoc Am|IV|SvIV_nomg|SV* sv
Like C<SvIV> but doesn't process magic.
=for apidoc Am|IV|SvIVx|SV* sv
-Coerces the given SV to an integer and returns it. Guarantees to evaluate
-C<sv> only once. Only use this if C<sv> is an expression with side effects,
+Coerces the given SV to an integer and returns it.
+Guarantees to evaluate C<sv> only once. Only use
+this if C<sv> is an expression with side effects,
otherwise use the more efficient C<SvIV>.
=for apidoc Am|NV|SvNV|SV* sv
-Coerce the given SV to a double and return it. See C<SvNVx> for a version
+Coerce the given SV to a double and return it. See C<SvNVx> for a version
which guarantees to evaluate sv only once.
=for apidoc Am|NV|SvNV_nomg|SV* sv
Like C<SvNV> but doesn't process magic.
=for apidoc Am|NV|SvNVx|SV* sv
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-C<sv> only once. Only use this if C<sv> is an expression with side effects,
+Coerces the given SV to a double and returns it.
+Guarantees to evaluate C<sv> only once. Only use
+this if C<sv> is an expression with side effects,
otherwise use the more efficient C<SvNV>.
=for apidoc Am|UV|SvUV|SV* sv
Like C<SvUV> but doesn't process magic.
=for apidoc Am|UV|SvUVx|SV* sv
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-C<sv> only once. Only use this if C<sv> is an expression with side effects,
+Coerces the given SV to an unsigned integer and
+returns it. Guarantees to C<sv> only once. Only
+use this if C<sv> is an expression with side effects,
otherwise use the more efficient C<SvUV>.
=for apidoc Am|bool|SvTRUE|SV* sv
otherwise.
=for apidoc Am|bool|SvIsCOW|SV* sv
-Returns a boolean indicating whether the SV is Copy-On-Write. (either shared
+Returns a boolean indicating whether the SV is Copy-On-Write (either shared
hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for
-COW)
+COW).
=for apidoc Am|bool|SvIsCOW_shared_hash|SV* sv
Returns a boolean indicating whether the SV is Copy-On-Write shared hash key
=for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|NN SV *sv
-Like sv_utf8_upgrade, but doesn't do magic on C<sv>
+Like sv_utf8_upgrade, but doesn't do magic on C<sv>.
=cut
*/
/* Let us hope that bitmaps for UV and IV are the same */
-#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv))
-#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
-#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
+#define SvIV(sv) (SvIOK_nog(sv) ? SvIVX(sv) : sv_2iv(sv))
+#define SvUV(sv) (SvUOK_nog(sv) ? SvUVX(sv) : sv_2uv(sv))
+#define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv))
#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
/* ----*/
-#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
-#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
+#define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
#define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
#define SvPV_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
#define SvPV_flags_const(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
(const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
#define SvPV_flags_const_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? SvPVX_const(sv) : \
(const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN))
#define SvPV_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#define SvPV_force_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
+ (SvPOK_pure_nogthink(sv) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
+
#define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))
+ (SvPOK_pure_nogthink(sv) \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))
+
#define SvPV_force_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
+ (SvPOK_pure_nogthink(sv) \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
: sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))
#define SvPV_nomg_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? SvPVX(sv) : sv_2pv_flags(sv, 0, 0))
#define SvPV_nolen_const(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ (SvPOK_nog(sv) \
? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))
#define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
/* ----*/
#define SvPVutf8(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \
+ (SvPOK_utf8_nog(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
#define SvPVutf8_force(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
+ (SvPOK_utf8_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
-
#define SvPVutf8_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\
+ (SvPOK_utf8_nog(sv) \
? SvPVX(sv) : sv_2pvutf8(sv, 0))
/* ----*/
#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ (SvPOK_byte_nog(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
#define SvPVbyte_force(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \
+ (SvPOK_byte_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
#define SvPVbyte_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\
+ (SvPOK_byte_nog(sv) \
? SvPVX(sv) : sv_2pvbyte(sv, 0))
-
/* define FOOx(): idempotent versions of FOO(). If possible, use a local
* var to evaluate the arg once; failing that, use a global if possible;
#define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp)
#define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp)
+#define SvTRUE(sv) ((sv) && (SvGMAGICAL(sv) ? sv_2bool(sv) : SvTRUE_common(sv, sv_2bool_nomg(sv))))
+#define SvTRUE_nomg(sv) ((sv) && ( SvTRUE_common(sv, sv_2bool_nomg(sv))))
+#define SvTRUE_common(sv,fallback) ( \
+ !SvOK(sv) \
+ ? 0 \
+ : (SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK)) \
+ ? ( (SvPOK(sv) && SvPVXtrue(sv)) \
+ || (SvIOK(sv) && SvIVX(sv) != 0) \
+ || (SvNOK(sv) && SvNVX(sv) != 0.0)) \
+ : (fallback))
+
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); })
# define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); })
# define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); })
# define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); })
-# define SvTRUE(sv) ( \
- !sv \
- ? 0 \
- : SvPOK(sv) \
- ? (({XPV *nxpv = (XPV*)SvANY(sv); \
- nxpv && \
- (nxpv->xpv_cur > 1 || \
- (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \
- ? 1 \
- : 0) \
- : \
- SvIOK(sv) \
- ? SvIVX(sv) != 0 \
- : SvNOK(sv) \
- ? SvNVX(sv) != 0.0 \
- : sv_2bool(sv) )
-# define SvTRUE_nomg(sv) ( \
- !sv \
- ? 0 \
- : SvPOK(sv) \
- ? (({XPV *nxpv = (XPV*)SvANY(sv); \
- nxpv && \
- (nxpv->xpv_cur > 1 || \
- (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \
- ? 1 \
- : 0) \
- : \
- SvIOK(sv) \
- ? SvIVX(sv) != 0 \
- : SvNOK(sv) \
- ? SvNVX(sv) != 0.0 \
- : sv_2bool_flags(sv,0) )
-# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); })
+# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); })
+# define SvTRUEx_nomg(sv) ({SV *_sv = (sv); SvTRUE_nomg(_sv); })
+# define SvPVXtrue(sv) \
+ ({XPV *nxpv; \
+ (nxpv = (XPV*)SvANY(sv)) \
+ && (nxpv->xpv_cur > 1 \
+ || (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0'));})
#else /* __GNUC__ */
# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp))
# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp))
# define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv))
-# define SvTRUE(sv) ( \
- !sv \
- ? 0 \
- : SvPOK(sv) \
- ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \
- (PL_Xpv->xpv_cur > 1 || \
- (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \
- ? 1 \
- : 0) \
- : \
- SvIOK(sv) \
- ? SvIVX(sv) != 0 \
- : SvNOK(sv) \
- ? SvNVX(sv) != 0.0 \
- : sv_2bool(sv) )
-# define SvTRUE_nomg(sv) ( \
- !sv \
- ? 0 \
- : SvPOK(sv) \
- ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \
- (PL_Xpv->xpv_cur > 1 || \
- (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \
- ? 1 \
- : 0) \
- : \
- SvIOK(sv) \
- ? SvIVX(sv) != 0 \
- : SvNOK(sv) \
- ? SvNVX(sv) != 0.0 \
- : sv_2bool_flags(sv,0) )
-# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
+# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
+# define SvTRUEx_nomg(sv) ((PL_Sv = (sv)), SvTRUE_nomg(PL_Sv))
+# define SvPVXtrue(sv) \
+ ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) \
+ && (PL_Xpv->xpv_cur > 1 \
+ || (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')))
#endif /* __GNU__ */
#define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
- (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv))
+ (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv) \
+ && SvTYPE(sv) != SVt_REGEXP)
#define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0)
#define SvSHARED_HEK_FROM_PV(pvx) \
#else
# define SvRELEASE_IVX(sv) 0
/* This little game brought to you by the need to shut this warning up:
-mg.c: In function `Perl_magic_get':
+mg.c: In function 'Perl_magic_get':
mg.c:1024: warning: left-hand operand of comma expression has no effect
*/
# define SvRELEASE_IVX_(sv) /**/
#define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0)
#define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC)
#define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC)
-#define sv_catpvn_mg(sv, sstr, slen) \
- sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC);
+#define sv_catpvn_mg(sv, sstr, slen) sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC);
+#define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC)
+#define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0)
#define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC)
#define sv_2pv_nolen(sv) sv_2pv(sv, 0)
#define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0)
#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
#define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC)
#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
+#define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0)
#define sv_insert(bigstr, offset, len, little, littlelen) \
Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \
(littlelen), SV_GMAGIC)
/* Should be named SvCatPVN_utf8_upgrade? */
-#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
+#define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \
STMT_START { \
if (!(nsv)) \
nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \
sv_setpvn(nsv, sstr, slen); \
SvUTF8_off(nsv); \
sv_utf8_upgrade(nsv); \
- sv_catsv(dsv, nsv); \
+ sv_catsv_nomg(dsv, nsv); \
} STMT_END
/*
=head1 Magical Functions
=for apidoc Am|void|SvGETMAGIC|SV* sv
-Invokes C<mg_get> on an SV if it has 'get' magic. This macro evaluates its
+Invokes C<mg_get> on an SV if it has 'get' magic. For example, this
+will call C<FETCH> on a tied variable. This macro evaluates its
argument more than once.
=for apidoc Am|void|SvSETMAGIC|SV* sv
-Invokes C<mg_set> on an SV if it has 'set' magic. This macro evaluates its
+Invokes C<mg_set> on an SV if it has 'set' magic. This is necessary
+after modifying a scalar, in case it is a magical variable like C<$|>
+or a tied variable (it calls C<STORE>). This macro evaluates its
argument more than once.
=for apidoc Am|void|SvSetSV|SV* dsb|SV* ssv
=for apidoc Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv
Calls a non-destructive version of C<sv_setsv> if dsv is not the same as
-ssv. May evaluate arguments more than once.
+ssv. May evaluate arguments more than once.
=for apidoc Am|void|SvSetMagicSV|SV* dsb|SV* ssv
Like C<SvSetSV>, but does any set magic required afterwards.
#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_placeholder)
+/*
+=for apidoc Am|SV *|boolSV|bool b
+
+Returns a true SV if C<b> is a true value, or a false SV if C<b> is 0.
+
+See also C<PL_sv_yes> and C<PL_sv_no>.
+
+=cut
+*/
+
#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#define isGV(sv) (SvTYPE(sv) == SVt_PVGV)
Reads into I<len> the offset from SvPVX back to the true start of the
allocated buffer, which will be non-zero if C<sv_chop> has been used to
-efficiently remove characters from start of the buffer. Implemented as a
+efficiently remove characters from start of the buffer. Implemented as a
macro, which takes the address of I<len>, which must be of type C<STRLEN>.
-Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false.
+Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false.
=cut
*/
# define SvOOK_offset(sv, offset) STMT_START { \
assert(sizeof(offset) == sizeof(STRLEN)); \
if (SvOOK(sv)) { \
- const U8 *crash = (U8*)SvPVX_const(sv); \
- offset = *--crash; \
- if (!offset) { \
- crash -= sizeof(STRLEN); \
- Copy(crash, (U8 *)&offset, sizeof(STRLEN), U8); \
+ const U8 *_crash = (U8*)SvPVX_const(sv); \
+ (offset) = *--_crash; \
+ if (!(offset)) { \
+ _crash -= sizeof(STRLEN); \
+ Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \
} \
{ \
/* Validate the preceding buffer's sentinels to \
verify that no-one is using it. */ \
- const U8 *const bonk = (U8 *) SvPVX_const(sv) - offset; \
- while (crash > bonk) { \
- --crash; \
- assert (*crash == (U8)PTR2UV(crash)); \
+ const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset);\
+ while (_crash > _bonk) { \
+ --_crash; \
+ assert (*_crash == (U8)PTR2UV(_crash)); \
} \
} \
} else { \
- offset = 0; \
+ (offset) = 0; \
} \
} STMT_END
#else
# define SvOOK_offset(sv, offset) STMT_START { \
assert(sizeof(offset) == sizeof(STRLEN)); \
if (SvOOK(sv)) { \
- offset = ((U8*)SvPVX_const(sv))[-1]; \
- if (!offset) { \
+ (offset) = ((U8*)SvPVX_const(sv))[-1]; \
+ if (!(offset)) { \
Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \
- (U8 *)&offset, sizeof(STRLEN), U8); \
+ (U8*)&(offset), sizeof(STRLEN), U8); \
} \
} else { \
- offset = 0; \
+ (offset) = 0; \
} \
} STMT_END
#endif
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff