diff options
-rw-r--r-- | embed.fnc | 3 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | pp_ctl.c | 10 | ||||
-rw-r--r-- | proto.h | 2 | ||||
-rw-r--r-- | t/op/taint.t | 6 |
5 files changed, 14 insertions, 9 deletions
@@ -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) @@ -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) @@ -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)) @@ -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 |