Regression tests and documentation for n-at-a-time for.

3 files changed, 400 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index c407c3a730..88b7acdc82 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5835,6 +5835,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 48b0e1c2d7..a76bb1cf27 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<try> feature, the following may also be used
 
     try BLOCK catch (VAR) BLOCK
@@ -549,6 +557,24 @@ followed by C<my>.  To use this form, you must enable the C<refaliasing>
 feature via C<use feature>.  (See L<feature>.  See also L<perlref/Assigning
 to References>.)
 
+As of Perl 5.36, you can iterate over a list of lexical scalars n-at-a-time.
+You can only iterate over scalars - unlike list assignment, it's not
+possible to use C<undef> to signify a value that isn't wanted.  This is a
+limitation of the current implementation, and might be changed in the
+future.
+
+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
+aliases to C<undef>, as if the LIST had C<, undef> appended as many times as
+needed for its length to become an exact multiple.  This happens whether
+LIST is a literal LIST or an array - ie arrays are not extended if their
+size is not a multiple of the iteration size, consistent with iterating an
+array one-at-a-time.  As these padding elements are not lvalues, attempting
+to modify them will fail, consistent with the behaviour when iterating a
+list with literal C<undef>s.  If this is not the behaviour you desire, then
+before the loop starts either explicitly extend your array to be an exact
+multiple, or explicitly throw an exception.
+
 Examples:
 
     for (@ary) { s/foo/bar/ }
@@ -574,6 +600,17 @@ Examples:
         # do something with 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 immediately copied to a flat list before the loop
+        # starts. The list contains copies of keys but aliases of values.
+        # 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 0000000000..df821603d0
--- /dev/null
+++ b/t/op/for-many.t
@@ -0,0 +1,362 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require "./test.pl";
+    set_up_inc('../lib');
+}
+
+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.';
+
+    my $count = scalar @array;
+
+    @have = ();
+
+    for my ($q, $r, $s) (@array) {
+        push @have, "$q;$r;$s";
+    }
+    is("@have", 'Dogs;have;owners, cats;have;staff.', 'package array');
+    is(scalar @array, $count, 'package array size unchanged');
+
+    @have = ();
+
+    for my ($q, $r, $s) (reverse @array) {
+        push @have, "$q;$r;$s";
+    }
+    is("@have", 'staff.;have;cats owners,;have;Dogs', 'package array reversed');
+    is(scalar @array, $count, 'package array reversed size unchanged');
+
+    @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');
+    is(scalar @array, $count, 'incomplete package array size unchanged');
+
+    # 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');
+    is(scalar @array, $count, 'incomplete package array reversed size unchanged');
+}
+
+my @array = split ' ', 'God is real, unless declared integer.';
+
+my $count = scalar @array;
+
+@have = ();
+
+for my ($q, $r, $s) (@array) {
+    push @have, "$q;$r;$s";
+}
+is("@have", 'God;is;real, unless;declared;integer.', 'lexical array');
+is(scalar @array, $count, 'lexical array size unchanged');
+
+@have = ();
+
+for my ($q, $r, $s) (reverse @array) {
+    push @have, "$q;$r;$s";
+}
+is("@have", 'integer.;declared;unless real,;is;God', 'lexical array reversed');
+is(scalar @array, $count, 'lexical array reversed size unchanged');
+
+@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');
+is(scalar @array, $count, 'incomplete lexical array size unchanged');
+
+@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');
+is(scalar @array, $count, 'incomplete lexical array reversed size unchanged');
+
+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();