use strict;
use warnings;
-use Test::More tests => 113;
+use Test::More tests => 118;
# The behaviour of the feature pragma should be tested by lib/switch.t
# using the tests in t/lib/switch/*. This file tests the behaviour of
{ package OverloadTest;
use overload '""' => sub{"string value of obj"};
+ use overload 'eq' => sub{"$_[0]" eq "$_[1]"};
use overload "~~" => sub {
my ($self, $other, $reversed) = @_;
default {$matched = 0}
}
- is($obj->{called}, 1, "$test: called");
- ok($matched, "$test: matched");
- is($obj->{left}, "string value of obj", "$test: left");
- is($obj->{right}, "other arg", "$test: right");
- ok(!$obj->{reversed}, "$test: not reversed");
+ is($obj->{called}, 0, "$test: called");
+ ok(!$matched, "$test: not matched");
}
{
when ("other arg") {$matched = 1}
}
- is($obj->{called}, 1, "$test: called");
+ is($obj->{called}, 0, "$test: called");
ok(!$matched, "$test: not matched");
- is($obj->{left}, "string value of obj", "$test: left");
- is($obj->{right}, "other arg", "$test: right");
- ok(!$obj->{reversed}, "$test: not reversed");
}
{
ok($obj->{reversed}, "$test: reversed");
}
}
+
+# Postfix when
+{
+ my $ok;
+ given (undef) {
+ $ok = 1 when undef;
+ }
+ is($ok, 1, "postfix undef");
+}
+{
+ my $ok;
+ given (2) {
+ $ok += 1 when 7;
+ $ok += 2 when 9.1685;
+ $ok += 4 when $_ > 4;
+ $ok += 8 when $_ < 2.5;
+ }
+ is($ok, 8, "postfix numeric");
+}
+{
+ my $ok;
+ given ("apple") {
+ $ok = 1, continue when $_ eq "apple";
+ $ok += 2;
+ $ok = 0 when "banana";
+ }
+ is($ok, 3, "postfix string");
+}
+{
+ my $ok;
+ given ("pear") {
+ do { $ok = 1; continue } when /pea/;
+ $ok += 2;
+ $ok = 0 when /pie/;
+ default { $ok += 4 }
+ $ok = 0;
+ }
+ is($ok, 7, "postfix regex");
+}
+# be_true is defined at the beginning of the file
+{
+ my $x = "what";
+ given(my $x = "foo") {
+ do {
+ is($x, "foo", "scope inside ... when my \$x = ...");
+ continue;
+ } when be_true(my $x = "bar");
+ is($x, "bar", "scope after ... when my \$x = ...");
+ }
+}
+{
+ my $x = 0;
+ given(my $x = 1) {
+ my $x = 2, continue when be_true();
+ is($x, undef, "scope after my \$x = ... when ...");
+ }
+}
+
+# Tests for last and next in when clauses
+my $letter;
+
+$letter = '';
+for ("a".."e") {
+ given ($_) {
+ $letter = $_;
+ when ("b") { last }
+ }
+ $letter = "z";
+}
+is($letter, "b", "last in when");
+
+$letter = '';
+LETTER1: for ("a".."e") {
+ given ($_) {
+ $letter = $_;
+ when ("b") { last LETTER1 }
+ }
+ $letter = "z";
+}
+is($letter, "b", "last LABEL in when");
+
+$letter = '';
+for ("a".."e") {
+ given ($_) {
+ when (/b|d/) { next }
+ $letter .= $_;
+ }
+ $letter .= ',';
+}
+is($letter, "a,c,e,", "next in when");
+
+$letter = '';
+LETTER2: for ("a".."e") {
+ given ($_) {
+ when (/b|d/) { next LETTER2 }
+ $letter .= $_;
+ }
+ $letter .= ',';
+}
+is($letter, "a,c,e,", "next LABEL in when");
+
# Okay, that'll do for now. The intricacies of the smartmatch
# semantics are tested in t/op/smartmatch.t
__END__