sv.c - add new bool related utility functions and macros

The new bool "type" does not have the usual complement of utility
functions and macros. It only has one encapsulating function, which is
perfectly reasonable for most use cases where one wants to test if an
SV* is a bool, but does a bit too much if one is working on a
serialization tool which is likely to want to unroll a nice chunk of the
logic.

The new type also lacks the usual cohort of utility functions to create
new bool SV's.

This patch adds the following functions:

    newSVbool(const bool bool_val)
    newSV_true()
    newSV_false()

    sv_set_true(SV *sv)
    sv_set_false(SV *sv)
    sv_set_bool(SV *sv, const bool bool_val)

And the following macros:

    SvIandPOK(sv)
    SvIandPOK_off(sv)
    SvIandPOK_on(sv)

The following three are intended very specifically for writing
serialization code like for Sereal, where it is reasonable to want to
unroll the logic contained in Perl_sv_isbool() and SvTRUE(). They are
documented as "you dont want to use this except under special
circumstances".

    SvBoolFlagsOK(sv)
    BOOL_INTERNALS_sv_isbool(sv)
    BOOL_INTERNALS_sv_isbool_true(sv)
    BOOL_INTERNALS_sv_isbool_false(sv)

SvBoolFlagsOK() is documented as being the same as SvIandPOK(),
but this abstracts the intent from the implementation.

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)