Add builtin::is_tainted

Also tweak the implementation of the other two boolean builtins (is_bool
& is_weak) to be slightly more efficient.

13 files changed, 116 insertions, 75 deletions

diff --git a/builtin.c b/builtin.c
index 9df6630082..c8b9614528 100644
--- a/builtin.c
+++ b/builtin.c
@@ -125,6 +125,10 @@ XS(XS_builtin_func1_scalar)
             Perl_pp_floor(aTHX);
             break;
 
+        case OP_IS_TAINTED:
+            Perl_pp_is_tainted(aTHX);
+            break;
+
         default:
             Perl_die(aTHX_ "panic: unhandled opcode %" IVdf
                            " for xs_builtin_func1_scalar()", (IV) ix);
@@ -380,16 +384,17 @@ static const struct BuiltinFuncDescriptor builtins[] = {
     { "builtin::false",  &XS_builtin_false,  &ck_builtin_const, BUILTIN_CONST_FALSE },
 
     /* unary functions */
-    { "builtin::is_bool",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_BOOL  },
-    { "builtin::weaken",   &XS_builtin_func1_void,   &ck_builtin_func1, OP_WEAKEN   },
-    { "builtin::unweaken", &XS_builtin_func1_void,   &ck_builtin_func1, OP_UNWEAKEN },
-    { "builtin::is_weak",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_WEAK  },
-    { "builtin::blessed",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED  },
-    { "builtin::refaddr",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR  },
-    { "builtin::reftype",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE  },
-    { "builtin::ceil",     &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL     },
-    { "builtin::floor",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR    },
-    { "builtin::trim",     &XS_builtin_trim, NULL, 0 },
+    { "builtin::is_bool",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_BOOL    },
+    { "builtin::weaken",     &XS_builtin_func1_void,   &ck_builtin_func1, OP_WEAKEN     },
+    { "builtin::unweaken",   &XS_builtin_func1_void,   &ck_builtin_func1, OP_UNWEAKEN   },
+    { "builtin::is_weak",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_WEAK    },
+    { "builtin::blessed",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED    },
+    { "builtin::refaddr",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR    },
+    { "builtin::reftype",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE    },
+    { "builtin::ceil",       &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL       },
+    { "builtin::floor",      &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR      },
+    { "builtin::is_tainted", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_TAINTED },
+    { "builtin::trim",       &XS_builtin_trim, NULL, 0 },
 
     { "builtin::created_as_string", &XS_builtin_created_as_string, &ck_builtin_func1, 0 },
     { "builtin::created_as_number", &XS_builtin_created_as_number, &ck_builtin_func1, 0 },
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 8170416a2a..b709601015 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -1,31 +1,21 @@
-package Opcode;
-
-use 5.006_001;
+package Opcode 1.59;
 
 use strict;
 
-our($VERSION, @ISA, @EXPORT_OK);
-
-$VERSION = "1.58";
-
 use Carp;
 use Exporter 'import';
 use XSLoader;
 
-BEGIN {
-    @EXPORT_OK = qw(
+sub opset (;@);
+sub opset_to_hex ($);
+sub opdump (;$);
+use subs our @EXPORT_OK = qw(
 	opset ops_to_opset
 	opset_to_ops opset_to_hex invert_opset
 	empty_opset full_opset
 	opdesc opcodes opmask define_optag
 	opmask_add verify_opset opdump
-    );
-}
-
-sub opset (;@);
-sub opset_to_hex ($);
-sub opdump (;$);
-use subs @EXPORT_OK;
+);
 
 XSLoader::load();
 
@@ -451,6 +441,8 @@ These are a hotchpotch of opcodes still waiting to be considered
 
     ceil floor
 
+    is_tainted
+
 =item :base_math
 
 These ops are not included in :base_core because of the risk of them being
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 7c2ecf992c..fbd12e73b7 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -7,7 +7,7 @@
 # This is based on the module of the same name by Malcolm Beattie,
 # but essentially none of his code remains.
 
-package B::Deparse;
+package B::Deparse 1.65;
 use strict;
 use Carp;
 use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
@@ -53,7 +53,6 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
-our $VERSION = '1.64';
 our $AUTOLOAD;
 use warnings ();
 require feature;
@@ -6660,15 +6659,16 @@ sub builtin1 {
     return "builtin::$name($arg)";
 }
 
-sub pp_is_bool  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "is_bool"); }
-sub pp_is_weak  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "is_weak"); }
-sub pp_weaken   { builtin1(@_, "weaken"); }
-sub pp_unweaken { builtin1(@_, "unweaken"); }
-sub pp_blessed  { builtin1(@_, "blessed"); }
-sub pp_refaddr  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "refaddr"); }
-sub pp_reftype  { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "reftype"); }
-sub pp_ceil     { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "ceil"); }
-sub pp_floor    { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "floor"); }
+sub pp_is_bool    { builtin1(@_, "is_bool"); }
+sub pp_is_weak    { builtin1(@_, "is_weak"); }
+sub pp_weaken     { builtin1(@_, "weaken"); }
+sub pp_unweaken   { builtin1(@_, "unweaken"); }
+sub pp_blessed    { builtin1(@_, "blessed"); }
+sub pp_refaddr    { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "refaddr"); }
+sub pp_reftype    { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "reftype"); }
+sub pp_ceil       { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "ceil"); }
+sub pp_floor      { $_[0]->maybe_targmy(@_[1,2], \&builtin1, "floor"); }
+sub pp_is_tainted { builtin1(@_, "is_tainted"); }
 
 1;
 __END__
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index e7a76c81fe..535719e966 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -3221,6 +3221,7 @@ $x = builtin::refaddr(undef);
 $x = builtin::reftype(undef);
 $x = builtin::ceil($x);
 $x = builtin::floor($x);
+$x = builtin::is_tainted($x);
 ####
 # boolean true preserved
 my $x = !0;
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index fd86782ad2..f763b297eb 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -149,7 +149,7 @@ $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark re
 $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
 $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
 $bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv);
-$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int is_bool is_weak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
+$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
 $bits{$_}{0} = 'OPpTRANS_CAN_FORCE_UTF8' for qw(trans transr);
 $bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr);
 $bits{$_}{7} = 'OPpTRANS_DELETE' for qw(trans transr);
@@ -404,6 +404,7 @@ $bits{i_preinc}{0} = $bf[0];
 $bits{int}{0} = $bf[0];
 @{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{is_bool}{0} = $bf[0];
+$bits{is_tainted}{0} = $bf[0];
 $bits{is_weak}{0} = $bf[0];
 @{$bits{isa}}{1,0} = ($bf[1], $bf[1]);
 @{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@@ -849,7 +850,7 @@ our %ops_using = (
     OPpSORT_DESCEND          => [qw(sort)],
     OPpSPLIT_ASSIGN          => [qw(split)],
     OPpSUBSTR_REPL_FIRST     => [qw(substr)],
-    OPpTARGET_MY             => [qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int is_bool is_weak kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
+    OPpTARGET_MY             => [qw(abs add atan2 ceil chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock floor getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand refaddr reftype rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
     OPpTRANS_CAN_FORCE_UTF8  => [qw(trans transr)],
     OPpTRUEBOOL              => [qw(blessed grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
     OPpUSEINT                => [qw(bit_and bit_or bit_xor complement left_shift nbit_and nbit_or nbit_xor ncomplement right_shift sbit_and sbit_or sbit_xor)],
diff --git a/lib/builtin.pm b/lib/builtin.pm
index 6995d62cc7..57d5d7b47b 100644
--- a/lib/builtin.pm
+++ b/lib/builtin.pm
@@ -1,4 +1,4 @@
-package builtin 0.007;
+package builtin 0.008;
 
 use strict;
 use warnings;
@@ -24,6 +24,7 @@ builtin - Perl pragma to import built-in utility functions
         ceil floor
         indexed
         trim
+        is_tainted
     );
 
 =head1 DESCRIPTION
@@ -281,8 +282,12 @@ C<trim> is equivalent to:
 For Perl versions where this feature is not available look at the
 L<String::Util> module for a comparable implementation.
 
+=head2 is_tainted
+
+    $bool = is_tainted($var);
+
+Returns true when given a tainted variable.
+
 =head1 SEE ALSO
 
 L<perlop>, L<perlfunc>, L<Scalar::Util>
-
-=cut
diff --git a/lib/builtin.t b/lib/builtin.t
index e601d9ec5b..31a4b30048 100644
--- a/lib/builtin.t
+++ b/lib/builtin.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -T
 
 BEGIN {
     chdir 't' if -d 't';
@@ -6,15 +6,14 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-use strict;
-use warnings;
+use v5.36;
 no warnings 'experimental::builtin';
 
 package FetchStoreCounter {
-    sub new { my $class = shift; return bless [@_], $class }
-    sub TIESCALAR { return shift->new(@_) }
-    sub FETCH { ${shift->[0]}++ }
-    sub STORE { ${shift->[1]}++ }
+    sub TIESCALAR($class, @args) { bless \@args, $class }
+
+    sub FETCH($self)    { $self->[0]->$*++ }
+    sub STORE($self, $) { $self->[1]->$*++ }
 }
 
 # booleans
@@ -47,7 +46,7 @@ package FetchStoreCounter {
     is($fetchcount, 1, 'is_bool() invokes FETCH magic');
 
     $tied = is_bool(false);
-    is($storecount, 1, 'is_bool() TARG invokes STORE magic');
+    is($storecount, 1, 'is_bool() invokes STORE magic');
 }
 
 # weakrefs
@@ -342,6 +341,23 @@ TODO: {
     is(trim($str2), "Hello world!", "Trim on an our \$var");
 }
 
+# is_tainted
+{
+    use builtin qw( is_tainted );
+
+    is(is_tainted($0), !!${^TAINT}, "\$0 is tainted (if tainting is supported)");
+    ok(!is_tainted($1), "\$1 isn't tainted");
+
+    # Invokes magic
+    tie my $tied, FetchStoreCounter => (\my $fetchcount, \my $storecount);
+
+    my $_dummy = is_tainted($tied);
+    is($fetchcount, 1, 'is_tainted() invokes FETCH magic');
+
+    $tied = is_tainted($0);
+    is($storecount, 1, 'is_tainted() invokes STORE magic');
+}
+
 # vim: tabstop=4 shiftwidth=4 expandtab autoindent softtabstop=4
 
 done_testing();
diff --git a/opcode.h b/opcode.h
index 838b2560ce..7e2d07c3c1 100644
--- a/opcode.h
+++ b/opcode.h
@@ -563,6 +563,7 @@ EXTCONST char* const PL_op_name[] = {
 	"reftype",
 	"ceil",
 	"floor",
+	"is_tainted",
         "freed",
 };
 #endif
@@ -985,6 +986,7 @@ EXTCONST char* const PL_op_desc[] = {
 	"reftype",
 	"ceil",
 	"floor",
+	"is_tainted",
         "freed op",
 };
 #endif
@@ -1410,6 +1412,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
 	Perl_pp_reftype,
 	Perl_pp_ceil,
 	Perl_pp_floor,
+	Perl_pp_is_tainted,
 }
 #endif
 ;
@@ -1831,6 +1834,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
 	Perl_ck_null,		/* reftype */
 	Perl_ck_null,		/* ceil */
 	Perl_ck_null,		/* floor */
+	Perl_ck_null,		/* is_tainted */
 }
 #endif
 ;
@@ -2244,8 +2248,8 @@ EXTCONST U32 PL_opargs[] = {
 	0x00000400,	/* poptry */
 	0x00000300,	/* catch */
 	0x00000300,	/* pushdefer */
-	0x0000011e,	/* is_bool */
-	0x0000011e,	/* is_weak */
+	0x00000106,	/* is_bool */
+	0x00000106,	/* is_weak */
 	0x00000100,	/* weaken */
 	0x00000100,	/* unweaken */
 	0x00000106,	/* blessed */
@@ -2253,6 +2257,7 @@ EXTCONST U32 PL_opargs[] = {
 	0x0000011e,	/* reftype */
 	0x0000011e,	/* ceil */
 	0x0000011e,	/* floor */
+	0x00000106,	/* is_tainted */
 };
 #endif
 
@@ -2925,8 +2930,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       -1, /* poptry */
        0, /* catch */
      238, /* pushdefer */
-      75, /* is_bool */
-      75, /* is_weak */
+       0, /* is_bool */
+       0, /* is_weak */
        0, /* weaken */
        0, /* unweaken */
       49, /* blessed */
@@ -2934,6 +2939,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       75, /* reftype */
       75, /* ceil */
       75, /* floor */
+       0, /* is_tainted */
 
 };
 
@@ -2952,7 +2958,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
  */
 
 EXTCONST U16  PL_op_private_bitdefs[] = {
-    0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst, cmpchain_and, cmpchain_dup, entertrycatch, catch, weaken, unweaken */
+    0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst, cmpchain_and, cmpchain_dup, entertrycatch, catch, is_bool, is_weak, weaken, unweaken, is_tainted */
     0x30dc, 0x41d9, /* pushmark */
     0x00bd, /* wantarray, runcv */
     0x0438, 0x1a50, 0x428c, 0x3e28, 0x3605, /* const */
@@ -2973,7 +2979,7 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x117c, 0x22b8, 0x09b4, 0x40ec, 0x2648, 0x4864, 0x07c1, /* trans, transr */
     0x0fbc, 0x04d8, 0x0067, /* sassign */
     0x0c78, 0x0b74, 0x0a70, 0x31cc, 0x05a8, 0x0067, /* aassign */
-    0x4630, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, is_bool, is_weak, refaddr, reftype, ceil, floor */
+    0x4630, 0x0003, /* chomp, schomp, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir, refaddr, reftype, ceil, floor */
     0x05b4, 0x31cc, 0x0003, /* pos */
     0x4630, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */
     0x1538, 0x0067, /* repeat */
@@ -3438,8 +3444,8 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* POPTRY     */ (0),
     /* CATCH      */ (OPpARG1_MASK),
     /* PUSHDEFER  */ (OPpARG1_MASK|OPpDEFER_FINALLY),
-    /* IS_BOOL    */ (OPpARG1_MASK|OPpTARGET_MY),
-    /* IS_WEAK    */ (OPpARG1_MASK|OPpTARGET_MY),
+    /* IS_BOOL    */ (OPpARG1_MASK),
+    /* IS_WEAK    */ (OPpARG1_MASK),
     /* WEAKEN     */ (OPpARG1_MASK),
     /* UNWEAKEN   */ (OPpARG1_MASK),
     /* BLESSED    */ (OPpARG1_MASK|OPpMAYBE_TRUEBOOL|OPpTRUEBOOL),
@@ -3447,6 +3453,7 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* REFTYPE    */ (OPpARG1_MASK|OPpTARGET_MY),
     /* CEIL       */ (OPpARG1_MASK|OPpTARGET_MY),
     /* FLOOR      */ (OPpARG1_MASK|OPpTARGET_MY),
+    /* IS_TAINTED */ (OPpARG1_MASK),
 
 };
 
diff --git a/opnames.h b/opnames.h
index 5bf8f4903f..e269a9703c 100644
--- a/opnames.h
+++ b/opnames.h
@@ -428,10 +428,11 @@ typedef enum opcode {
 	OP_REFTYPE	 = 411,
 	OP_CEIL		 = 412,
 	OP_FLOOR	 = 413,
+	OP_IS_TAINTED	 = 414,
 	OP_max		
 } opcode;
 
-#define MAXO 414
+#define MAXO 415
 #define OP_FREED MAXO
 
 /* the OP_IS_* macros are optimized to a simple range check because
diff --git a/pp.c b/pp.c
index 13eb068e02..ad0c8aded4 100644
--- a/pp.c
+++ b/pp.c
@@ -7249,28 +7249,22 @@ PP(pp_cmpchain_dup)
 
 PP(pp_is_bool)
 {
-    dSP;
-    dTARGET;
-    SV *arg = POPs;
+    SV *arg = *PL_stack_sp;
 
     SvGETMAGIC(arg);
 
-    sv_setbool_mg(TARG, SvIsBOOL(arg));
-    PUSHs(TARG);
-    RETURN;
+    *PL_stack_sp = boolSV(SvIsBOOL(arg));
+    return NORMAL;
 }
 
 PP(pp_is_weak)
 {
-    dSP;
-    dTARGET;
-    SV *arg = POPs;
+    SV *arg = *PL_stack_sp;
 
     SvGETMAGIC(arg);
 
-    sv_setbool_mg(TARG, SvROK(arg) && SvWEAKREF(arg));
-    PUSHs(TARG);
-    RETURN;
+    *PL_stack_sp = boolSV(SvWEAKREF(arg));
+    return NORMAL;
 }
 
 PP(pp_weaken)
@@ -7377,6 +7371,16 @@ PP(pp_floor)
     RETURN;
 }
 
+PP(pp_is_tainted)
+{
+    SV *arg = *PL_stack_sp;
+
+    SvGETMAGIC(arg);
+
+    *PL_stack_sp = boolSV(SvTAINTED(arg));
+    return NORMAL;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/pp_proto.h b/pp_proto.h
index 07f5366864..83516cdf66 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -134,6 +134,7 @@ PERL_CALLCONV OP *Perl_pp_int(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_introcv(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_ioctl(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_is_bool(pTHX) __attribute__visibility__("hidden");
+PERL_CALLCONV OP *Perl_pp_is_tainted(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_is_weak(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_isa(pTHX) __attribute__visibility__("hidden");
 PERL_CALLCONV OP *Perl_pp_iter(pTHX) __attribute__visibility__("hidden");
diff --git a/regen/opcodes b/regen/opcodes
index 7b0316f7ac..3f33f3dcdd 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -584,8 +584,8 @@ poptry		pop try			ck_null		@
 catch		catch {} block		ck_null		|
 pushdefer	push defer {} block	ck_null		|
 
-is_bool		boolean type test	ck_null		fsT1
-is_weak		weakref type test	ck_null		fsT1
+is_bool		boolean type test	ck_null		fs1
+is_weak		weakref type test	ck_null		fs1
 weaken		reference weaken	ck_null		1
 unweaken	reference unweaken	ck_null		1
 blessed		blessed			ck_null		fs1
@@ -593,3 +593,4 @@ refaddr		refaddr			ck_null		fsT1
 reftype		reftype			ck_null		fsT1
 ceil		ceil			ck_null		fsT1
 floor		floor			ck_null		fsT1
+is_tainted	is_tainted		ck_null		fs1
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index ad58203a98..30e0676660 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -712,8 +712,8 @@ test_opcount(0, "builtin::is_bool is replaced with direct opcode",
                 {
                     entersub => 0,
                     is_bool  => 1,
-                    padsv    => 3, # OA_TARGLEX applies so only 3, not 4
-                    sassign  => 0,
+                    padsv    => 4,
+                    sassign  => 1,
                 });
 
 test_opcount(0, "builtin::is_bool gets constant-folded",
@@ -781,4 +781,11 @@ test_opcount(0, "builtin::floor is replaced with direct opcode",
                     floor    => 1,
                 });
 
+test_opcount(0, "builtin::is_tainted is replaced with direct opcode",
+                sub { builtin::is_tainted($0); },
+                {
+                    entersub   => 0,
+                    is_tainted => 1,
+                });
+
 done_testing();