summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc3
-rw-r--r--embed.h2
-rw-r--r--pp_ctl.c10
-rw-r--r--proto.h2
-rw-r--r--t/op/taint.t6
5 files changed, 14 insertions, 9 deletions
diff --git a/embed.fnc b/embed.fnc
index f51124c2ec..d2a08ee60a 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1755,7 +1755,8 @@ sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen
sR |PMOP* |make_matcher |NN REGEXP* re
sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv
s |void |destroy_matcher|NN PMOP* matcher
-s |OP* |do_smartmatch |NULLOK HV* seen_this|NULLOK HV* seen_other
+s |OP* |do_smartmatch |NULLOK HV* seen_this \
+ |NULLOK HV* seen_other|const bool copied
#endif
#if defined(PERL_IN_PP_HOT_C)
diff --git a/embed.h b/embed.h
index 120567fe15..0e99ca5592 100644
--- a/embed.h
+++ b/embed.h
@@ -1404,7 +1404,7 @@
#define adjust_stack_on_leave(a,b,c,d,e) S_adjust_stack_on_leave(aTHX_ a,b,c,d,e)
#define check_type_and_open(a) S_check_type_and_open(aTHX_ a)
#define destroy_matcher(a) S_destroy_matcher(aTHX_ a)
-#define do_smartmatch(a,b) S_do_smartmatch(aTHX_ a,b)
+#define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c)
#define docatch(a) S_docatch(aTHX_ a)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
#define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
diff --git a/pp_ctl.c b/pp_ctl.c
index 2e89b7053c..52b0682d0d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4445,14 +4445,14 @@ S_destroy_matcher(pTHX_ PMOP *matcher)
PP(pp_smartmatch)
{
DEBUG_M(Perl_deb(aTHX_ "Starting smart match resolution\n"));
- return do_smartmatch(NULL, NULL);
+ return do_smartmatch(NULL, NULL, 0);
}
/* This version of do_smartmatch() implements the
* table of smart matches that is found in perlsyn.
*/
STATIC OP *
-S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
{
dVAR;
dSP;
@@ -4464,7 +4464,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
/* Take care only to invoke mg_get() once for each argument.
* Currently we do this by copying the SV if it's magical. */
if (d) {
- if (SvGMAGICAL(d))
+ if (!copied && SvGMAGICAL(d))
d = sv_mortalcopy(d);
}
else
@@ -4775,7 +4775,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
PUTBACK;
DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n"));
- (void) do_smartmatch(seen_this, seen_other);
+ (void) do_smartmatch(seen_this, seen_other, 0);
SPAGAIN;
DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
@@ -4837,7 +4837,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
PUTBACK;
/* infinite recursion isn't supposed to happen here */
DEBUG_M(Perl_deb(aTHX_ " recursively testing array element...\n"));
- (void) do_smartmatch(NULL, NULL);
+ (void) do_smartmatch(NULL, NULL, 1);
SPAGAIN;
DEBUG_M(Perl_deb(aTHX_ " recursion finished\n"));
if (SvTRUEx(POPs))
diff --git a/proto.h b/proto.h
index 58fc77e766..cd18de8a9c 100644
--- a/proto.h
+++ b/proto.h
@@ -5756,7 +5756,7 @@ STATIC void S_destroy_matcher(pTHX_ PMOP* matcher)
#define PERL_ARGS_ASSERT_DESTROY_MATCHER \
assert(matcher)
-STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other);
+STATIC OP* S_do_smartmatch(pTHX_ HV* seen_this, HV* seen_other, const bool copied);
STATIC OP* S_docatch(pTHX_ OP *o)
__attribute__warn_unused_result__;
diff --git a/t/op/taint.t b/t/op/taint.t
index 47e9303c68..ba32722250 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
use strict;
use Config;
-plan tests => 784;
+plan tests => 786;
$| = 1;
@@ -2164,6 +2164,10 @@ end
ok(!tainted "", "tainting still works after index() of the constant");
}
+# Tainted values with smartmatch
+# [perl #93590] S_do_smartmatch stealing its own string buffers
+ok "M$TAINT" ~~ ['m', 'M'], '$tainted ~~ ["whatever", "match"]';
+ok !("M$TAINT" ~~ ['m', undef]), '$tainted ~~ ["whatever", undef]';
# This may bomb out with the alarm signal so keep it last