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) <perlbug-followup@perl.org>
Message-ID: <rt-22708-59432.14.6755501393177@rt.perl.org>
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 (file)
--- 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<require> 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 (executable)
--- 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 (executable)
--- 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";
+}