Fix [perl #21742] :

require() should always be called in scalar context,
even when it's the last statement in an eval("").

p4raw-id: //depot/perl@19851

diff --git a/pp_ctl.c b/pp_ctl.c
index 30e7b13..dbfc39c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2828,8 +2828,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     else
        sv_setpv(ERRSV,"");
     if (yyparse() || PL_error_count || !PL_eval_root) {
-       SV **newsp;
-       I32 gimme;
+       SV **newsp;                     /* Used by POPBLOCK. */
        PERL_CONTEXT *cx;
        I32 optype = 0;                 /* Might be reset by POPEVAL. */
        STRLEN n_a;
@@ -2873,7 +2872,16 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        *startop = PL_eval_root;
     } else
        SAVEFREEOP(PL_eval_root);
-    if (gimme & G_VOID)
+
+    /* Set the context for this new optree.
+     * If the last op is an OP_REQUIRE, force scalar context.
+     * Otherwise, propagate the context from the eval(). */
+    if (PL_eval_root->op_type == OP_LEAVEEVAL
+           && cUNOPx(PL_eval_root)->op_first->op_type == OP_LINESEQ
+           && cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
+           == OP_REQUIRE)
+       scalar(PL_eval_root);
+    else 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 8896bb3..7d1b240 100755 (executable)
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -11,7 +11,7 @@ $i = 1;
 
 my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
 my $Is_UTF8   = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 29;
+my $total_tests = 30;
 if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 26; }
 print "1..$total_tests\n";
 
@@ -134,8 +134,7 @@ print $x;
 
 write_file('bleah.pm', <<'**BLEAH**'
 print "not " if !defined wantarray || wantarray ne '';
-my $TODO = $i == 23 ? " # TODO bug #21742" : "";
-print "ok $i - require() context$TODO\n";
+print "ok $i - require() context\n";
 1;
 **BLEAH**
 );
@@ -143,6 +142,7 @@ print "ok $i - require() context$TODO\n";
 $foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
 @foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
        eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+       eval q{$_=$_+2;require bleah}; delete $INC{"bleah.pm"}; ++$::i;
 $foo = eval  {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
 @foo = eval  {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
        eval  {require bleah};