From: Marcus Holland-Moritz Date: Sun, 15 Jun 2003 23:09:03 +0000 (+0000) Subject: Revert change #19126, a poor attempt at fixing bug #21742. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f48583aa2d2b7c9a2c44c530083c6fdd7e6f9713;p=p5sagit%2Fp5-mst-13.2.git Revert change #19126, a poor attempt at fixing bug #21742. The test for #21742 is marked as TODO. Plus new regression tests from : Subject: [perl #22708] void context in string eval is broken From: "Marcus Holland-Moritz" (via RT) Message-ID: p4raw-link: @19126 on //depot/perl: a89be09a10c36299e755a956d356eb7f1f643437 p4raw-id: //depot/perl@19801 --- diff --git a/pp_ctl.c b/pp_ctl.c index 95ea793..42fea59 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2898,13 +2898,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) *startop = PL_eval_root; } else SAVEFREEOP(PL_eval_root); - if (gimme & G_VOID && ! PL_in_eval & EVAL_INREQUIRE) - /* - * EVAL_INREQUIRE (the code is being required) is special-cased : - * in this case we want scalar context to be forced, instead - * of void context, so a proper return value is returned from - * C via this leaveeval op. - */ + if (gimme & G_VOID) scalarvoid(PL_eval_root); else if (gimme & G_ARRAY) list(PL_eval_root); diff --git a/t/comp/require.t b/t/comp/require.t index 78ac436..8896bb3 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -134,7 +134,8 @@ print $x; write_file('bleah.pm', <<'**BLEAH**' print "not " if !defined wantarray || wantarray ne ''; -print "ok $i - require() context\n"; +my $TODO = $i == 23 ? " # TODO bug #21742" : ""; +print "ok $i - require() context$TODO\n"; 1; **BLEAH** ); diff --git a/t/op/eval.t b/t/op/eval.t index a6d78c4..6aef5b8 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..88\n"; +print "1..91\n"; eval 'print "ok 1\n";'; @@ -422,3 +422,19 @@ $test++; sub Foo {} print Foo(eval {}); print "ok ",$test++," - #20798 (used to dump core)\n"; + +# check for context in string eval +{ + my(@r,$r,$c); + sub context { defined(wantarray) ? (wantarray ? ($c='A') : ($c='S')) : ($c='V') } + + my $code = q{ context() }; + @r = qw( a b ); + $r = 'ab'; + @r = eval $code; + print "@r$c" eq 'AA' ? "ok " : "# '@r$c' ne 'AA'\nnot ok ", $test++, "\n"; + $r = eval $code; + print "$r$c" eq 'SS' ? "ok " : "# '$r$c' ne 'SS'\nnot ok ", $test++, "\n"; + eval $code; + print $c eq 'V' ? "ok " : "# '$c' ne 'V'\nnot ok ", $test++, "\n"; +}