From: Rafael Garcia-Suarez Date: Wed, 25 Jun 2003 19:25:47 +0000 (+0000) Subject: Fix [perl #21742] : X-Git-Tag: accepted/trunk/20130322.191538~23935 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=0c58d367e297133798f6e191e83d3087e2617588;p=platform%2Fupstream%2Fperl.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};