[perl #104084] Make exec call FETCH once under -Tsmoke-me/exec-magic

2 files changed, 31 insertions, 15 deletions

diff --git a/pp_sys.c b/pp_sys.c
index fcfdeb322e..e4db53700a 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4259,16 +4259,13 @@ PP(pp_exec)
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
 
-    if (PL_tainting) {
-	TAINT_ENV();
-	while (++MARK <= SP) {
-	    (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
-	    if (PL_tainted)
-		break;
-	}
-	MARK = ORIGMARK;
-	TAINT_PROPER("exec");
-    }
+    TAINT_ENV();
+    /* SvGETMAGIC propagates taintedness.  Since we have to skip magic
+       later on under taint as a result, it simplifies things to call magic
+       up front all the time. */
+    while (++MARK <= SP) SvGETMAGIC(*MARK);
+    MARK = ORIGMARK;
+    TAINT_PROPER("exec");
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
 	SV * const really = *++MARK;
@@ -4289,13 +4286,13 @@ PP(pp_exec)
 #endif
     else {
 #ifdef VMS
-	value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
+	value = (I32)vms_do_exec(SvPV_nomg_nolen(*SP));
 #else
 #  ifdef __OPEN_VM
-	(void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
+	(void) do_spawn(SvPV_nomg_nolen(*SP));
 	value = 0;
 #  else
-	value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
+	value = (I32)do_exec(SvPV_nomg_nolen(*SP));
 #  endif
 #endif
     }
diff --git a/t/op/exec.t b/t/op/exec.t
index 3087ce46ab..e65c75c3e1 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C';		# Ditto in GNU.
 my $Is_VMS   = $^O eq 'VMS';
 my $Is_Win32 = $^O eq 'MSWin32';
 
-plan(tests => 22);
+plan(tests => 24);
 
 my $Perl = which_perl();
 
@@ -141,7 +141,8 @@ TODO: {
         "exec failure doesn't terminate process");
 }
 
-# [perl #104084] system $tied should FETCH in the parent
+# [perl #104084] system($tied) and exec($tied) should FETCH in the parent,
+#                and only once
 fresh_perl_is(
   q{
     use 5.10.0;
@@ -157,6 +158,24 @@ fresh_perl_is(
   {},
   'system $tied should FETCH in the parent',
 );
+fresh_perl_is(
+  q{
+    delete
+     @ENV{qw{ PATH TERM DCL$PATH IFS CDPATH ENV BASH_ENV PERL5SHELL }};
+    use 5.10.0;
+    package D {
+     sub TIESCALAR { return bless {},  shift }
+     sub FETCH { say ++$y; "lskdjfalksdjfdjfkls" }
+    }
+    tie $x, "D";
+    exec {$x} $x;
+    exec $x;
+    say $D::y;
+  },
+  "1\n2\n3\n3\n",
+  { switches => ['-T'] }, # fetch was being called twice under taint
+  'exec $tied should FETCH in the parent',
+);
 
 my $test = curr_test();
 exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};