Rewrite tests for objects and ~~

[p5sagit/p5-mst-13.2.git] / t / op / switch.t

diff --git a/t/op/switch.t b/t/op/switch.t
index de44082..f4cedba 100644 (file)
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -8,7 +8,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 113;
+use Test::More tests => 124;
 
 # 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
@@ -860,6 +860,107 @@ SKIP: {
        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__