This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ex-PVBM and mro interact badly
[perl5.git] / t / op / switch.t
CommitLineData
0d863452
RH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8use strict;
9use warnings;
10
11use Test::More tests => 107;
12
13# The behaviour of the feature pragma should be tested by lib/switch.t
14# using the tests in t/lib/switch/*. This file tests the behaviour of
15# the switch ops themselves.
16
17
18use feature 'switch';
19no warnings "numeric";
20
21eval { continue };
22like($@, qr/^Can't "continue" outside/, "continue outside");
23
24eval { break };
25like($@, qr/^Can't "break" outside/, "break outside");
26
27# Scoping rules
28
29{
30 my $x = "foo";
31 given(my $x = "bar") {
32 is($x, "bar", "given scope starts");
33 }
34 is($x, "foo", "given scope ends");
35}
36
37sub be_true {1}
38
39given(my $x = "foo") {
40 when(be_true(my $x = "bar")) {
41 is($x, "bar", "given scope starts");
42 }
43 is($x, "foo", "given scope ends");
44}
45
46$_ = "outside";
47given("inside") { check_outside1() }
48sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
49
50{
51 my $_ = "outside";
52 given("inside") { check_outside2() }
53 sub check_outside2 {
54 is($_, "outside", "\$_ lexically scoped (lexical \$_)")
55 }
56}
57
58# Basic string/numeric comparisons and control flow
59
60{
cd9c531b 61 my $ok;
0d863452 62 given(3) {
cd9c531b
NC
63 when(2) { $ok = 'two'; }
64 when(3) { $ok = 'three'; }
65 when(4) { $ok = 'four'; }
66 default { $ok = 'd'; }
0d863452 67 }
cd9c531b 68 is($ok, 'three', "numeric comparison");
0d863452
RH
69}
70
71{
cd9c531b 72 my $ok;
0d863452
RH
73 use integer;
74 given(3.14159265) {
cd9c531b
NC
75 when(2) { $ok = 'two'; }
76 when(3) { $ok = 'three'; }
77 when(4) { $ok = 'four'; }
78 default { $ok = 'd'; }
0d863452 79 }
cd9c531b 80 is($ok, 'three', "integer comparison");
0d863452
RH
81}
82
83{
cd9c531b 84 my ($ok1, $ok2);
0d863452 85 given(3) {
cd9c531b
NC
86 when(3.1) { $ok1 = 'n'; }
87 when(3.0) { $ok1 = 'y'; continue }
88 when("3.0") { $ok2 = 'y'; }
89 default { $ok2 = 'n'; }
0d863452 90 }
cd9c531b
NC
91 is($ok1, 'y', "more numeric (pt. 1)");
92 is($ok2, 'y', "more numeric (pt. 2)");
0d863452
RH
93}
94
95{
cd9c531b 96 my $ok;
0d863452 97 given("c") {
cd9c531b
NC
98 when("b") { $ok = 'B'; }
99 when("c") { $ok = 'C'; }
100 when("d") { $ok = 'D'; }
101 default { $ok = 'def'; }
0d863452 102 }
cd9c531b 103 is($ok, 'C', "string comparison");
0d863452
RH
104}
105
106{
cd9c531b 107 my $ok;
0d863452 108 given("c") {
cd9c531b
NC
109 when("b") { $ok = 'B'; }
110 when("c") { $ok = 'C'; continue }
111 when("c") { $ok = 'CC'; }
112 default { $ok = 'D'; }
0d863452 113 }
cd9c531b 114 is($ok, 'CC', "simple continue");
0d863452
RH
115}
116
117# Definedness
118{
119 my $ok = 1;
120 given (0) { when(undef) {$ok = 0} }
cd9c531b 121 is($ok, 1, "Given(0) when(undef)");
0d863452
RH
122}
123{
124 my $undef;
125 my $ok = 1;
126 given (0) { when($undef) {$ok = 0} }
cd9c531b 127 is($ok, 1, 'Given(0) when($undef)');
0d863452
RH
128}
129{
130 my $undef;
131 my $ok = 0;
132 given (0) { when($undef++) {$ok = 1} }
cd9c531b 133 is($ok, 1, "Given(0) when($undef++)");
0d863452
RH
134}
135{
136 my $ok = 1;
137 given (undef) { when(0) {$ok = 0} }
cd9c531b 138 is($ok, 1, "Given(undef) when(0)");
0d863452
RH
139}
140{
141 my $undef;
142 my $ok = 1;
143 given ($undef) { when(0) {$ok = 0} }
cd9c531b 144 is($ok, 1, 'Given($undef) when(0)');
0d863452
RH
145}
146########
147{
148 my $ok = 1;
149 given ("") { when(undef) {$ok = 0} }
cd9c531b 150 is($ok, 1, 'Given("") when(undef)');
0d863452
RH
151}
152{
153 my $undef;
154 my $ok = 1;
155 given ("") { when($undef) {$ok = 0} }
cd9c531b 156 is($ok, 1, 'Given("") when($undef)');
0d863452
RH
157}
158{
159 my $ok = 1;
160 given (undef) { when("") {$ok = 0} }
cd9c531b 161 is($ok, 1, 'Given(undef) when("")');
0d863452
RH
162}
163{
164 my $undef;
165 my $ok = 1;
166 given ($undef) { when("") {$ok = 0} }
cd9c531b 167 is($ok, 1, 'Given($undef) when("")');
0d863452
RH
168}
169########
170{
171 my $ok = 0;
172 given (undef) { when(undef) {$ok = 1} }
cd9c531b 173 is($ok, 1, "Given(undef) when(undef)");
0d863452
RH
174}
175{
176 my $undef;
177 my $ok = 0;
178 given (undef) { when($undef) {$ok = 1} }
cd9c531b 179 is($ok, 1, 'Given(undef) when($undef)');
0d863452
RH
180}
181{
182 my $undef;
183 my $ok = 0;
184 given ($undef) { when(undef) {$ok = 1} }
cd9c531b 185 is($ok, 1, 'Given($undef) when(undef)');
0d863452
RH
186}
187{
188 my $undef;
189 my $ok = 0;
190 given ($undef) { when($undef) {$ok = 1} }
cd9c531b 191 is($ok, 1, 'Given($undef) when($undef)');
0d863452
RH
192}
193
194
195# Regular expressions
196{
cd9c531b 197 my ($ok1, $ok2);
0d863452
RH
198 given("Hello, world!") {
199 when(/lo/)
cd9c531b 200 { $ok1 = 'y'; continue}
0d863452 201 when(/no/)
cd9c531b 202 { $ok1 = 'n'; continue}
0d863452 203 when(/^(Hello,|Goodbye cruel) world[!.?]/)
cd9c531b 204 { $ok2 = 'Y'; continue}
0d863452 205 when(/^(Hello cruel|Goodbye,) world[!.?]/)
cd9c531b 206 { $ok2 = 'n'; continue}
0d863452 207 }
cd9c531b
NC
208 is($ok1, 'y', "regex 1");
209 is($ok2, 'Y', "regex 2");
0d863452
RH
210}
211
212# Comparisons
213{
214 my $test = "explicit numeric comparison (<)";
215 my $twenty_five = 25;
cd9c531b 216 my $ok;
0d863452 217 given($twenty_five) {
cd9c531b
NC
218 when ($_ < 10) { $ok = "ten" }
219 when ($_ < 20) { $ok = "twenty" }
220 when ($_ < 30) { $ok = "thirty" }
221 when ($_ < 40) { $ok = "forty" }
222 default { $ok = "default" }
0d863452 223 }
cd9c531b 224 is($ok, "thirty", $test);
0d863452
RH
225}
226
227{
228 use integer;
229 my $test = "explicit numeric comparison (integer <)";
230 my $twenty_five = 25;
cd9c531b 231 my $ok;
0d863452 232 given($twenty_five) {
cd9c531b
NC
233 when ($_ < 10) { $ok = "ten" }
234 when ($_ < 20) { $ok = "twenty" }
235 when ($_ < 30) { $ok = "thirty" }
236 when ($_ < 40) { $ok = "forty" }
237 default { $ok = "default" }
0d863452 238 }
cd9c531b 239 is($ok, "thirty", $test);
0d863452
RH
240}
241
242{
243 my $test = "explicit numeric comparison (<=)";
244 my $twenty_five = 25;
cd9c531b 245 my $ok;
0d863452 246 given($twenty_five) {
cd9c531b
NC
247 when ($_ <= 10) { $ok = "ten" }
248 when ($_ <= 20) { $ok = "twenty" }
249 when ($_ <= 30) { $ok = "thirty" }
250 when ($_ <= 40) { $ok = "forty" }
251 default { $ok = "default" }
0d863452 252 }
cd9c531b 253 is($ok, "thirty", $test);
0d863452
RH
254}
255
256{
257 use integer;
258 my $test = "explicit numeric comparison (integer <=)";
259 my $twenty_five = 25;
cd9c531b 260 my $ok;
0d863452 261 given($twenty_five) {
cd9c531b
NC
262 when ($_ <= 10) { $ok = "ten" }
263 when ($_ <= 20) { $ok = "twenty" }
264 when ($_ <= 30) { $ok = "thirty" }
265 when ($_ <= 40) { $ok = "forty" }
266 default { $ok = "default" }
0d863452 267 }
cd9c531b 268 is($ok, "thirty", $test);
0d863452
RH
269}
270
271
272{
273 my $test = "explicit numeric comparison (>)";
274 my $twenty_five = 25;
cd9c531b 275 my $ok;
0d863452 276 given($twenty_five) {
cd9c531b
NC
277 when ($_ > 40) { $ok = "forty" }
278 when ($_ > 30) { $ok = "thirty" }
279 when ($_ > 20) { $ok = "twenty" }
280 when ($_ > 10) { $ok = "ten" }
281 default { $ok = "default" }
0d863452 282 }
cd9c531b 283 is($ok, "twenty", $test);
0d863452
RH
284}
285
286{
287 my $test = "explicit numeric comparison (>=)";
288 my $twenty_five = 25;
cd9c531b 289 my $ok;
0d863452 290 given($twenty_five) {
cd9c531b
NC
291 when ($_ >= 40) { $ok = "forty" }
292 when ($_ >= 30) { $ok = "thirty" }
293 when ($_ >= 20) { $ok = "twenty" }
294 when ($_ >= 10) { $ok = "ten" }
295 default { $ok = "default" }
0d863452 296 }
cd9c531b 297 is($ok, "twenty", $test);
0d863452
RH
298}
299
300{
301 use integer;
302 my $test = "explicit numeric comparison (integer >)";
303 my $twenty_five = 25;
cd9c531b 304 my $ok;
0d863452 305 given($twenty_five) {
cd9c531b
NC
306 when ($_ > 40) { $ok = "forty" }
307 when ($_ > 30) { $ok = "thirty" }
308 when ($_ > 20) { $ok = "twenty" }
309 when ($_ > 10) { $ok = "ten" }
310 default { $ok = "default" }
0d863452 311 }
cd9c531b 312 is($ok, "twenty", $test);
0d863452
RH
313}
314
315{
316 use integer;
317 my $test = "explicit numeric comparison (integer >=)";
318 my $twenty_five = 25;
cd9c531b 319 my $ok;
0d863452 320 given($twenty_five) {
cd9c531b
NC
321 when ($_ >= 40) { $ok = "forty" }
322 when ($_ >= 30) { $ok = "thirty" }
323 when ($_ >= 20) { $ok = "twenty" }
324 when ($_ >= 10) { $ok = "ten" }
325 default { $ok = "default" }
0d863452 326 }
cd9c531b 327 is($ok, "twenty", $test);
0d863452
RH
328}
329
330
331{
332 my $test = "explicit string comparison (lt)";
333 my $twenty_five = "25";
cd9c531b 334 my $ok;
0d863452 335 given($twenty_five) {
cd9c531b
NC
336 when ($_ lt "10") { $ok = "ten" }
337 when ($_ lt "20") { $ok = "twenty" }
338 when ($_ lt "30") { $ok = "thirty" }
339 when ($_ lt "40") { $ok = "forty" }
340 default { $ok = "default" }
0d863452 341 }
cd9c531b 342 is($ok, "thirty", $test);
0d863452
RH
343}
344
345{
346 my $test = "explicit string comparison (le)";
347 my $twenty_five = "25";
cd9c531b 348 my $ok;
0d863452 349 given($twenty_five) {
cd9c531b
NC
350 when ($_ le "10") { $ok = "ten" }
351 when ($_ le "20") { $ok = "twenty" }
352 when ($_ le "30") { $ok = "thirty" }
353 when ($_ le "40") { $ok = "forty" }
354 default { $ok = "default" }
0d863452 355 }
cd9c531b 356 is($ok, "thirty", $test);
0d863452
RH
357}
358
359{
360 my $test = "explicit string comparison (gt)";
361 my $twenty_five = 25;
cd9c531b 362 my $ok;
0d863452 363 given($twenty_five) {
cd9c531b
NC
364 when ($_ ge "40") { $ok = "forty" }
365 when ($_ ge "30") { $ok = "thirty" }
366 when ($_ ge "20") { $ok = "twenty" }
367 when ($_ ge "10") { $ok = "ten" }
368 default { $ok = "default" }
0d863452 369 }
cd9c531b 370 is($ok, "twenty", $test);
0d863452
RH
371}
372
373{
374 my $test = "explicit string comparison (ge)";
375 my $twenty_five = 25;
cd9c531b 376 my $ok;
0d863452 377 given($twenty_five) {
cd9c531b
NC
378 when ($_ ge "40") { $ok = "forty" }
379 when ($_ ge "30") { $ok = "thirty" }
380 when ($_ ge "20") { $ok = "twenty" }
381 when ($_ ge "10") { $ok = "ten" }
382 default { $ok = "default" }
0d863452 383 }
cd9c531b 384 is($ok, "twenty", $test);
0d863452
RH
385}
386
387# Make sure it still works with a lexical $_:
388{
389 my $_;
390 my $test = "explicit comparison with lexical \$_";
391 my $twenty_five = 25;
cd9c531b 392 my $ok;
0d863452 393 given($twenty_five) {
cd9c531b
NC
394 when ($_ ge "40") { $ok = "forty" }
395 when ($_ ge "30") { $ok = "thirty" }
396 when ($_ ge "20") { $ok = "twenty" }
397 when ($_ ge "10") { $ok = "ten" }
398 default { $ok = "default" }
0d863452 399 }
cd9c531b 400 is($ok, "twenty", $test);
0d863452
RH
401}
402
403# Optimized-away comparisons
404{
cd9c531b 405 my $ok;
0d863452 406 given(23) {
cd9c531b
NC
407 when (2 + 2 == 4) { $ok = 'y'; continue }
408 when (2 + 2 == 5) { $ok = 'n' }
0d863452 409 }
cd9c531b 410 is($ok, 'y', "Optimized-away comparison");
0d863452
RH
411}
412
413# File tests
414# (How to be both thorough and portable? Pinch a few ideas
415# from t/op/filetest.t. We err on the side of portability for
416# the time being.)
417
418{
419 my ($ok_d, $ok_f, $ok_r);
420 given("op") {
421 when(-d) {$ok_d = 1; continue}
422 when(!-f) {$ok_f = 1; continue}
423 when(-r) {$ok_r = 1; continue}
424 }
425 ok($ok_d, "Filetest -d");
426 ok($ok_f, "Filetest -f");
427 ok($ok_r, "Filetest -r");
428}
429
430# Sub and method calls
431sub bar {"bar"}
432{
433 my $ok = 0;
434 given("foo") {
435 when(bar()) {$ok = 1}
436 }
437 ok($ok, "Sub call acts as boolean")
438}
439
440{
441 my $ok = 0;
442 given("foo") {
443 when(main->bar()) {$ok = 1}
444 }
445 ok($ok, "Class-method call acts as boolean")
446}
447
448{
449 my $ok = 0;
450 my $obj = bless [];
451 given("foo") {
452 when($obj->bar()) {$ok = 1}
453 }
454 ok($ok, "Object-method call acts as boolean")
455}
456
457# Other things that should not be smart matched
458{
459 my $ok = 0;
460 given(0) {
461 when(eof(DATA)) {
462 $ok = 1;
463 }
464 }
465 ok($ok, "eof() not smartmatched");
466}
467
468{
469 my $ok = 0;
470 my %foo = ("bar", 0);
471 given(0) {
472 when(exists $foo{bar}) {
473 $ok = 1;
474 }
475 }
476 ok($ok, "exists() not smartmatched");
477}
478
479{
480 my $ok = 0;
481 given(0) {
482 when(defined $ok) {
483 $ok = 1;
484 }
485 }
486 ok($ok, "defined() not smartmatched");
487}
488
489{
490 my $ok = 1;
491 given("foo") {
492 when((1 == 1) && "bar") {
493 $ok = 0;
494 }
495 when((1 == 1) && $_ eq "foo") {
496 $ok = 2;
497 }
498 }
499 is($ok, 2, "((1 == 1) && \"bar\") not smartmatched");
500}
501
502{
503 my $ok = 1;
504 given(0) {
505 when((1 == $ok) || "foo") {
506 $ok = 0;
507 }
508 }
509 ok($ok, '((1 == $ok) || "foo") not smartmatched');
510}
511
512
513# Make sure we aren't invoking the get-magic more than once
514
515{ # A helper class to count the number of accesses.
516 package FetchCounter;
517 sub TIESCALAR {
518 my ($class) = @_;
519 bless {value => undef, count => 0}, $class;
520 }
521 sub STORE {
522 my ($self, $val) = @_;
523 $self->{count} = 0;
524 $self->{value} = $val;
525 }
526 sub FETCH {
527 my ($self) = @_;
528 # Avoid pre/post increment here
529 $self->{count} = 1 + $self->{count};
530 $self->{value};
531 }
532 sub count {
533 my ($self) = @_;
534 $self->{count};
535 }
536}
537
538my $f = tie my $v, "FetchCounter";
539
540{ my $test_name = "Only one FETCH (in given)";
cd9c531b 541 my $ok;
0d863452
RH
542 given($v = 23) {
543 when(undef) {}
544 when(sub{0}->()) {}
545 when(21) {}
546 when("22") {}
547 when(23) {$ok = 1}
548 when(/24/) {$ok = 0}
549 }
cd9c531b 550 is($ok, 1, "precheck: $test_name");
0d863452
RH
551 is($f->count(), 1, $test_name);
552}
553
554{ my $test_name = "Only one FETCH (numeric when)";
cd9c531b 555 my $ok;
0d863452
RH
556 $v = 23;
557 is($f->count(), 0, "Sanity check: $test_name");
558 given(23) {
559 when(undef) {}
560 when(sub{0}->()) {}
561 when(21) {}
562 when("22") {}
563 when($v) {$ok = 1}
564 when(/24/) {$ok = 0}
565 }
cd9c531b 566 is($ok, 1, "precheck: $test_name");
0d863452
RH
567 is($f->count(), 1, $test_name);
568}
569
570{ my $test_name = "Only one FETCH (string when)";
cd9c531b 571 my $ok;
0d863452
RH
572 $v = "23";
573 is($f->count(), 0, "Sanity check: $test_name");
574 given("23") {
575 when(undef) {}
576 when(sub{0}->()) {}
577 when("21") {}
578 when("22") {}
579 when($v) {$ok = 1}
580 when(/24/) {$ok = 0}
581 }
cd9c531b 582 is($ok, 1, "precheck: $test_name");
0d863452
RH
583 is($f->count(), 1, $test_name);
584}
585
586{ my $test_name = "Only one FETCH (undef)";
cd9c531b 587 my $ok;
0d863452
RH
588 $v = undef;
589 is($f->count(), 0, "Sanity check: $test_name");
590 given(my $undef) {
591 when(sub{0}->()) {}
592 when("21") {}
593 when("22") {}
594 when($v) {$ok = 1}
595 when(undef) {$ok = 0}
596 }
cd9c531b 597 is($ok, 1, "precheck: $test_name");
0d863452
RH
598 is($f->count(), 1, $test_name);
599}
600
601# Loop topicalizer
602{
603 my $first = 1;
604 for (1, "two") {
605 when ("two") {
606 is($first, 0, "Loop: second");
607 eval {break};
608 like($@, qr/^Can't "break" in a loop topicalizer/,
609 q{Can't "break" in a loop topicalizer});
610 }
611 when (1) {
612 is($first, 1, "Loop: first");
613 $first = 0;
614 # Implicit break is okay
615 }
616 }
617}
618
619{
620 my $first = 1;
621 for $_ (1, "two") {
622 when ("two") {
623 is($first, 0, "Explicit \$_: second");
624 eval {break};
625 like($@, qr/^Can't "break" in a loop topicalizer/,
626 q{Can't "break" in a loop topicalizer});
627 }
628 when (1) {
629 is($first, 1, "Explicit \$_: first");
630 $first = 0;
631 # Implicit break is okay
632 }
633 }
634}
635
636{
637 my $first = 1;
638 my $_;
639 for (1, "two") {
640 when ("two") {
641 is($first, 0, "Implicitly lexical loop: second");
642 eval {break};
643 like($@, qr/^Can't "break" in a loop topicalizer/,
644 q{Can't "break" in a loop topicalizer});
645 }
646 when (1) {
647 is($first, 1, "Implicitly lexical loop: first");
648 $first = 0;
649 # Implicit break is okay
650 }
651 }
652}
653
654{
655 my $first = 1;
656 my $_;
657 for $_ (1, "two") {
658 when ("two") {
659 is($first, 0, "Implicitly lexical, explicit \$_: second");
660 eval {break};
661 like($@, qr/^Can't "break" in a loop topicalizer/,
662 q{Can't "break" in a loop topicalizer});
663 }
664 when (1) {
665 is($first, 1, "Implicitly lexical, explicit \$_: first");
666 $first = 0;
667 # Implicit break is okay
668 }
669 }
670}
671
672{
673 my $first = 1;
674 for my $_ (1, "two") {
675 when ("two") {
676 is($first, 0, "Lexical loop: second");
677 eval {break};
678 like($@, qr/^Can't "break" in a loop topicalizer/,
679 q{Can't "break" in a loop topicalizer});
680 }
681 when (1) {
682 is($first, 1, "Lecical loop: first");
683 $first = 0;
684 # Implicit break is okay
685 }
686 }
687}
688
689
690# Code references
691{
692 no warnings "redefine";
693 my $called_foo = 0;
694 sub foo {$called_foo = 1}
695 my $called_bar = 0;
696 sub bar {$called_bar = 1}
697 my ($matched_foo, $matched_bar) = (0, 0);
698 given(\&foo) {
699 when(\&bar) {$matched_bar = 1}
700 when(\&foo) {$matched_foo = 1}
701 }
702 is($called_foo, 0, "Code ref comparison: foo not called");
703 is($called_bar, 0, "Code ref comparison: bar not called");
704 is($matched_bar, 0, "Code ref didn't match different one");
705 is($matched_foo, 1, "Code ref did match itself");
706}
707
708sub contains_x {
709 my $x = shift;
710 return ($x =~ /x/);
711}
712{
713 my ($ok1, $ok2) = (0,0);
714 given("foxy!") {
715 when(contains_x($_))
716 { $ok1 = 1; continue }
717 when(\&contains_x)
718 { $ok2 = 1; continue }
719 }
720 is($ok1, 1, "Calling sub directly (true)");
721 is($ok2, 1, "Calling sub indirectly (true)");
722
723 given("foggy") {
724 when(contains_x($_))
725 { $ok1 = 2; continue }
726 when(\&contains_x)
727 { $ok2 = 2; continue }
728 }
729 is($ok1, 1, "Calling sub directly (false)");
730 is($ok2, 1, "Calling sub indirectly (false)");
731}
732
733# Test overloading
734{ package OverloadTest;
735
736 use overload '""' => sub{"string value of obj"};
737
738 use overload "~~" => sub {
739 my ($self, $other, $reversed) = @_;
740 if ($reversed) {
741 $self->{left} = $other;
742 $self->{right} = $self;
743 $self->{reversed} = 1;
744 } else {
745 $self->{left} = $self;
746 $self->{right} = $other;
747 $self->{reversed} = 0;
748 }
749 $self->{called} = 1;
750 return $self->{retval};
751 };
752
753 sub new {
754 my ($pkg, $retval) = @_;
755 bless {
756 called => 0,
757 retval => $retval,
758 }, $pkg;
759 }
760}
761
762{
763 my $test = "Overloaded obj in given (true)";
764 my $obj = OverloadTest->new(1);
765 my $matched;
766 given($obj) {
767 when ("other arg") {$matched = 1}
768 default {$matched = 0}
769 }
770
771 is($obj->{called}, 1, "$test: called");
772 ok($matched, "$test: matched");
773 is($obj->{left}, "string value of obj", "$test: left");
774 is($obj->{right}, "other arg", "$test: right");
775 ok(!$obj->{reversed}, "$test: not reversed");
776}
777
778{
779 my $test = "Overloaded obj in given (false)";
780 my $obj = OverloadTest->new(0);
781 my $matched;
782 given($obj) {
783 when ("other arg") {$matched = 1}
784 }
785
786 is($obj->{called}, 1, "$test: called");
787 ok(!$matched, "$test: not matched");
788 is($obj->{left}, "string value of obj", "$test: left");
789 is($obj->{right}, "other arg", "$test: right");
790 ok(!$obj->{reversed}, "$test: not reversed");
791}
792
793{
794 my $test = "Overloaded obj in when (true)";
795 my $obj = OverloadTest->new(1);
796 my $matched;
797 given("topic") {
798 when ($obj) {$matched = 1}
799 default {$matched = 0}
800 }
801
802 is($obj->{called}, 1, "$test: called");
803 ok($matched, "$test: matched");
804 is($obj->{left}, "topic", "$test: left");
805 is($obj->{right}, "string value of obj", "$test: right");
806 ok($obj->{reversed}, "$test: reversed");
807}
808
809{
810 my $test = "Overloaded obj in when (false)";
811 my $obj = OverloadTest->new(0);
812 my $matched;
813 given("topic") {
814 when ($obj) {$matched = 1}
815 default {$matched = 0}
816 }
817
818 is($obj->{called}, 1, "$test: called");
819 ok(!$matched, "$test: not matched");
820 is($obj->{left}, "topic", "$test: left");
821 is($obj->{right}, "string value of obj", "$test: right");
822 ok($obj->{reversed}, "$test: reversed");
823}
824
825# Okay, that'll do for now. The intricacies of the smartmatch
826# semantics are tested in t/op/smartmatch.t
827__END__