=head2 Statement Modifiers
X<statement modifier> X<modifier> X<if> X<unless> X<while>
-X<until> X<when> X<foreach> X<for>
+X<until> X<whereso> X<foreach> X<for>
Any simple statement may optionally be followed by a I<SINGLE> modifier,
just before the terminating semicolon (or block ending). The possible
until EXPR
for LIST
foreach LIST
- when EXPR
+ whereso EXPR
The C<EXPR> following the modifier is referred to as the "condition".
Its truth or falsehood determines how the modifier will behave.
version of perl you try it out on. Here be dragons.
X<my>
-The C<when> modifier is an experimental feature that first appeared in
-Perl 5.12, but behaved quite differently from its present form prior
-to Perl 5.28. To use it, you should include a C<use feature 'switch'>
+The C<whereso> modifier is an experimental feature that first appeared
+with this spelling in Perl 5.28.
+To use it, you should include a C<use feature 'switch'>
declaration, or a declaration that implies it. It behaves like the full
-C<when> statement with block, described in L</"Switch Statements"> below.
+C<whereso> statement with block, described in L</"Switch Statements"> below.
It executes the statement only if the I<EXPR> is true. If the statement
executes, control then implicitly jumps to the end of the dynamically
enclosing loop (usually a C<given> block).
given (EXPR) BLOCK
- when (EXPR) BLOCK
+ whereso (EXPR) BLOCK
LABEL while (EXPR) BLOCK
LABEL while (EXPR) BLOCK continue BLOCK
PHASE BLOCK
-The experimental C<given> and C<when> statements are I<not
+The experimental C<given> and C<whereso> statements are I<not
automatically enabled>; see L</"Switch Statements"> below for how to do
so, and the attendant caveats.
=head2 Switch Statements
-X<switch> X<case> X<given> X<when>
+X<switch> X<case> X<given> X<whereso>
-C<given>, C<when>, and related keywords make up an experimental feature
+C<given>, C<whereso>, and related keywords make up an experimental feature
that first appeared in Perl 5.10, but behaved quite differently from
its present form prior to Perl 5.28. To use it, you should declare
use v5.14;
Under the "switch" feature, Perl gains the experimental keywords C<given>
-and C<when>. Starting from Perl 5.16, one can
+and C<whereso>. Starting from Perl 5.16, one can
prefix the switch keywords with C<CORE::> to access the feature without
a C<use feature> statement.
The "switch" feature is considered highly experimental; it is subject
-to change with little notice. Uses of the C<given> and C<when> keywords
+to change with little notice. Uses of the C<given> and C<whereso> keywords
will by default warn about their experimental status. Due to historical
links between the two features, these warnings are in the same category
as warnings about the C<~~> (smartmatch) operator being experimental.
-The keywords C<given> and C<when> are analogous to C<switch> and C<case>
+The keywords C<given> and C<whereso> are analogous to C<switch> and C<case>
in C. They're meant to be used together, but can actually be used
independently and mixed with other kinds of compound statement.
of loop control, so the C<redo> operator can be used to restart its block,
and C<next> or C<last> can be used to exit the block early.
-C<when> evaluates its argument as a truth value. If the argument
+C<whereso> evaluates its argument as a truth value. If the argument
was false then it does not execute its block, and proceeds to the
following statement. If the argument was true, it executes the block,
then implicitly performs a C<next>, jumping to the end of the closest
use v5.10.1;
given ($var) {
- when (/^abc/) { $abc = 1 }
- when (/^def/) { $def = 1 }
- when (/^xyz/) { $xyz = 1 }
+ whereso (/^abc/) { $abc = 1 }
+ whereso (/^def/) { $def = 1 }
+ whereso (/^xyz/) { $xyz = 1 }
$nothing = 1;
}
-Or if you prefer the modifier form of C<when>, it can be written with
+Or if you prefer the modifier form of C<whereso>, it can be written with
less punctuation as
use v5.14;
given ($var) {
- $abc = 1 when /^abc/;
- $def = 1 when /^def/;
- $xyz = 1 when /^xyz/;
+ $abc = 1 whereso /^abc/;
+ $def = 1 whereso /^def/;
+ $xyz = 1 whereso /^xyz/;
$nothing = 1;
}
-You can use the C<continue> keyword to exit a C<when>
+You can use the C<continue> keyword to exit a C<whereso>
block, proceeding to the following statement. This is most commonly
done last thing inside the block, to override the implicit C<next>.
For example
given($foo) {
- when (/x/) { say '$foo contains an x'; continue }
- when (/y/) { say '$foo contains a y' }
+ whereso (/x/) { say '$foo contains an x'; continue }
+ whereso (/y/) { say '$foo contains a y' }
say '$foo does not contain a y';
}
=item *
The value of the last evaluated expression of the successful
-C<when> clause, if there happens to be one.
+C<whereso> clause, if there happens to be one.
=item *
In both last cases, the last expression is evaluated in the context that
was applied to the C<given> block.
-Note that, unlike C<if> and C<unless>, failed C<when> statements always
+Note that, unlike C<if> and C<unless>, failed C<whereso> statements always
evaluate to an empty list.
-On versions of Perl preceding Perl 5.28, C<given> and C<when> behave
+On versions of Perl preceding Perl 5.28, C<given> and C<whereso> behave
quite differently from their present behaviour. If your code needs to
-run on older versions, avoid C<given> and C<when>.
+run on older versions, avoid C<given> and C<whereso>.
=head2 Goto
X<goto>
# Before loading feature, test the switch ops with CORE::
CORE::given(3) {
- CORE::when(3) { pass "CORE::given and CORE::when"; continue }
+ CORE::whereso(3) { pass "CORE::given and CORE::whereso"; continue }
pass "continue (without feature)";
}
sub be_true {1}
given(my $x = "foo") {
- when(be_true(my $x = "bar")) {
+ whereso(be_true(my $x = "bar")) {
is($x, "bar", "given scope starts");
}
is($x, "foo", "given scope ends");
{
my $ok;
given(3) {
- when($_ == 2) { $ok = 'two'; }
- when($_ == 3) { $ok = 'three'; }
- when($_ == 4) { $ok = 'four'; }
+ whereso($_ == 2) { $ok = 'two'; }
+ whereso($_ == 3) { $ok = 'three'; }
+ whereso($_ == 4) { $ok = 'four'; }
$ok = 'd';
}
is($ok, 'three', "numeric comparison");
my $ok;
use integer;
given(3.14159265) {
- when($_ == 2) { $ok = 'two'; }
- when($_ == 3) { $ok = 'three'; }
- when($_ == 4) { $ok = 'four'; }
+ whereso($_ == 2) { $ok = 'two'; }
+ whereso($_ == 3) { $ok = 'three'; }
+ whereso($_ == 4) { $ok = 'four'; }
$ok = 'd';
}
is($ok, 'three', "integer comparison");
{
my ($ok1, $ok2);
given(3) {
- when($_ == 3.1) { $ok1 = 'n'; }
- when($_ == 3.0) { $ok1 = 'y'; continue }
- when($_ == "3.0") { $ok2 = 'y'; }
+ whereso($_ == 3.1) { $ok1 = 'n'; }
+ whereso($_ == 3.0) { $ok1 = 'y'; continue }
+ whereso($_ == "3.0") { $ok2 = 'y'; }
$ok2 = 'n';
}
is($ok1, 'y', "more numeric (pt. 1)");
{
my $ok;
given("c") {
- when($_ eq "b") { $ok = 'B'; }
- when($_ eq "c") { $ok = 'C'; }
- when($_ eq "d") { $ok = 'D'; }
+ whereso($_ eq "b") { $ok = 'B'; }
+ whereso($_ eq "c") { $ok = 'C'; }
+ whereso($_ eq "d") { $ok = 'D'; }
$ok = 'def';
}
is($ok, 'C', "string comparison");
{
my $ok;
given("c") {
- when($_ eq "b") { $ok = 'B'; }
- when($_ eq "c") { $ok = 'C'; continue }
- when($_ eq "c") { $ok = 'CC'; }
+ whereso($_ eq "b") { $ok = 'B'; }
+ whereso($_ eq "c") { $ok = 'C'; continue }
+ whereso($_ eq "c") { $ok = 'CC'; }
$ok = 'D';
}
is($ok, 'CC', "simple continue");
# Definedness
{
my $ok = 1;
- given (0) { when(!defined) {$ok = 0} }
- is($ok, 1, "Given(0) when(!defined)");
+ given (0) { whereso(!defined) {$ok = 0} }
+ is($ok, 1, "Given(0) whereso(!defined)");
}
{
no warnings "uninitialized";
my $ok = 1;
- given (undef) { when(0) {$ok = 0} }
- is($ok, 1, "Given(undef) when(0)");
+ given (undef) { whereso(0) {$ok = 0} }
+ is($ok, 1, "Given(undef) whereso(0)");
}
{
no warnings "uninitialized";
my $undef;
my $ok = 1;
- given ($undef) { when(0) {$ok = 0} }
- is($ok, 1, 'Given($undef) when(0)');
+ given ($undef) { whereso(0) {$ok = 0} }
+ is($ok, 1, 'Given($undef) whereso(0)');
}
########
{
my $ok = 1;
- given ("") { when(!defined) {$ok = 0} }
- is($ok, 1, 'Given("") when(!defined)');
+ given ("") { whereso(!defined) {$ok = 0} }
+ is($ok, 1, 'Given("") whereso(!defined)');
}
{
no warnings "uninitialized";
my $ok = 1;
- given (undef) { when(0) {$ok = 0} }
- is($ok, 1, 'Given(undef) when(0)');
+ given (undef) { whereso(0) {$ok = 0} }
+ is($ok, 1, 'Given(undef) whereso(0)');
}
########
{
my $ok = 0;
- given (undef) { when(!defined) {$ok = 1} }
- is($ok, 1, "Given(undef) when(!defined)");
+ given (undef) { whereso(!defined) {$ok = 1} }
+ is($ok, 1, "Given(undef) whereso(!defined)");
}
{
my $undef;
my $ok = 0;
- given ($undef) { when(!defined) {$ok = 1} }
- is($ok, 1, 'Given($undef) when(!defined)');
+ given ($undef) { whereso(!defined) {$ok = 1} }
+ is($ok, 1, 'Given($undef) whereso(!defined)');
}
{
my ($ok1, $ok2);
given("Hello, world!") {
- when(/lo/)
+ whereso(/lo/)
{ $ok1 = 'y'; continue}
- when(/no/)
+ whereso(/no/)
{ $ok1 = 'n'; continue}
- when(/^(Hello,|Goodbye cruel) world[!.?]/)
+ whereso(/^(Hello,|Goodbye cruel) world[!.?]/)
{ $ok2 = 'Y'; continue}
- when(/^(Hello cruel|Goodbye,) world[!.?]/)
+ whereso(/^(Hello cruel|Goodbye,) world[!.?]/)
{ $ok2 = 'n'; continue}
}
is($ok1, 'y', "regex 1");
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ < 10) { $ok = "ten" }
- when ($_ < 20) { $ok = "twenty" }
- when ($_ < 30) { $ok = "thirty" }
- when ($_ < 40) { $ok = "forty" }
+ whereso ($_ < 10) { $ok = "ten" }
+ whereso ($_ < 20) { $ok = "twenty" }
+ whereso ($_ < 30) { $ok = "thirty" }
+ whereso ($_ < 40) { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ < 10) { $ok = "ten" }
- when ($_ < 20) { $ok = "twenty" }
- when ($_ < 30) { $ok = "thirty" }
- when ($_ < 40) { $ok = "forty" }
+ whereso ($_ < 10) { $ok = "ten" }
+ whereso ($_ < 20) { $ok = "twenty" }
+ whereso ($_ < 30) { $ok = "thirty" }
+ whereso ($_ < 40) { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ <= 10) { $ok = "ten" }
- when ($_ <= 20) { $ok = "twenty" }
- when ($_ <= 30) { $ok = "thirty" }
- when ($_ <= 40) { $ok = "forty" }
+ whereso ($_ <= 10) { $ok = "ten" }
+ whereso ($_ <= 20) { $ok = "twenty" }
+ whereso ($_ <= 30) { $ok = "thirty" }
+ whereso ($_ <= 40) { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ <= 10) { $ok = "ten" }
- when ($_ <= 20) { $ok = "twenty" }
- when ($_ <= 30) { $ok = "thirty" }
- when ($_ <= 40) { $ok = "forty" }
+ whereso ($_ <= 10) { $ok = "ten" }
+ whereso ($_ <= 20) { $ok = "twenty" }
+ whereso ($_ <= 30) { $ok = "thirty" }
+ whereso ($_ <= 40) { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ > 40) { $ok = "forty" }
- when ($_ > 30) { $ok = "thirty" }
- when ($_ > 20) { $ok = "twenty" }
- when ($_ > 10) { $ok = "ten" }
+ whereso ($_ > 40) { $ok = "forty" }
+ whereso ($_ > 30) { $ok = "thirty" }
+ whereso ($_ > 20) { $ok = "twenty" }
+ whereso ($_ > 10) { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ >= 40) { $ok = "forty" }
- when ($_ >= 30) { $ok = "thirty" }
- when ($_ >= 20) { $ok = "twenty" }
- when ($_ >= 10) { $ok = "ten" }
+ whereso ($_ >= 40) { $ok = "forty" }
+ whereso ($_ >= 30) { $ok = "thirty" }
+ whereso ($_ >= 20) { $ok = "twenty" }
+ whereso ($_ >= 10) { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ > 40) { $ok = "forty" }
- when ($_ > 30) { $ok = "thirty" }
- when ($_ > 20) { $ok = "twenty" }
- when ($_ > 10) { $ok = "ten" }
+ whereso ($_ > 40) { $ok = "forty" }
+ whereso ($_ > 30) { $ok = "thirty" }
+ whereso ($_ > 20) { $ok = "twenty" }
+ whereso ($_ > 10) { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ >= 40) { $ok = "forty" }
- when ($_ >= 30) { $ok = "thirty" }
- when ($_ >= 20) { $ok = "twenty" }
- when ($_ >= 10) { $ok = "ten" }
+ whereso ($_ >= 40) { $ok = "forty" }
+ whereso ($_ >= 30) { $ok = "thirty" }
+ whereso ($_ >= 20) { $ok = "twenty" }
+ whereso ($_ >= 10) { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
my $twenty_five = "25";
my $ok;
given($twenty_five) {
- when ($_ lt "10") { $ok = "ten" }
- when ($_ lt "20") { $ok = "twenty" }
- when ($_ lt "30") { $ok = "thirty" }
- when ($_ lt "40") { $ok = "forty" }
+ whereso ($_ lt "10") { $ok = "ten" }
+ whereso ($_ lt "20") { $ok = "twenty" }
+ whereso ($_ lt "30") { $ok = "thirty" }
+ whereso ($_ lt "40") { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = "25";
my $ok;
given($twenty_five) {
- when ($_ le "10") { $ok = "ten" }
- when ($_ le "20") { $ok = "twenty" }
- when ($_ le "30") { $ok = "thirty" }
- when ($_ le "40") { $ok = "forty" }
+ whereso ($_ le "10") { $ok = "ten" }
+ whereso ($_ le "20") { $ok = "twenty" }
+ whereso ($_ le "30") { $ok = "thirty" }
+ whereso ($_ le "40") { $ok = "forty" }
$ok = "default";
}
is($ok, "thirty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ ge "40") { $ok = "forty" }
- when ($_ ge "30") { $ok = "thirty" }
- when ($_ ge "20") { $ok = "twenty" }
- when ($_ ge "10") { $ok = "ten" }
+ whereso ($_ ge "40") { $ok = "forty" }
+ whereso ($_ ge "30") { $ok = "thirty" }
+ whereso ($_ ge "20") { $ok = "twenty" }
+ whereso ($_ ge "10") { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
my $twenty_five = 25;
my $ok;
given($twenty_five) {
- when ($_ ge "40") { $ok = "forty" }
- when ($_ ge "30") { $ok = "thirty" }
- when ($_ ge "20") { $ok = "twenty" }
- when ($_ ge "10") { $ok = "ten" }
+ whereso ($_ ge "40") { $ok = "forty" }
+ whereso ($_ ge "30") { $ok = "thirty" }
+ whereso ($_ ge "20") { $ok = "twenty" }
+ whereso ($_ ge "10") { $ok = "ten" }
$ok = "default";
}
is($ok, "twenty", $test);
{
my $ok;
given(23) {
- when (2 + 2 == 4) { $ok = 'y'; continue }
- when (2 + 2 == 5) { $ok = 'n' }
+ whereso (2 + 2 == 4) { $ok = 'y'; continue }
+ whereso (2 + 2 == 5) { $ok = 'n' }
}
is($ok, 'y', "Optimized-away comparison");
}
{
my $ok;
given(23) {
- when ($_ == scalar 24) { $ok = 'n'; continue }
+ whereso ($_ == scalar 24) { $ok = 'n'; continue }
$ok = 'y';
}
is($ok,'y','scalar()');
{
my ($ok_d, $ok_f, $ok_r);
given("op") {
- when(-d) {$ok_d = 1; continue}
- when(!-f) {$ok_f = 1; continue}
- when(-r) {$ok_r = 1; continue}
+ whereso(-d) {$ok_d = 1; continue}
+ whereso(!-f) {$ok_f = 1; continue}
+ whereso(-r) {$ok_r = 1; continue}
}
ok($ok_d, "Filetest -d");
ok($ok_f, "Filetest -f");
{
my $ok = 0;
given("foo") {
- when(notfoo()) {$ok = 1}
+ whereso(notfoo()) {$ok = 1}
}
ok($ok, "Sub call acts as boolean")
}
{
my $ok = 0;
given("foo") {
- when(main->notfoo()) {$ok = 1}
+ whereso(main->notfoo()) {$ok = 1}
}
ok($ok, "Class-method call acts as boolean")
}
my $ok = 0;
my $obj = bless [];
given("foo") {
- when($obj->notfoo()) {$ok = 1}
+ whereso($obj->notfoo()) {$ok = 1}
}
ok($ok, "Object-method call acts as boolean")
}
{
my $ok = 0;
given(12) {
- when( /(\d+)/ and ( 1 <= $1 and $1 <= 12 ) ) {
+ whereso( /(\d+)/ and ( 1 <= $1 and $1 <= 12 ) ) {
$ok = 1;
}
}
{
my $ok = 0;
given(0) {
- when(eof(DATA)) {
+ whereso(eof(DATA)) {
$ok = 1;
}
}
my $ok = 0;
my %foo = ("bar", 0);
given(0) {
- when(exists $foo{bar}) {
+ whereso(exists $foo{bar}) {
$ok = 1;
}
}
{
my $ok = 0;
given(0) {
- when(defined $ok) {
+ whereso(defined $ok) {
$ok = 1;
}
}
{
my $ok = 1;
given("foo") {
- when((1 == 1) && "bar") {
+ whereso((1 == 1) && "bar") {
$ok = 2;
}
- when((1 == 1) && $_ eq "foo") {
+ whereso((1 == 1) && $_ eq "foo") {
$ok = 0;
}
}
my $n = 0;
for my $l (qw(a b c d)) {
given ($l) {
- when ($_ eq "b" .. $_ eq "c") { $n = 1 }
+ whereso ($_ eq "b" .. $_ eq "c") { $n = 1 }
$n = 0;
}
- ok(($n xor $l =~ /[ad]/), 'when(E1..E2) evaluates in boolean context');
+ ok(($n xor $l =~ /[ad]/), 'whereso(E1..E2) evaluates in boolean context');
}
}
my $n = 0;
for my $l (qw(a b c d)) {
given ($l) {
- when ($_ eq "b" ... $_ eq "c") { $n = 1 }
+ whereso ($_ eq "b" ... $_ eq "c") { $n = 1 }
$n = 0;
}
- ok(($n xor $l =~ /[ad]/), 'when(E1...E2) evaluates in boolean context');
+ ok(($n xor $l =~ /[ad]/), 'whereso(E1...E2) evaluates in boolean context');
}
}
{
my $ok = 0;
given("foo") {
- when((1 == $ok) || "foo") {
+ whereso((1 == $ok) || "foo") {
$ok = 1;
}
}
{
my $ok = 0;
given("foo") {
- when((1 == $ok || undef) // "foo") {
+ whereso((1 == $ok || undef) // "foo") {
$ok = 1;
}
}
{ my $test_name = "Multiple FETCHes in given, due to aliasing";
my $ok;
given($v = 23) {
- when(!defined) {}
- when(sub{0}->()) {}
- when($_ == 21) {}
- when($_ == "22") {}
- when($_ == 23) {$ok = 1}
- when(/24/) {$ok = 0}
+ whereso(!defined) {}
+ whereso(sub{0}->()) {}
+ whereso($_ == 21) {}
+ whereso($_ == "22") {}
+ whereso($_ == 23) {$ok = 1}
+ whereso(/24/) {$ok = 0}
}
is($ok, 1, "precheck: $test_name");
is($f->count(), 4, $test_name);
}
-{ my $test_name = "Only one FETCH (numeric when)";
+{ my $test_name = "Only one FETCH (numeric whereso)";
my $ok;
$v = 23;
is($f->count(), 0, "Sanity check: $test_name");
given(23) {
- when(!defined) {}
- when(sub{0}->()) {}
- when($_ == 21) {}
- when($_ == "22") {}
- when($_ == $v) {$ok = 1}
- when(/24/) {$ok = 0}
+ whereso(!defined) {}
+ whereso(sub{0}->()) {}
+ whereso($_ == 21) {}
+ whereso($_ == "22") {}
+ whereso($_ == $v) {$ok = 1}
+ whereso(/24/) {$ok = 0}
}
is($ok, 1, "precheck: $test_name");
is($f->count(), 1, $test_name);
}
-{ my $test_name = "Only one FETCH (string when)";
+{ my $test_name = "Only one FETCH (string whereso)";
my $ok;
$v = "23";
is($f->count(), 0, "Sanity check: $test_name");
given("23") {
- when(!defined) {}
- when(sub{0}->()) {}
- when($_ eq "21") {}
- when($_ eq "22") {}
- when($_ eq $v) {$ok = 1}
- when(/24/) {$ok = 0}
+ whereso(!defined) {}
+ whereso(sub{0}->()) {}
+ whereso($_ eq "21") {}
+ whereso($_ eq "22") {}
+ whereso($_ eq $v) {$ok = 1}
+ whereso(/24/) {$ok = 0}
}
is($ok, 1, "precheck: $test_name");
is($f->count(), 1, $test_name);
{
my $first = 1;
for (1, "two") {
- when ($_ eq "two") {
+ whereso ($_ eq "two") {
is($first, 0, "Loop: second");
}
- when ($_ == 1) {
+ whereso ($_ == 1) {
is($first, 1, "Loop: first");
$first = 0;
}
{
my $first = 1;
for $_ (1, "two") {
- when ($_ eq "two") {
+ whereso ($_ eq "two") {
is($first, 0, "Explicit \$_: second");
}
- when ($_ == 1) {
+ whereso ($_ == 1) {
is($first, 1, "Explicit \$_: first");
$first = 0;
}
sub bar {$called_bar = 1; "@_" eq "bar"}
my ($matched_foo, $matched_bar) = (0, 0);
given("foo") {
- when((\&bar)->($_)) {$matched_bar = 1}
- when((\&foo)->($_)) {$matched_foo = 1}
+ whereso((\&bar)->($_)) {$matched_bar = 1}
+ whereso((\&foo)->($_)) {$matched_foo = 1}
}
is($called_foo, 1, "foo() was called");
is($called_bar, 1, "bar() was called");
{
my ($ok1, $ok2) = (0,0);
given("foxy!") {
- when(contains_x($_))
+ whereso(contains_x($_))
{ $ok1 = 1; continue }
- when((\&contains_x)->($_))
+ whereso((\&contains_x)->($_))
{ $ok2 = 1; continue }
}
is($ok1, 1, "Calling sub directly (true)");
is($ok2, 1, "Calling sub indirectly (true)");
given("foggy") {
- when(contains_x($_))
+ whereso(contains_x($_))
{ $ok1 = 2; continue }
- when((\&contains_x)->($_))
+ whereso((\&contains_x)->($_))
{ $ok2 = 2; continue }
}
is($ok1, 1, "Calling sub directly (false)");
my($ea, $eb, $ec) = (0, 0, 0);
my $r;
given(3) {
- when(do { $ea++; $_ == 2 }) { $r = "two"; }
- when(do { $eb++; $_ == 3 }) { $r = "three"; }
- when(do { $ec++; $_ == 4 }) { $r = "four"; }
+ whereso(do { $ea++; $_ == 2 }) { $r = "two"; }
+ whereso(do { $eb++; $_ == 3 }) { $r = "three"; }
+ whereso(do { $ec++; $_ == 4 }) { $r = "four"; }
}
is $r, "three", "evaluation count";
is $ea, 1, "evaluation count";
is $ec, 0, "evaluation count";
}
-# Postfix when
+# Postfix whereso
{
my $ok;
given (undef) {
- $ok = 1 when !defined;
+ $ok = 1 whereso !defined;
}
is($ok, 1, "postfix !defined");
}
{
my $ok;
given (2) {
- $ok += 1 when $_ == 7;
- $ok += 2 when $_ == 9.1685;
- $ok += 4 when $_ > 4;
- $ok += 8 when $_ < 2.5;
+ $ok += 1 whereso $_ == 7;
+ $ok += 2 whereso $_ == 9.1685;
+ $ok += 4 whereso $_ > 4;
+ $ok += 8 whereso $_ < 2.5;
}
is($ok, 8, "postfix numeric");
}
{
my $ok;
given ("apple") {
- $ok = 1, continue when $_ eq "apple";
+ $ok = 1, continue whereso $_ eq "apple";
$ok += 2;
- $ok = 0 when $_ eq "banana";
+ $ok = 0 whereso $_ eq "banana";
}
is($ok, 3, "postfix string");
}
{
my $ok;
given ("pear") {
- do { $ok = 1; continue } when /pea/;
+ do { $ok = 1; continue } whereso /pea/;
$ok += 2;
- $ok = 0 when /pie/;
+ $ok = 0 whereso /pie/;
$ok += 4; next;
$ok = 0;
}
my $x = "what";
given(my $x = "foo") {
do {
- is($x, "foo", "scope inside ... when my \$x = ...");
+ is($x, "foo", "scope inside ... whereso my \$x = ...");
continue;
- } when be_true(my $x = "bar");
- is($x, "bar", "scope after ... when my \$x = ...");
+ } whereso be_true(my $x = "bar");
+ is($x, "bar", "scope after ... whereso my \$x = ...");
}
}
{
my $x = 0;
given(my $x = 1) {
- my $x = 2, continue when be_true();
- is($x, undef, "scope after my \$x = ... when ...");
+ my $x = 2, continue whereso be_true();
+ is($x, undef, "scope after my \$x = ... whereso ...");
}
}
-# Tests for last and next in when clauses
+# Tests for last and next in whereso clauses
my $letter;
$letter = '';
LETTER1: for ("a".."e") {
given ($_) {
$letter = $_;
- when ($_ eq "b") { last LETTER1 }
+ whereso ($_ eq "b") { last LETTER1 }
}
$letter = "z";
}
-is($letter, "b", "last LABEL in when");
+is($letter, "b", "last LABEL in whereso");
$letter = '';
LETTER2: for ("a".."e") {
given ($_) {
- when (/b|d/) { next LETTER2 }
+ whereso (/b|d/) { next LETTER2 }
$letter .= $_;
}
$letter .= ',';
}
-is($letter, "a,c,e,", "next LABEL in when");
+is($letter, "a,c,e,", "next LABEL in whereso");
-# Test goto with given/when
+# Test goto with given/whereso
{
my $flag = 0;
goto GIVEN1;
$flag = 1;
GIVEN1: given ($flag) {
- when ($_ == 0) { next; }
+ whereso ($_ == 0) { next; }
$flag = 2;
}
is($flag, 0, "goto GIVEN1");
{
my $flag = 0;
given ($flag) {
- when ($_ == 0) { $flag = 1; }
+ whereso ($_ == 0) { $flag = 1; }
goto GIVEN2;
$flag = 2;
}
{
my $flag = 0;
given ($flag) {
- when ($_ == 0) { $flag = 1; goto GIVEN3; $flag = 2; }
+ whereso ($_ == 0) { $flag = 1; goto GIVEN3; $flag = 2; }
$flag = 3;
}
GIVEN3:
- is($flag, 1, "goto inside given and when");
+ is($flag, 1, "goto inside given and whereso");
}
{
my $flag = 0;
for ($flag) {
- when ($_ == 0) { $flag = 1; goto GIVEN4; $flag = 2; }
+ whereso ($_ == 0) { $flag = 1; goto GIVEN4; $flag = 2; }
$flag = 3;
}
GIVEN4:
- is($flag, 1, "goto inside for and when");
+ is($flag, 1, "goto inside for and whereso");
}
{
my $flag = 0;
GIVEN5:
given ($flag) {
- when ($_ == 0) { $flag = 1; goto GIVEN5; $flag = 2; }
- when ($_ == 1) { next; }
+ whereso ($_ == 0) { $flag = 1; goto GIVEN5; $flag = 2; }
+ whereso ($_ == 1) { next; }
$flag = 3;
}
- is($flag, 1, "goto inside given and when to the given stmt");
+ is($flag, 1, "goto inside given and whereso to the given stmt");
}
# Test do { given } as a rvalue
no warnings 'void';
for (0, 1, 2) {
my $scalar = do { given ($_) {
- when ($_ == 0) { $lexical }
- when ($_ == 2) { 'void'; 8, 9 }
+ whereso ($_ == 0) { $lexical }
+ whereso ($_ == 2) { 'void'; 8, 9 }
@things;
} };
is($scalar, shift(@exp), "rvalue given - simple scalar [$_]");
for (0, 1, 2) {
no warnings 'void';
my $scalar = do { given ($_) {
- $lexical when $_ == 0;
- 8, 9 when $_ == 2;
+ $lexical whereso $_ == 0;
+ 8, 9 whereso $_ == 2;
6, 7;
} };
is($scalar, shift(@exp), "rvalue given - postfix scalar [$_]");
for (0, 1, 2) {
my $scalar = do { given ($_) {
no warnings 'void';
- when ($_ == 0) { 5 }
+ whereso ($_ == 0) { 5 }
8, 9;
} };
is($scalar, shift(@exp), "rvalue given - default scalar [$_]");
my @exp = ('3 4 5', '11 12 13', '8 9');
for (0, 1, 2) {
my @list = do { given ($_) {
- when ($_ == 0) { 3 .. 5 }
- when ($_ == 2) { my $fake = 'void'; 8, 9 }
+ whereso ($_ == 0) { 3 .. 5 }
+ whereso ($_ == 2) { my $fake = 'void'; 8, 9 }
@things;
} };
is("@list", shift(@exp), "rvalue given - simple list [$_]");
my @exp = ('3 4 5', '6 7', '12');
for (0, 1, 2) {
my @list = do { given ($_) {
- 3 .. 5 when $_ == 0;
- @things when $_ == 2;
+ 3 .. 5 whereso $_ == 0;
+ @things whereso $_ == 2;
6, 7;
} };
is("@list", shift(@exp), "rvalue given - postfix list [$_]");
my @exp = ('m o o', '8 10', '8 10');
for (0, 1, 2) {
my @list = do { given ($_) {
- when ($_ == 0) { "moo" =~ /(.)/g }
+ whereso ($_ == 0) { "moo" =~ /(.)/g }
8, scalar(@things);
} };
is("@list", shift(@exp), "rvalue given - default list [$_]");
my @exp = ('6 7', '', '6 7');
F: for (0, 1, 2, 3) {
my @list = do { given ($_) {
- continue when $_ <= 1;
- next when $_ == 1;
- next F when $_ == 2;
+ continue whereso $_ <= 1;
+ next whereso $_ == 1;
+ next F whereso $_ == 2;
6, 7;
} };
is("@list", shift(@exp), "rvalue given - default list [$_]");
# Context propagation
my $smart_hash = sub {
do { given ($_[0]) {
- 'undef' when !defined;
- when ($_ >= 1 && $_ <= 3) { 1 .. 3 }
- when ($_ == 4) { my $fake; do { 4, 5 } }
+ 'undef' whereso !defined;
+ whereso ($_ >= 1 && $_ <= 3) { 1 .. 3 }
+ whereso ($_ == 4) { my $fake; do { 4, 5 } }
} };
};
our $given_glob = 5;
local $given_loc = 6;
- when ($_ == 0) { 0 }
+ whereso ($_ == 0) { 0 }
- when ($_ == 1) { my $when_lex = 1 }
- when ($_ == 2) { our $when_glob = 2 }
- when ($_ == 3) { local $when_loc = 3 }
+ whereso ($_ == 1) { my $when_lex = 1 }
+ whereso ($_ == 2) { our $when_glob = 2 }
+ whereso ($_ == 3) { local $when_loc = 3 }
- when ($_ == 4) { $given_lex }
- when ($_ == 5) { $given_glob }
- when ($_ == 6) { $given_loc }
+ whereso ($_ == 4) { $given_lex }
+ whereso ($_ == 5) { $given_glob }
+ whereso ($_ == 6) { $given_loc }
- when ($_ == 7) { $ext_lex }
- when ($_ == 8) { $ext_glob }
- when ($_ == 9) { $ext_loc }
+ whereso ($_ == 7) { $ext_lex }
+ whereso ($_ == 8) { $ext_glob }
+ whereso ($_ == 9) { $ext_loc }
'fallback';
}
my @descriptions = qw<
constant
- when-lexical
- when-global
- when-local
+ whereso-lexical
+ whereso-global
+ whereso-local
given-lexical
given-global
my $id_plus_1 = $id + 1;
given ($id_plus_1) {
do {
- when (/\d/) {
+ whereso (/\d/) {
--$id_plus_1;
continue;
456;
}
}
-# Check that values returned from given/when are destroyed at the right time.
+# Check that values returned from given/whereso are destroyed at the right time.
{
{
package Fmurrr;
}
my @descriptions = qw<
- when
+ whereso
next
continue
default
my $res = do {
given ($id) {
my $x;
- when ($_ == 0) { Fmurrr->new($destroyed, 0) }
- when ($_ == 1) { my $y = Fmurrr->new($destroyed, 1); next }
- when ($_ == 2) { $x = Fmurrr->new($destroyed, 2); continue }
- when ($_ == 2) { $x }
+ whereso ($_ == 0) { Fmurrr->new($destroyed, 0) }
+ whereso ($_ == 1) { my $y = Fmurrr->new($destroyed, 1); next }
+ whereso ($_ == 2) { $x = Fmurrr->new($destroyed, 2); continue }
+ whereso ($_ == 2) { $x }
Fmurrr->new($destroyed, 3);
}
};
}
$res_id = $id if $id == 1; # next doesn't return anything
- is $res_id, $id, "given/when returns the right object - $desc";
- is $destroyed, 1, "given/when does not leak - $desc";
+ is $res_id, $id, "given/whereso returns the right object - $desc";
+ is $destroyed, 1, "given/whereso does not leak - $desc";
};
}
my @res = (1, do {
given ("x") {
2, 3, do {
- when (/[a-z]/) {
+ whereso (/[a-z]/) {
4, 5, 6, next
}
}
f2();
}
-# check that 'when' handles all 'for' loop types
+# check that 'whereso' handles all 'for' loop types
{
my $i;
$i = 0;
for (1..3) {
- when ($_ == 1) {$i += 1 }
- when ($_ == 2) {$i += 10 }
- when ($_ == 3) {$i += 100 }
+ whereso ($_ == 1) {$i += 1 }
+ whereso ($_ == 2) {$i += 10 }
+ whereso ($_ == 3) {$i += 100 }
$i += 1000;
}
- is($i, 111, "when in for 1..3");
+ is($i, 111, "whereso in for 1..3");
$i = 0;
for ('a'..'c') {
- when ($_ eq 'a') {$i += 1 }
- when ($_ eq 'b') {$i += 10 }
- when ($_ eq 'c') {$i += 100 }
+ whereso ($_ eq 'a') {$i += 1 }
+ whereso ($_ eq 'b') {$i += 10 }
+ whereso ($_ eq 'c') {$i += 100 }
$i += 1000;
}
- is($i, 111, "when in for a..c");
+ is($i, 111, "whereso in for a..c");
$i = 0;
for (1,2,3) {
- when ($_ == 1) {$i += 1 }
- when ($_ == 2) {$i += 10 }
- when ($_ == 3) {$i += 100 }
+ whereso ($_ == 1) {$i += 1 }
+ whereso ($_ == 2) {$i += 10 }
+ whereso ($_ == 3) {$i += 100 }
$i += 1000;
}
- is($i, 111, "when in for 1,2,3");
+ is($i, 111, "whereso in for 1,2,3");
$i = 0;
my @a = (1,2,3);
for (@a) {
- when ($_ == 1) {$i += 1 }
- when ($_ == 2) {$i += 10 }
- when ($_ == 3) {$i += 100 }
+ whereso ($_ == 1) {$i += 1 }
+ whereso ($_ == 2) {$i += 10 }
+ whereso ($_ == 3) {$i += 100 }
$i += 1000;
}
- is($i, 111, 'when in for @a');
+ is($i, 111, 'whereso in for @a');
}
https://perl5.git.perl.org / perl5.git / commitdiff