From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 25 Jun 2003 19:25:47 +0000 (+0000)
Subject: Fix [perl #21742] :
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0c58d367e297133798f6e191e83d3087e2617588;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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};