BEGIN {
chdir 't' if -d 't';
- @INC = '../lib';
require './test.pl';
+ set_up_inc('../lib');
}
use strict;
-plan tests => 132;
+plan tests => 164;
# Before loading feature.pm, test it with CORE::
ok eval 'CORE::state $x = 1;', 'CORE::state outside of feature.pm scope';
$xsize = stateful_array();
is( $xsize, 1, 'uninitialized state array after one iteration' );
+sub stateful_init_array {
+ state @x = qw(a b c);
+ push @x, "x";
+ return join(",", @x);
+}
+
+is stateful_init_array(), "a,b,c,x";
+is stateful_init_array(), "a,b,c,x,x";
+is stateful_init_array(), "a,b,c,x,x,x";
+
# hash state vars
sub stateful_hash {
$xhval = stateful_hash();
is( $xhval, 1, 'uninitialized state hash after one iteration' );
+sub stateful_init_hash {
+ state %x = qw(a b c d);
+ $x{foo}++;
+ return join(",", map { ($_, $x{$_}) } sort keys %x);
+}
+
+is stateful_init_hash(), "a,b,c,d,foo,1";
+is stateful_init_hash(), "a,b,c,d,foo,2";
+is stateful_init_hash(), "a,b,c,d,foo,3";
+
+# declarations with attributes
+
+SKIP: {
+skip "no attributes in miniperl", 3, if is_miniperl;
+
+eval q{
+sub stateful_attr {
+ state $a :shared;
+ state $b :shared = 3;
+ state @c :shared;
+ state @d :shared = qw(a b c);
+ state %e :shared;
+ state %f :shared = qw(a b c d);
+ $a++;
+ $b++;
+ push @c, "x";
+ push @d, "x";
+ $e{e}++;
+ $f{e}++;
+ return join(",", $a, $b, join(":", @c), join(":", @d), join(":", %e),
+ join(":", map { ($_, $f{$_}) } sort keys %f));
+}
+};
+
+is stateful_attr(), "1,4,x,a:b:c:x,e:1,a:b:c:d:e:1";
+is stateful_attr(), "2,5,x:x,a:b:c:x:x,e:2,a:b:c:d:e:2";
+is stateful_attr(), "3,6,x:x:x,a:b:c:x:x:x,e:3,a:b:c:d:e:3";
+}
+
+
# Recursion
sub noseworth {
#
-# Check state $_
-#
-my @stones = qw [fred wilma barny betty];
-my $first = $stones [0];
-my $First = ucfirst $first;
-$_ = "bambam";
-foreach my $flint (@stones) {
- no warnings 'experimental::lexical_topic';
- state $_ = $flint;
- is $_, $first, 'state $_';
- ok /$first/, '/.../ binds to $_';
- is ucfirst, $First, '$_ default argument';
-}
-is $_, "bambam", '$_ is still there';
-
-#
# Goto.
#
my @simpsons = qw [Homer Marge Bart Lisa Maggie];
#
my @spam = qw [spam ham bacon beans];
foreach my $spam (@spam) {
+ no warnings 'experimental::smartmatch';
given (state $spam = $spam) {
when ($spam [0]) {ok 1, "given"}
default {ok 0, "given"}
foreach my $forbidden (<DATA>) {
- chomp $forbidden;
- no strict 'vars';
- eval $forbidden;
- like $@, qr/Initialization of state variables in list context currently forbidden/, "Currently forbidden: $forbidden";
+ SKIP: {
+ skip_if_miniperl("miniperl can't load attributes.pm", 1)
+ if $forbidden =~ /:shared/;
+
+ chomp $forbidden;
+ no strict 'vars';
+ eval $forbidden;
+ like $@,
+ qr/Initialization of state variables in list currently forbidden/,
+ "Currently forbidden: $forbidden";
+ }
}
# [perl #49522] state variable not available
ok(defined $f, 'state init not skipped');
}
+# [perl #121134] Make sure padrange doesn't mess with these
+{
+ sub thing {
+ my $expect = shift;
+ my ($x, $y);
+ state $z;
+
+ is($z, $expect, "State variable is correct");
+
+ $z = 5;
+ }
+
+ thing(undef);
+ thing(5);
+
+ sub thing2 {
+ my $expect = shift;
+ my $x;
+ my $y;
+ state $z;
+
+ is($z, $expect, "State variable is correct");
+
+ $z = 6;
+ }
+
+ thing2(undef);
+ thing2(6);
+}
+
+# [perl #123029] regression in "state" under PERL_NO_COW
+sub rt_123029 {
+ state $s;
+ $s = 'foo'x500;
+ my $c = $s;
+ return defined $s;
+}
+ok(rt_123029(), "state variables don't surprisingly disappear when accessed");
+
+# make sure multiconcat doesn't break state
+
+for (1,2) {
+ state $s = "-$_-";
+ is($s, "-1-", "state with multiconcat pass $_");
+}
__DATA__
-state ($a) = 1;
(state $a) = 1;
-state @a = 1;
-state (@a) = 1;
(state @a) = 1;
-state %a = ();
-state (%a) = ();
+(state @a :shared) = 1;
(state %a) = ();
+(state %a :shared) = ();
+state ($a) = 1;
+(state ($a)) = 1;
+state (@a) = 1;
+(state (@a)) = 1;
+state (@a) :shared = 1;
+(state (@a) :shared) = 1;
+state (%a) = ();
+(state (%a)) = ();
+state (%a) :shared = ();
+(state (%a) :shared) = ();
+state (undef, $a) = ();
+(state (undef, $a)) = ();
+state (undef, @a) = ();
+(state (undef, @a)) = ();
+state ($a, undef) = ();
+(state ($a, undef)) = ();
state ($a, $b) = ();
+(state ($a, $b)) = ();
+state ($a, $b) :shared = ();
+(state ($a, $b) :shared) = ();
state ($a, @b) = ();
+(state ($a, @b)) = ();
+state ($a, @b) :shared = ();
+(state ($a, @b) :shared) = ();
+state (@a, undef) = ();
+(state (@a, undef)) = ();
+state (@a, $b) = ();
+(state (@a, $b)) = ();
+state (@a, $b) :shared = ();
+(state (@a, $b) :shared) = ();
+state (@a, @b) = ();
+(state (@a, @b)) = ();
+state (@a, @b) :shared = ();
+(state (@a, @b) :shared) = ();
(state $a, state $b) = ();
(state $a, $b) = ();
(state $a, my $b) = ();