diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 4034312c8dd13..455bdf67d6327 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -2820,6 +2820,18 @@ call_argv(subname, flags, ...) EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i))); +bool +call_argv_cleanup() + CODE: + IV old_count = PL_sv_count; + char one[] = "one"; /* non const strings */ + char two[] = "two"; + char *args[] = { one, two, NULL }; + Perl_call_argv(aTHX_ "called_by_argv_cleanup", G_DISCARD | G_LIST, args); + RETVAL = PL_sv_count == old_count; + OUTPUT: + RETVAL + void call_method(methname, flags, ...) char* methname diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index 04a6d8c3aba47..7ac294b453900 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -11,7 +11,7 @@ use strict; BEGIN { require '../../t/test.pl'; - plan(542); + plan(544); use_ok('XS::APItest') }; use Config; @@ -35,6 +35,13 @@ sub i { call_sv_C(); is($call_sv_count, 7, "call_sv_C passes"); +my $did_argv; +sub called_by_argv_cleanup { + ++$did_argv if @_; +} +ok(call_argv_cleanup(), "call_argv() cleans up temps if asked to"); +ok($did_argv, "call_argv_cleanup() did the actual call with arguments"); + sub d { die "its_dead_jim\n"; } diff --git a/perl.c b/perl.c index 0f1872dd177b8..4183e2ce046e7 100644 --- a/perl.c +++ b/perl.c @@ -3040,6 +3040,16 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, char **argv) #else 0; #endif + /* For a reference counted stack the arguments are cleaned up + * when the stack is popped. + */ + if (!is_rc && (flags & G_DISCARD) != 0) { + ENTER; + SAVETMPS; + /* leave G_DISCARD on to clean up any return values + * from the stack in call_sv(). + */ + } PUSHMARK(PL_stack_sp); while (*argv) { SV *newsv = newSVpv(*argv,0); @@ -3049,7 +3059,15 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, char **argv) sv_2mortal(newsv); argv++; } - return call_pv(sub_name, flags); + + SSize_t count = call_pv(sub_name, flags); + + if (!is_rc && (flags & G_DISCARD) != 0) { + FREETMPS; + LEAVE; + } + + return count; } /*