summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-02-08 21:21:28 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2004-02-08 21:21:28 +0000
commit7cc47870397ebff757d126816a8d225e8c7f5e20 (patch)
treead26d528dd7b26f67de8a47c0978bfc185e687bb
parent986f8adc220317ecfcf2c0eace5110e18382f196 (diff)
downloadperl-7cc47870397ebff757d126816a8d225e8c7f5e20.tar.gz
map and grep weren't working correctly with lexical $_ in
scalar context, because pp_mapwhile and pp_grepwhile were using their target as a temporary slot to store the return value. p4raw-id: //depot/perl@22289
-rw-r--r--pp_ctl.c11
-rw-r--r--pp_hot.c11
-rw-r--r--t/op/mydef.t14
3 files changed, 31 insertions, 5 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index 42d63c6d55..c5f802ab74 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -954,8 +954,15 @@ PP(pp_mapwhile)
(void)POPMARK; /* pop dst */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
- dTARGET;
- XPUSHi(items);
+ if (PL_op->op_private & OPpGREP_LEX) {
+ SV* sv = sv_newmortal();
+ sv_setiv(sv, items);
+ PUSHs(sv);
+ }
+ else {
+ dTARGET;
+ XPUSHi(items);
+ }
}
else if (gimme == G_ARRAY)
SP += items;
diff --git a/pp_hot.c b/pp_hot.c
index e884e2dbe1..ccfbf4181c 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2294,8 +2294,15 @@ PP(pp_grepwhile)
(void)POPMARK; /* pop dst */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
- dTARGET;
- XPUSHi(items);
+ if (PL_op->op_private & OPpGREP_LEX) {
+ SV* sv = sv_newmortal();
+ sv_setiv(sv, items);
+ PUSHs(sv);
+ }
+ else {
+ dTARGET;
+ XPUSHi(items);
+ }
}
else if (gimme == G_ARRAY)
SP += items;
diff --git a/t/op/mydef.t b/t/op/mydef.t
index 0770e78f0b..485f8431a5 100644
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -5,7 +5,7 @@ BEGIN {
@INC = '../lib';
}
-print "1..64\n";
+print "1..66\n";
my $test = 0;
sub ok ($$) {
@@ -118,6 +118,12 @@ $_ = "global";
ok( $x eq '1globallocal-2globallocal', 'map without {}' );
}
{
+ for my $_ (1) {
+ my $x = map $_, qw(a b);
+ ok( $x == 2, 'map in scalar context' );
+ }
+}
+{
my $buf = '';
sub tgrep1 { /(.)/; $buf .= $1 }
my $_ = 'y';
@@ -142,6 +148,12 @@ $_ = "global";
ok( $_ eq 'local', '...but without extraneous side-effects' );
}
{
+ for my $_ (1) {
+ my $x = grep $_, qw(a b);
+ ok( $x == 2, 'grep in scalar context' );
+ }
+}
+{
my $s = "toto";
my $_ = "titi";
$s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/