This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement state array and state hashes. Initialisation assignment
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 5 May 2006 12:48:19 +0000 (12:48 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 5 May 2006 12:48:19 +0000 (12:48 +0000)
to state arrays or hashes is not implemented yet.

p4raw-id: //depot/perl@28106

ext/B/B/Concise.pm
pp.c
t/op/state.t

index d8a259f..b2179a7 100644 (file)
@@ -572,7 +572,7 @@ $priv{"repeat"}{64} = "DOLIST";
 $priv{"leaveloop"}{64} = "CONT";
 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
   for (qw(rv2gv rv2sv padsv aelem helem));
-$priv{"padsv"}{16} = "STATE";
+$priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");
 @{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD");
 @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv");
 $priv{"gv"}{32} = "EARLYCV";
diff --git a/pp.c b/pp.c
index 777c657..7540c99 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -61,7 +61,8 @@ PP(pp_padav)
     dVAR; dSP; dTARGET;
     I32 gimme;
     if (PL_op->op_private & OPpLVAL_INTRO)
-       SAVECLEARSV(PAD_SVl(PL_op->op_targ));
+       if (!(PL_op->op_private & OPpPAD_STATE))
+           SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     EXTEND(SP, 1);
     if (PL_op->op_flags & OPf_REF) {
        PUSHs(TARG);
@@ -104,7 +105,8 @@ PP(pp_padhv)
 
     XPUSHs(TARG);
     if (PL_op->op_private & OPpLVAL_INTRO)
-       SAVECLEARSV(PAD_SVl(PL_op->op_targ));
+       if (!(PL_op->op_private & OPpPAD_STATE))
+           SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     if (PL_op->op_flags & OPf_REF)
        RETURN;
     else if (LVRET) {
index 7a82f8a..ebe8d9b 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
 use strict;
 use feature "state";
 
-plan tests => 26;
+plan tests => 30;
 
 ok( ! defined state $uninit, q(state vars are undef by default) );
 
@@ -110,3 +110,30 @@ sub stateless {
 }
 is( stateless(), 43, 'stateless function, first time' );
 is( stateless(), 43, 'stateless function, second time' );
+
+# array state vars
+
+sub stateful_array {
+    state @x;
+    push @x, 'x';
+    return $#x;
+}
+
+my $xsize = stateful_array();
+is( $xsize, 0, 'uninitialized state array' );
+
+$xsize = stateful_array();
+is( $xsize, 1, 'uninitialized state array after one iteration' );
+
+# hash state vars
+
+sub stateful_hash {
+    state %hx;
+    return $hx{foo}++;
+}
+
+my $xhval = stateful_hash();
+is( $xhval, 0, 'uninitialized state hash' );
+
+$xhval = stateful_hash();
+is( $xhval, 1, 'uninitialized state hash after one iteration' );