develooper Front page | perl.perl5.porters | Postings from August 2001

[PATCH List::Util] fix stack/scoping problems

Thread Next
From:
Robin Houston
Date:
August 21, 2001 07:13
Subject:
[PATCH List::Util] fix stack/scoping problems
Message ID:
20010821150958.A5512@robin.kitsite.com
The patch below is an attempt to fix the problem reported by Doug Wilson.
It seems to work, but I'd appreciate it if someone (Graham?) could make
sure I haven't done anything too hideous.

The failing examples given by Doug and Graham have been added as tests.

 .robin.

--- perl@11626/ext/List/Util/Util.xs	Mon Jul  9 15:10:08 2001
+++ perl@11660/ext/List/Util/Util.xs	Tue Aug 21 14:38:22 2001
@@ -163,6 +163,9 @@
     HV *stash;
     CV *cv;
     OP *reducecop;
+    PERL_CONTEXT *cx;
+    SV** newsp;
+    I32 gimme = cxstack[cxstack_ix].blk_gimme;
     if(items <= 1) {
 	XSRETURN_UNDEF;
     }
@@ -171,7 +174,7 @@
     SAVESPTR(GvSV(agv));
     SAVESPTR(GvSV(bgv));
     cv = sv_2cv(block, &stash, &gv, 0);
-    reducecop = CvSTART(cv);
+    reducecop = CvSTART(cv)->op_next;
     SAVESPTR(CvROOT(cv)->op_ppaddr);
     CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
     SAVESPTR(PL_curpad);
@@ -183,7 +186,10 @@
 	GvSV(agv) = ret;
 	GvSV(bgv) = ST(index);
 	PL_op = reducecop;
+        PUSHBLOCK(cx, CXt_BLOCK, SP);
 	CALLRUNOPS(aTHX);
+        POPBLOCK(cx,PL_curpm);
+        SP = newsp;
 	ret = *PL_stack_sp;
     }
     ST(0) = ret;
@@ -201,12 +207,16 @@
     HV *stash;
     CV *cv;
     OP *reducecop;
+    PERL_CONTEXT *cx;
+    SV** newsp;
+    I32 gimme = cxstack[cxstack_ix].blk_gimme;
+
     if(items <= 1) {
 	XSRETURN_UNDEF;
     }
     SAVESPTR(GvSV(PL_defgv));
     cv = sv_2cv(block, &stash, &gv, 0);
-    reducecop = CvSTART(cv);
+    reducecop = CvSTART(cv)->op_next;
     SAVESPTR(CvROOT(cv)->op_ppaddr);
     CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
     SAVESPTR(PL_curpad);
@@ -216,7 +226,10 @@
     for(index = 1 ; index < items ; index++) {
 	GvSV(PL_defgv) = ST(index);
 	PL_op = reducecop;
+        PUSHBLOCK(cx, CXt_BLOCK, SP);
 	CALLRUNOPS(aTHX);
+        POPBLOCK(cx,PL_curpm);
+        SP = newsp;
 	if (SvTRUE(*PL_stack_sp)) {
 	  ST(0) = ST(index);
 	  XSRETURN(1);
--- perl@11626/ext/List/Util/t/first.t	Mon Jul  9 15:10:08 2001
+++ perl@11660/ext/List/Util/t/first.t	Tue Aug 21 15:04:09 2001
@@ -10,7 +10,7 @@
 
 use List::Util qw(first);
 
-print "1..4\n";
+print "1..5\n";
 
 print "not " unless defined &first;
 print "ok 1\n";
@@ -23,3 +23,8 @@
 
 print "not " if defined(first { 0 });
 print "ok 4\n";
+
+my $foo = first { $_->[1] le "e" and "e" le $_->[2] }
+		([qw(a b c)], [qw(d e f)], [qw(g h i)]);
+print "not " unless $foo->[0] eq 'd';
+print "ok 5\n";
--- perl@11626/ext/List/Util/t/reduce.t	Mon Jul  9 15:10:08 2001
+++ perl@11660/ext/List/Util/t/reduce.t	Tue Aug 21 15:05:13 2001
@@ -10,7 +10,7 @@
 
 use List::Util qw(reduce min);
 
-print "1..5\n";
+print "1..6\n";
 
 print "not " if defined reduce {};
 print "ok 1\n";
@@ -28,3 +28,12 @@
 @a = map { pack("C", int(rand(256))) } 0 .. 20;
 print "not " unless join("",@a) eq reduce { $a . $b } @a;
 print "ok 5\n";
+
+sub add {
+  my($aa, $bb) = @_;
+  return $aa + $bb;
+}
+
+my $sum = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
+print "not " unless $sum == 6;
+print "ok 6\n";

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About