Change 19851: Fix [perl #21742] :

[Rafael Garcia-Suarez]

Change 19851 by [EMAIL PROTECTED] on 2003/06/25 19:25:47

        Fix [perl #21742] :
        require() should always be called in scalar context,
        even when it's the last statement in an eval("").

Affected files ...

... //depot/perl/pp_ctl.c#361 edit
... //depot/perl/t/comp/require.t#26 edit

Differences ...

==== //depot/perl/pp_ctl.c#361 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#360~19819~    Thu Jun 19 07:08:13 2003
+++ perl/pp_ctl.c       Wed Jun 25 12:25:47 2003
@@ -2828,8 +2828,7 @@
     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 @@
        *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);

==== //depot/perl/t/comp/require.t#26 (xtext) ====
Index: perl/t/comp/require.t
--- perl/t/comp/require.t#25~19801~     Mon Jun 16 15:47:28 2003
+++ perl/t/comp/require.t       Wed Jun 25 12:25:47 2003
@@ -11,7 +11,7 @@
 
 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 @@
 
 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 @@
 $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};
End of Patch.