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

Re: [PATCH List::Util] Take 2

Thread Previous | Thread Next
From:
Graham Barr
Date:
August 22, 2001 05:31
Subject:
Re: [PATCH List::Util] Take 2
Message ID:
20010822133029.X7667@pobox.com
On Wed, Aug 22, 2001 at 12:54:33PM +0100, Robin Houston wrote:
> 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...)

Well it costs if it is a 200MB string.

> 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.

Excellent.

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

It certaily seems more reasonable to me. I will add it to the
Scalar-List-Utils dist and run some tests if it seems OK then I
will release and we can merge it back into the core.

Graham.

> --- 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 Previous | 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