From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 1 Apr 2003 18:39:43 +0000 (+0000)
Subject: Fix bug #21742. require should be always invoked in
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a89be09a10c36299e755a956d356eb7f1f643437;p=p5sagit%2Fp5-mst-13.2.git

Fix bug #21742. require should be always invoked in
scalar context. This wasn't the case when called from
an eval(""), because the void context doesn't propagate
through the leaveeval op. Instead of making scalarvoid()
handle OP_LEAVEEVAL -- this breaks AutoLoader -- implement
a workaround in doeval().

p4raw-id: //depot/perl@19126
---

diff --git a/pp_ctl.c b/pp_ctl.c
index ac33adf..0b00685 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2884,7 +2884,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	*startop = PL_eval_root;
     } else
 	SAVEFREEOP(PL_eval_root);
-    if (gimme & G_VOID)
+    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.
+	 */
 	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 44b46cd..78ac436 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -11,8 +11,8 @@ $i = 1;
 
 my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
 my $Is_UTF8   = (${^OPEN} || "") =~ /:utf8/;
-my $total_tests = 23;
-if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 20; }
+my $total_tests = 29;
+if ($Is_EBCDIC || $Is_UTF8) { $total_tests = 26; }
 print "1..$total_tests\n";
 
 sub do_require {
@@ -130,6 +130,22 @@ dofile();
 sub dofile { do "bleah.do"; };
 print $x;
 
+# Test that scalar context is forced for require
+
+write_file('bleah.pm', <<'**BLEAH**'
+print "not " if !defined wantarray || wantarray ne '';
+print "ok $i - require() context\n";
+1;
+**BLEAH**
+);
+                              delete $INC{"bleah.pm"}; ++$::i;
+$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;
+$foo = eval  {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+@foo = eval  {require bleah}; delete $INC{"bleah.pm"}; ++$::i;
+       eval  {require bleah};
+
 # UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input
 
 if ($Is_EBCDIC || $Is_UTF8) { exit; }