diff options
| -rw-r--r-- | pod/perldelta.pod | 7 | ||||
| -rw-r--r-- | pp_sys.c | 16 | ||||
| -rw-r--r-- | t/op/exec.t | 15 |
3 files changed, 31 insertions, 7 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c3ed5083ea..fb5b7cfe94 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -596,6 +596,13 @@ or C<unimport> method. It is now treated like any other string C<1>. =item * +C<system> now reduces its arguments to strings in the parent process, so +any effects of stringifying them (such as overload methods being called +or warnings being emitted) are visible in the way the program expects. +[perl #121105] + +=item * + The C<readpipe()> built-in function now checks at compile time that it has only one parameter expression, and puts it in scalar context, thus ensuring that it doesn't corrupt the stack at runtime. [perl #4574] @@ -4392,14 +4392,18 @@ PP(pp_system) int result; # endif + while (++MARK <= SP) { + SV *origsv = *MARK; + STRLEN len; + char *pv; + pv = SvPV(origsv, len); + *MARK = newSVpvn_flags(pv, len, + (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP); + } + MARK = ORIGMARK; + if (TAINTING_get) { TAINT_ENV(); - while (++MARK <= SP) { - (void)SvPV_nolen_const(*MARK); /* stringify for taint check */ - if (TAINT_get) - break; - } - MARK = ORIGMARK; TAINT_PROPER("system"); } PERL_FLUSHALL_FOR_CHILD; diff --git a/t/op/exec.t b/t/op/exec.t index b55cbda09c..d696163f7c 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 => 38); +plan(tests => 41); my $Perl = which_perl(); @@ -192,6 +192,19 @@ TODO: { or printf "# \$! eq %d, '%s'\n", $!, $!; } +package CountRead { + sub TIESCALAR { bless({ n => 0 }, $_[0]) } + sub FETCH { ++$_[0]->{n} } +} +my $cr; +tie $cr, "CountRead"; +is system($^X, "-e", "exit(\$ARGV[0] eq '1' ? 0 : 1)", $cr), 0, + "system args have magic processed exactly once"; +is tied($cr)->{n}, 1, "system args have magic processed before fork"; + +is system($^X, "-e", "exit(\$ARGV[0] eq \$ARGV[1] ? 0 : 1)", "$$", $$), 0, + "system args have magic processed before fork"; + my $test = curr_test(); exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}}; fail("This should never be reached if the exec() worked"); |