diff --git a/MANIFEST b/MANIFEST index b392fb7711e2..ef78dbb83563 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5833,6 +5833,7 @@ t/op/filetest_stack_ok.t See if file tests leave their argument on the stack t/op/filetest_t.t See if -t file test works t/op/flip.t See if range operator works t/op/for.t See if for loops work +t/op/for-many.t See if n-at-a-time for loops work t/op/fork.t See if fork works t/op/fresh_perl_utf8.t UTF8 tests for pads and gvs t/op/getpid.t See if $$ and getppid work with threads diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index fe511f052e20..ab4a73f372c3 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -282,6 +282,14 @@ The following compound statements may be used to control flow: PHASE BLOCK +As of Perl 5.36, you can iterate over multiple values at a time by specifying +a list of lexicals within parentheses + + LABEL for my (VAR, VAR) (LIST) BLOCK + LABEL for my (VAR, VAR) (LIST) BLOCK continue BLOCK + LABEL foreach my (VAR, VAR) (LIST) BLOCK + LABEL foreach my (VAR, VAR) (LIST) BLOCK continue BLOCK + If enabled by the experimental C feature, the following may also be used try BLOCK catch (VAR) BLOCK @@ -549,6 +557,14 @@ followed by C. To use this form, you must enable the C feature via C. (See L. See also L.) +As of Perl 5.36, you can iterate over a list of lexical scalars n-at-a-time. +If the size of the LIST is not an exact multiple of number of iterator +variables, then on the last iteration the "excess" iterator variables are +undefined values, much like if you slice beyond the end of an array. You +can only iterate over scalars - unlike list assignment, it's not possible to +use C to signify a value that isn't wanted. This is a limitation of +the current implementation, and might be changed in the future. + Examples: for (@ary) { s/foo/bar/ } @@ -574,6 +590,17 @@ Examples: # do something which each %hash } + foreach my ($foo, $bar, $baz) (@list) { + # do something three-at-a-time + } + + foreach my ($key, $value) (%hash) { + # iterate over the hash + # The hash is eagerly flattened to a list before the loop starts, + # but as ever keys are copies, values are aliases. + # This is the same behaviour as for $var (%hash) {...} + } + Here's how a C programmer might code up a particular algorithm in Perl: for (my $i = 0; $i < @ary1; $i++) { diff --git a/t/op/for-many.t b/t/op/for-many.t new file mode 100644 index 000000000000..a58b3eb3880a --- /dev/null +++ b/t/op/for-many.t @@ -0,0 +1,349 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require "./test.pl"; +} + +use strict; +use warnings; + +my @have; + +# Simplest case is an explicit list: +for my ($q, $r) ('A', 'B', 'C', 'D') { + push @have, "$q;$r"; +} +is ("@have", 'A;B C;D', 'explicit list'); + +@have = (); + +for my ($q, $r) (reverse 'A', 'B', 'C', 'D') { + push @have, "$q;$r"; +} +is ("@have", 'D;C B;A', 'explicit list reversed'); + +@have = (); + +for my ($q, $r) ('A', 'B', 'C', 'D', 'E', 'F') { + push @have, "$q;$r"; +} +is ("@have", 'A;B C;D E;F', 'explicit list three iterations'); + +@have = (); + +for my ($q, $r, $s) ('A', 'B', 'C', 'D', 'E', 'F') { + push @have, "$q;$r;$s"; +} +is ("@have", 'A;B;C D;E;F', 'explicit list triplets'); + +@have = (); + +for my ($q, $r, $s,) ('A', 'B', 'C', 'D', 'E', 'F') { + push @have, "$q;$r;$s"; +} +is ("@have", 'A;B;C D;E;F', 'trailing comma n-fold'); + +@have = (); + +for my ($q, $r, $s) ('A', 'B', 'C', 'D', 'E') { + push @have, join ';', map { $_ // 'undef' } $q, $r, $s; +} + +is ("@have", 'A;B;C D;E;undef', 'incomplete explicit list'); + +@have = (); + +for my ($q, $r, $s) (reverse 'A', 'B', 'C', 'D', 'E') { + push @have, join ';', map { $_ // 'undef' } $q, $r, $s; +} + +is ("@have", 'E;D;C B;A;undef', 'incomplete explicit list reversed'); + +# This two are legal syntax and actually indistinguishable from for my $q () ... +@have = (); + +for my ($q,) ('A', 'B', 'C', 'D', 'E', 'F') { + push @have, $q; +} +is ("@have", 'A B C D E F', 'trailing comma one-at-a-time'); + +@have = (); + +for my ($q) ('A', 'B', 'C', 'D', 'E', 'F') { + push @have, $q; +} +is ("@have", 'A B C D E F', 'one-at-a-time'); + + +# Arrays have an optimised case in pp_iter: +{ + no strict; + + @array = split ' ', 'Dogs have owners, cats have staff.'; + + @have = (); + + for my ($q, $r, $s) (@array) { + push @have, "$q;$r;$s"; + } + is ("@have", 'Dogs;have;owners, cats;have;staff.', 'package array'); + + @have = (); + + for my ($q, $r, $s) (reverse @array) { + push @have, "$q;$r;$s"; + } + is ("@have", 'staff.;have;cats owners,;have;Dogs', 'package array reversed'); + + @have = (); + + for my ($q, $r, $s, $t) (@array) { + push @have, join ';', map { $_ // '!' } $q, $r, $s, $t; + } + is ("@have", 'Dogs;have;owners,;cats have;staff.;!;!', 'incomplete package array'); + + @have = (); + + for my ($q, $r, $s, $t) (reverse @array) { + push @have, join ';', map { $_ // '!' } $q, $r, $s, $t; + } + is ("@have", 'staff.;have;cats;owners, have;Dogs;!;!', 'incomplete package array reversed'); + + # And for our last test, we trash @array + for my ($q, $r) (@array) { + ($q, $r) = ($r, $q); + } + is ("@array", 'have Dogs cats owners, staff. have', 'package array aliased'); +} + +my @array = split ' ', 'God is real, unless declared integer.'; + +@have = (); + +for my ($q, $r, $s) (@array) { + push @have, "$q;$r;$s"; +} +is ("@have", 'God;is;real, unless;declared;integer.', 'lexical array'); + +@have = (); + +for my ($q, $r, $s) (reverse @array) { + push @have, "$q;$r;$s"; +} +is ("@have", 'integer.;declared;unless real,;is;God', 'lexical array reversed'); + +@have = (); + +for my ($q, $r, $s, $t) (@array) { + push @have, join ';', map { $_ // '!' } $q, $r, $s, $t; +} +is ("@have", 'God;is;real,;unless declared;integer.;!;!', 'incomplete lexical array'); + +@have = (); + +for my ($q, $r, $s, $t) (reverse @array) { + push @have, join ';', map { $_ // '!' } $q, $r, $s, $t; +} +is ("@have", 'integer.;declared;unless;real, is;God;!;!', 'incomplete lexical array reversed'); + +for my ($q, $r) (@array) { + $q = uc $q; + $r = ucfirst $r; +} +is ("@array", 'GOD Is REAL, Unless DECLARED Integer.', 'lexical array aliased'); + +# Integer ranges have an optimised case in pp_iter: +@have = (); + +for my ($q, $r, $s) (0..5) { + push @have, "$q;$r;$s"; +} + +is ("@have", '0;1;2 3;4;5', 'integer list'); + +@have = (); + +for my ($q, $r, $s) (reverse 0..5) { + push @have, "$q;$r;$s"; +} + +is ("@have", '5;4;3 2;1;0', 'integer list reversed'); + +@have = (); + +for my ($q, $r, $s) (1..5) { + push @have, join ';', map { $_ // 'undef' } $q, $r, $s; +} + +is ("@have", '1;2;3 4;5;undef', 'incomplete integer list'); + +@have = (); + +for my ($q, $r, $s) (reverse 1..5) { + push @have, join ';', map { $_ // 'Thunderbirds are go' } $q, $r, $s; +} + +is ("@have", '5;4;3 2;1;Thunderbirds are go', 'incomplete integer list reversed'); + +# String ranges have an optimised case in pp_iter: +@have = (); + +for my ($q, $r, $s) ('A'..'F') { + push @have, "$q;$r;$s"; +} + +is ("@have", 'A;B;C D;E;F', 'string list'); + +@have = (); + +for my ($q, $r, $s) (reverse 'A'..'F') { + push @have, "$q;$r;$s"; +} + +is ("@have", 'F;E;D C;B;A', 'string list reversed'); + +@have = (); + +for my ($q, $r, $s) ('B'..'F') { + push @have, join ';', map { $_ // 'undef' } $q, $r, $s; +} + +is ("@have", 'B;C;D E;F;undef', 'incomplete string list'); + +@have = (); + +for my ($q, $r, $s) (reverse 'B'..'F') { + push @have, join ';', map { $_ // 'undef' } $q, $r, $s; +} + +is ("@have", 'F;E;D C;B;undef', 'incomplete string list reversed'); + +# Hashes are expanded as regular lists, so there's nothing particularly +# special here: +{ + no strict; + + %hash = ( + perl => 'rules', + beer => 'foamy', + ); + + @have = (); + + for my ($key, $value) (%hash) { + push @have, "$key;$value"; + } + + my $got = "@have"; + if ($got =~ /^perl/) { + is ($got, 'perl;rules beer;foamy', 'package hash key/value iteration'); + } + else { + is ($got, 'beer;foamy perl;rules', 'package hash key/value iteration'); + } + + @have = (); + + for my ($value, $key) (reverse %hash) { + push @have, "$key;$value"; + } + + $got = "@have"; + if ($got =~ /^perl/) { + is ($got, 'perl;rules beer;foamy', 'package hash key/value reverse iteration'); + } + else { + is ($got, 'beer;foamy perl;rules', 'package hash key/value reverse iteration'); + } + + # values are aliases. As ever. Keys are copies. + + for my ($key, $value) (%hash) { + $key = ucfirst $key; + $value = uc $value; + } + + $got = join ';', %hash; + + if ($got =~ /^perl/i) { + is ($got, 'perl;RULES;beer;FOAMY', 'package hash value iteration aliases'); + } + else { + is ($got, 'beer;FOAMY;perl;RULES', 'package hash value iteration aliases'); + } +} + +my %hash = ( + beer => 'street', + gin => 'lane', +); + + +@have = (); + +for my ($key, $value) (%hash) { + push @have, "$key;$value"; +} + +my $got = "@have"; +if ($got =~ /^gin/) { + is ($got, 'gin;lane beer;street', 'lexical hash key/value iteration'); +} +else { + is ($got, 'beer;street gin;lane', 'lexical hash key/value iteration'); +} + +@have = (); + +for my ($value, $key) (reverse %hash) { + push @have, "$key;$value"; +} + +$got = "@have"; +if ($got =~ /^gin/) { + is ($got, 'gin;lane beer;street', 'lexical hash key/value reverse iteration'); +} +else { + is ($got, 'beer;street gin;lane', 'lexical hash key/value reverse iteration'); +} + +# values are aliases, keys are copies, so this is a daft thing to do: + +for my ($key, $value) (%hash) { + ($key, $value) = ($value, $key); +} + +$got = join ';', %hash; + +if ($got =~ /^gin/i) { + is ($got, 'gin;gin;beer;beer', 'lexical hash value iteration aliases'); +} +else { + is ($got, 'beer;beer;gin;gin', 'lexical hash value iteration aliases'); +} + +my $code = 'for my ($q, $r) (6, 9) {}; 42'; + +$got = eval $code; + +is ($@, "", 'test code generated no error'); +is ($got, 42, 'test code ran'); + +$code =~ s/my/our/; + +like ($code, qr/for our \(/, 'for our code set up correctly'); +$got = eval $code; + +like ($@, qr/^Missing \$ on loop variable /, 'for our code generated error'); +is ($got, undef, 'for our did not run'); + +$code =~ s/ our//; + +like ($code, qr/for \(/, 'for () () code set up correctly'); +$got = eval "no strict 'vars'; $code"; + +like ($@, qr/^syntax error /, 'for () () code generated error'); +is ($got, undef, 'for () () did not run'); + +done_testing();