summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc6
-rw-r--r--embed.h6
-rw-r--r--inline.h3
-rw-r--r--proto.h21
-rw-r--r--sv.c111
-rw-r--r--sv.h63
6 files changed, 208 insertions, 2 deletions
diff --git a/embed.fnc b/embed.fnc
index 7da9faa0d6..de38a2d21b 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1507,6 +1507,9 @@ ApR |OP* |newSVREF |NN OP* o
ApdR |OP* |newSVOP |I32 type|I32 flags|NN SV* sv
ApdR |OP* |newDEFSVOP
pR |SV* |newSVavdefelem |NN AV *av|SSize_t ix|bool extendible
+ApdR |SV* |newSVbool |const bool bool_val
+ApdR |SV* |newSV_true
+ApdR |SV* |newSV_false
ApdR |SV* |newSViv |const IV i
ApdR |SV* |newSVuv |const UV u
ApdR |SV* |newSVnv |const NV n
@@ -3368,6 +3371,9 @@ iR |bool |is_utf8_common |NN const U8 *const p \
EXiTp |void |append_utf8_from_native_byte|const U8 byte|NN U8** dest
Apd |void |sv_set_undef |NN SV *sv
+Apd |void |sv_set_true |NN SV *sv
+Apd |void |sv_set_false |NN SV *sv
+Apd |void |sv_set_bool |NN SV *sv|const bool bool_val
Apd |void |sv_setsv_flags |NN SV *dsv|NULLOK SV *ssv|const I32 flags
Apd |void |sv_catpvn_flags|NN SV *const dsv|NN const char *sstr|const STRLEN len \
|const I32 flags
diff --git a/embed.h b/embed.h
index c221a8e2d1..f3968fae35 100644
--- a/embed.h
+++ b/embed.h
@@ -387,8 +387,11 @@
#define newSV(a) Perl_newSV(aTHX_ a)
#define newSVOP(a,b,c) Perl_newSVOP(aTHX_ a,b,c)
#define newSVREF(a) Perl_newSVREF(aTHX_ a)
+#define newSV_false() Perl_newSV_false(aTHX)
+#define newSV_true() Perl_newSV_true(aTHX)
#define newSV_type(a) Perl_newSV_type(aTHX_ a)
#define newSV_type_mortal(a) Perl_newSV_type_mortal(aTHX_ a)
+#define newSVbool(a) Perl_newSVbool(aTHX_ a)
#define newSVhek(a) Perl_newSVhek(aTHX_ a)
#define newSViv(a) Perl_newSViv(aTHX_ a)
#define newSVnv(a) Perl_newSVnv(aTHX_ a)
@@ -677,6 +680,9 @@
#define sv_reset(a,b) Perl_sv_reset(aTHX_ a,b)
#define sv_rvunweaken(a) Perl_sv_rvunweaken(aTHX_ a)
#define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a)
+#define sv_set_bool(a,b) Perl_sv_set_bool(aTHX_ a,b)
+#define sv_set_false(a) Perl_sv_set_false(aTHX_ a)
+#define sv_set_true(a) Perl_sv_set_true(aTHX_ a)
#define sv_set_undef(a) Perl_sv_set_undef(aTHX_ a)
#define sv_setiv(a,b) Perl_sv_setiv(aTHX_ a,b)
#define sv_setiv_mg(a,b) Perl_sv_setiv_mg(aTHX_ a,b)
diff --git a/inline.h b/inline.h
index 436f8eb3ac..72fe1d3cd4 100644
--- a/inline.h
+++ b/inline.h
@@ -3475,8 +3475,7 @@ Perl_mortal_getenv(const char * str)
PERL_STATIC_INLINE bool
Perl_sv_isbool(pTHX_ const SV *sv)
{
- return SvIOK(sv) && SvPOK(sv) && SvIsCOW_static(sv) &&
- (SvPVX_const(sv) == PL_Yes || SvPVX_const(sv) == PL_No);
+ return SvBoolFlagsOK(sv) && BOOL_INTERNALS_sv_isbool(sv);
}
#ifdef USE_ITHREADS
diff --git a/proto.h b/proto.h
index 873347ca99..768731833f 100644
--- a/proto.h
+++ b/proto.h
@@ -2482,6 +2482,14 @@ PERL_CALLCONV OP* Perl_newSVREF(pTHX_ OP* o)
#define PERL_ARGS_ASSERT_NEWSVREF \
assert(o)
+PERL_CALLCONV SV* Perl_newSV_false(pTHX)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEWSV_FALSE
+
+PERL_CALLCONV SV* Perl_newSV_true(pTHX)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEWSV_TRUE
+
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE SV* Perl_newSV_type(pTHX_ const svtype type)
__attribute__warn_unused_result__;
@@ -2500,6 +2508,10 @@ PERL_CALLCONV SV* Perl_newSVavdefelem(pTHX_ AV *av, SSize_t ix, bool extendible)
#define PERL_ARGS_ASSERT_NEWSVAVDEFELEM \
assert(av)
+PERL_CALLCONV SV* Perl_newSVbool(pTHX_ const bool bool_val)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEWSVBOOL
+
PERL_CALLCONV SV* Perl_newSVhek(pTHX_ const HEK *const hek)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_NEWSVHEK
@@ -3770,6 +3782,15 @@ PERL_CALLCONV SV* Perl_sv_rvunweaken(pTHX_ SV *const sv);
PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *const sv);
#define PERL_ARGS_ASSERT_SV_RVWEAKEN \
assert(sv)
+PERL_CALLCONV void Perl_sv_set_bool(pTHX_ SV *sv, const bool bool_val);
+#define PERL_ARGS_ASSERT_SV_SET_BOOL \
+ assert(sv)
+PERL_CALLCONV void Perl_sv_set_false(pTHX_ SV *sv);
+#define PERL_ARGS_ASSERT_SV_SET_FALSE \
+ assert(sv)
+PERL_CALLCONV void Perl_sv_set_true(pTHX_ SV *sv);
+#define PERL_ARGS_ASSERT_SV_SET_TRUE \
+ assert(sv)
PERL_CALLCONV void Perl_sv_set_undef(pTHX_ SV *sv);
#define PERL_ARGS_ASSERT_SV_SET_UNDEF \
assert(sv)
diff --git a/sv.c b/sv.c
index 16bba941cb..bff92f610d 100644
--- a/sv.c
+++ b/sv.c
@@ -4682,6 +4682,67 @@ Perl_sv_set_undef(pTHX_ SV *sv)
SvOK_off(sv);
}
+/*
+=for apidoc sv_set_true
+
+Equivalent to C<sv_setsv(sv, &PL_sv_yes)>, but may be made more
+efficient in the future. Doesn't handle set magic.
+
+The perl equivalent is C<$sv = !0;>.
+
+Introduced in perl 5.35.11.
+
+=cut
+*/
+
+void
+Perl_sv_set_true(pTHX_ SV *sv)
+{
+ PERL_ARGS_ASSERT_SV_SET_TRUE;
+ sv_setsv(sv, &PL_sv_yes);
+}
+
+/*
+=for apidoc sv_set_false
+
+Equivalent to C<sv_setsv(sv, &PL_sv_no)>, but may be made more
+efficient in the future. Doesn't handle set magic.
+
+The perl equivalent is C<$sv = !1;>.
+
+Introduced in perl 5.35.11.
+
+=cut
+*/
+
+void
+Perl_sv_set_false(pTHX_ SV *sv)
+{
+ PERL_ARGS_ASSERT_SV_SET_FALSE;
+ sv_setsv(sv, &PL_sv_no);
+}
+
+/*
+=for apidoc sv_set_bool
+
+Equivalent to C<sv_setsv(sv, bool_val ? &Pl_sv_yes : &PL_sv_no)>, but
+may be made more efficient in the future. Doesn't handle set magic.
+
+The perl equivalent is C<$sv = !!$expr;>.
+
+Introduced in perl 5.35.11.
+
+=cut
+*/
+
+void
+Perl_sv_set_bool(pTHX_ SV *sv, const bool bool_val)
+{
+ PERL_ARGS_ASSERT_SV_SET_BOOL;
+ sv_setsv(sv, bool_val ? &PL_sv_yes : &PL_sv_no);
+}
+
+
void
Perl_sv_setsv_mg(pTHX_ SV *const dsv, SV *const ssv)
{
@@ -9777,6 +9838,56 @@ Perl_newSVuv(pTHX_ const UV u)
}
/*
+=for apidoc newSVbool
+
+Creates a new SV boolean.
+
+=cut
+*/
+
+SV *
+Perl_newSVbool(pTHX_ bool bool_val)
+{
+ PERL_ARGS_ASSERT_NEWSVBOOL;
+ SV *sv = newSVsv(bool_val ? &PL_sv_yes : &PL_sv_no);
+
+ return sv;
+}
+
+/*
+=for apidoc newSV_true
+
+Creates a new SV that is a boolean true.
+
+=cut
+*/
+SV *
+Perl_newSV_true(pTHX)
+{
+ PERL_ARGS_ASSERT_NEWSV_TRUE;
+ SV *sv = newSVsv(&PL_sv_yes);
+
+ return sv;
+}
+
+/*
+=for apidoc newSV_false
+
+Creates a new SV that is a boolean false.
+
+=cut
+*/
+
+SV *
+Perl_newSV_false(pTHX)
+{
+ PERL_ARGS_ASSERT_NEWSV_FALSE;
+ SV *sv = newSVsv(&PL_sv_no);
+
+ return sv;
+}
+
+/*
=for apidoc newRV_noinc
Creates an RV wrapper for an SV. The reference count for the original
diff --git a/sv.h b/sv.h
index 7b21e71241..9c0da53b9b 100644
--- a/sv.h
+++ b/sv.h
@@ -746,6 +746,55 @@ Unsets the PV status of an SV.
Tells an SV that it is a string and disables all other C<OK> bits.
Will also turn off the UTF-8 status.
+=for apidoc Am|U32|SvBoolFlagsOK|SV* sv
+Returns a bool indicating whether the SV has the right flags set such
+that it is safe to call C<BOOL_INTERNALS_sv_isbool()> or
+C<BOOL_INTERNALS_sv_isbool_true()> or
+C<BOOL_INTERNALS_sv_isbool_false()>. Currently equivalent to
+C<SvIandPOK(sv)> or C<SvIOK(sv) && SvPOK(sv)>. Serialization may want to
+unroll this check. If so you are strongly recommended to add code like
+C<assert(SvBoolFlagsOK(sv));> B<before> calling using any of the
+BOOL_INTERNALS macros.
+
+=for apidoc Am|U32|SvIandPOK|SV* sv
+Returns a bool indicating whether the SV is both C<SvPOK()> and
+C<SvIOK()> at the same time. Equivalent to C<SvIOK(sv) && SvPOK(sv)> but
+more efficient.
+
+=for apidoc Am|void|SvIandPOK_on|SV* sv
+Tells an SV that is a string and a number in one operation. Equivalent
+to C<SvIOK_on(sv); SvPOK_on(sv);> but more efficient.
+
+=for apidoc Am|void|SvIandPOK_off|SV* sv
+Unsets the PV and IV status of an SV in one operation. Equivalent to
+C<SvIOK_off(sv); SvPK_off(v);> but more efficient.
+
+=for apidoc Am|bool|BOOL_INTERNALS_sv_isbool|SV* sv
+Checks if a C<SvBoolFlagsOK()> sv is a bool. B<Note> that it is the
+caller's responsibility to ensure that the sv is C<SvBoolFlagsOK()> before
+calling this. This is only useful in specialized logic like
+serialization code where performance is critical and the flags have
+already been checked to be correct. Almost always you should be using
+C<sv_isbool(sv)> instead.
+
+=for apidoc Am|bool|BOOL_INTERNALS_sv_isbool_true|SV* sv
+Checks if a C<SvBoolFlagsOK()> sv is a true bool. B<Note> that it is
+the caller's responsibility to ensure that the sv is C<SvBoolFlagsOK()>
+before calling this. This is only useful in specialized logic like
+serialization code where performance is critical and the flags have
+already been checked to be correct. This is B<NOT> what you should use
+to check if an SV is "true", for that you should be using
+C<SvTRUE(sv)> instead.
+
+=for apidoc Am|bool|BOOL_INTERNALS_sv_isbool_false|SV* sv
+Checks if a C<SvBoolFlagsOK()> sv is a false bool. B<Note> that it is
+the caller's responsibility to ensure that the sv is C<SvBoolFlagsOK()>
+before calling this. This is only useful in specialized logic like
+serialization code where performance is critical and the flags have
+already been checked to be correct. This is B<NOT> what you should use
+to check if an SV is "false", for that you should be using
+C<!SvTRUE(sv)> instead.
+
=for apidoc Am|bool|SvVOK|SV* sv
Returns a boolean indicating whether the SV contains a v-string.
@@ -914,6 +963,20 @@ Set the size of the string buffer for the SV. See C<L</SvLEN>>.
#define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \
== SVf_IOK)
+#define SvIandPOK(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_POK)) == (SVf_IOK|SVf_POK))
+#define SvIandPOK_on(sv) (assert_not_glob(sv) \
+ (SvFLAGS(sv) |= (SVf_IOK|SVp_IOK|SVf_POK|SVp_POK)))
+#define SvIandPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_POK|SVp_POK))
+
+#define SvBoolFlagsOK(sv) SvIandPOK(sv)
+
+#define BOOL_INTERNALS_sv_isbool(sv) (SvIsCOW_static(sv) && \
+ (SvPVX_const(sv) == PL_Yes || SvPVX_const(sv) == PL_No))
+#define BOOL_INTERNALS_sv_isbool_true(sv) (SvIsCOW_static(sv) && \
+ (SvPVX_const(sv) == PL_Yes))
+#define BOOL_INTERNALS_sv_isbool_false(sv) (SvIsCOW_static(sv) && \
+ (SvPVX_const(sv) == PL_No))
+
#define SvIsUV(sv) (SvFLAGS(sv) & SVf_IVisUV)
#define SvIsUV_on(sv) (SvFLAGS(sv) |= SVf_IVisUV)
#define SvIsUV_off(sv) (SvFLAGS(sv) &= ~SVf_IVisUV)