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

[PATCH List::Util] Take 2

Thread Next
From:
Robin Houston
Date:
August 22, 2001 04:57
Subject:
[PATCH List::Util] Take 2
Message ID:
20010822125432.A929@robin.kitsite.com
This patch replaces the previous one. It makes a mortal copy of the
return value, to avoid the problem Doug noticed. (Not sure if it's
necessary to do that in "first", because the value's always taken
from the argument list. But it can't hurt...)

I also force gimme to G_SCALAR and use CXt_SUB rather than CXt_BLOCK
so that the code block is always called in scalar context.

I hope this attempt fares better; please try to break it!
(More tests would be nice too.)

 .robin.

--- perl@11626/ext/List/Util/Util.xs	Mon Jul  9 15:10:08 2001
+++ perl@11660/ext/List/Util/Util.xs	Wed Aug 22 12:49:33 2001
@@ -163,6 +163,9 @@
     HV *stash;
     CV *cv;
     OP *reducecop;
+    PERL_CONTEXT *cx;
+    SV** newsp;
+    I32 gimme = G_SCALAR;
     if(items <= 1) {
 	XSRETURN_UNDEF;
     }
@@ -179,14 +182,17 @@
     SAVETMPS;
     SAVESPTR(PL_op);
     ret = ST(1);
+    PUSHBLOCK(cx, CXt_SUB, SP);
     for(index = 2 ; index < items ; index++) {
 	GvSV(agv) = ret;
 	GvSV(bgv) = ST(index);
 	PL_op = reducecop;
 	CALLRUNOPS(aTHX);
+        SP = newsp;
 	ret = *PL_stack_sp;
     }
-    ST(0) = ret;
+    ST(0) = sv_mortalcopy(ret);
+    POPBLOCK(cx,PL_curpm);
     XSRETURN(1);
 }
 
@@ -201,6 +207,10 @@
     HV *stash;
     CV *cv;
     OP *reducecop;
+    PERL_CONTEXT *cx;
+    SV** newsp;
+    I32 gimme = G_SCALAR;
+
     if(items <= 1) {
 	XSRETURN_UNDEF;
     }
@@ -213,15 +223,20 @@
     PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
     SAVETMPS;
     SAVESPTR(PL_op);
+    PUSHBLOCK(cx, CXt_SUB, SP);
     for(index = 1 ; index < items ; index++) {
 	GvSV(PL_defgv) = ST(index);
 	PL_op = reducecop;
 	CALLRUNOPS(aTHX);
+	SvREFCNT_inc(ST(0));
+        SP = newsp;
 	if (SvTRUE(*PL_stack_sp)) {
-	  ST(0) = ST(index);
+	  ST(0) = sv_mortalcopy(ST(index));
+          POPBLOCK(cx,PL_curpm);
 	  XSRETURN(1);
 	}
     }
+    POPBLOCK(cx,PL_curpm);
     XSRETURN_UNDEF;
 }
 
--- 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