BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
use strict;
use warnings;
-use Test::More tests => 122;
+plan tests => 128;
# 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
# the switch ops themselves.
-
use feature 'switch';
}
{
no warnings "uninitialized";
- my $ok = 0;
- given (undef) { when(0) {$ok = 1} }
+ my $ok = 1;
+ given (undef) { when(0) {$ok = 0} }
is($ok, 1, "Given(undef) when(0)");
}
{
no warnings "uninitialized";
my $undef;
- my $ok = 0;
- given ($undef) { when(0) {$ok = 1} }
+ my $ok = 1;
+ given ($undef) { when(0) {$ok = 0} }
is($ok, 1, 'Given($undef) when(0)');
}
########
}
{
no warnings "uninitialized";
- my $ok = 0;
- given (undef) { when("") {$ok = 1} }
+ my $ok = 1;
+ given (undef) { when("") {$ok = 0} }
is($ok, 1, 'Given(undef) when("")');
}
{
no warnings "uninitialized";
my $undef;
- my $ok = 0;
- given ($undef) { when("") {$ok = 1} }
+ my $ok = 1;
+ given ($undef) { when("") {$ok = 0} }
is($ok, 1, 'Given($undef) when("")');
}
########
is($ok, 'y', "Optimized-away comparison");
}
+{
+ my $ok;
+ given(23) {
+ when (scalar 24) { $ok = 'n'; continue }
+ default { $ok = 'y' }
+ }
+ is($ok,'y','scalar()');
+}
+
# File tests
# (How to be both thorough and portable? Pinch a few ideas
# from t/op/filetest.t. We err on the side of portability for
}
is($letter, "a,c,e,", "next LABEL in when");
+# Test goto with given/when
+{
+ my $flag = 0;
+ goto GIVEN1;
+ $flag = 1;
+ GIVEN1: given ($flag) {
+ when (0) { break; }
+ $flag = 2;
+ }
+ is($flag, 0, "goto GIVEN1");
+}
+{
+ my $flag = 0;
+ given ($flag) {
+ when (0) { $flag = 1; }
+ goto GIVEN2;
+ $flag = 2;
+ }
+GIVEN2:
+ is($flag, 1, "goto inside given");
+}
+{
+ my $flag = 0;
+ given ($flag) {
+ when (0) { $flag = 1; goto GIVEN3; $flag = 2; }
+ $flag = 3;
+ }
+GIVEN3:
+ is($flag, 1, "goto inside given and when");
+}
+{
+ my $flag = 0;
+ for ($flag) {
+ when (0) { $flag = 1; goto GIVEN4; $flag = 2; }
+ $flag = 3;
+ }
+GIVEN4:
+ is($flag, 1, "goto inside for and when");
+}
+{
+ my $flag = 0;
+GIVEN5:
+ given ($flag) {
+ when (0) { $flag = 1; goto GIVEN5; $flag = 2; }
+ when (1) { break; }
+ $flag = 3;
+ }
+ is($flag, 1, "goto inside given and when to the given stmt");
+}
+
# Okay, that'll do for now. The intricacies of the smartmatch
# semantics are tested in t/op/smartmatch.t
__END__