develooper Front page | perl.perl5.changes | Postings from May 2006

Change 28090: Another test for state variables and closures,

From:
Rafael Garcia-Suarez
Date:
May 4, 2006 00:45
Subject:
Change 28090: Another test for state variables and closures,
Message ID:
200605040745.k447j1Po010135@smtp3.ActiveState.com
Change 28090 by rgs@stencil on 2006/05/04 07:42:27

	Another test for state variables and closures,
	adapted from a Perl 6 example, pointed out by
	Joshua "Limbic_Region" Gatcomb

Affected files ...

... //depot/perl/t/op/state.t#5 edit

Differences ...

==== //depot/perl/t/op/state.t#5 (text) ====
Index: perl/t/op/state.t
--- perl/t/op/state.t#4~28089~	2006-05-03 15:49:14.000000000 -0700
+++ perl/t/op/state.t	2006-05-04 00:42:27.000000000 -0700
@@ -1,4 +1,5 @@
 #!./perl -w
+# tests state variables
 
 BEGIN {
     chdir 't' if -d 't';
@@ -9,10 +10,12 @@
 use strict;
 use feature "state";
 
-plan tests => 25;
+plan tests => 26;
 
 ok( ! defined state $uninit, q(state vars are undef by default) );
 
+# basic functionality
+
 sub stateful {
     state $x;
     state $y = 1;
@@ -35,6 +38,8 @@
 is( $y, 3, 'incremented state var' );
 is( $z, 2, 'reinitialized lexical' );
 
+# in a nested block
+
 sub nesting {
     state $foo = 10;
     my $t;
@@ -51,6 +56,8 @@
 is( $x, 12, 'outer state var' );
 is( $y, 14, 'inner state var' );
 
+# in a closure
+
 sub generator {
     my $outer;
     # we use $outer to generate a closure
@@ -65,6 +72,7 @@
 is( $f1->(), 3, 'generator 1 again' );
 is( $f2->(), 2, 'generator 2 once more' );
 
+# with ties
 {
     package countfetches;
     our $fetchcount = 0;
@@ -78,8 +86,25 @@
     ::is( $fetchcount, 1, "fetch only called once" );
 }
 
+# state variables are shared among closures
+
+sub gen_cashier {
+    my $amount = shift;
+    state $cash_in_store = 0;
+    return {
+	add => sub { $cash_in_store += $amount },
+	del => sub { $cash_in_store -= $amount },
+	bal => sub { $cash_in_store },
+    };
+}
+
+gen_cashier(59)->{add}->();
+gen_cashier(17)->{del}->();
+is( gen_cashier()->{bal}->(), 42, '$42 in my drawer' );
+
+# stateless assignment to a state variable
+
 sub stateless {
-    # stateless assignment
     (state $reinitme) = 42;
     ++$reinitme;
 }
End of Patch.



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