This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regularise "given"
[perl5.git] / t / op / given.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use strict;
10 use warnings;
11 no warnings 'experimental::smartmatch';
12
13 plan tests => 39;
14
15 CORE::given(3) {
16     pass "CORE::given without feature flag";
17 }
18
19 use feature 'switch';
20
21 CORE::given(3) {
22     pass "CORE::given with feature flag";
23 }
24
25 given(3) {
26     pass "given with feature flag";
27 }
28
29 {
30     my $x = "foo";
31     is($x, "foo", "given lexical scope not started yet");
32     given(my $x = "bar") {
33         is($x, "bar", "given lexical scope starts");
34     }
35     is($x, "foo", "given lexical scope ends");
36 }
37
38 sub topic_is ($@) { is $_, shift, @_ }
39 {
40     local $_ = "foo";
41     is $_, "foo", "given dynamic scope not started yet";
42     topic_is "foo", "given dynamic scope not started yet";
43     given("bar") {
44         is $_, "bar", "given dynamic scope starts";
45         topic_is "bar", "given dynamic scope starts";
46     }
47     is $_, "foo", "given dynamic scope ends";
48     topic_is "foo", "given dynamic scope ends";
49 }
50
51 given(undef) {
52     is $_, undef, "folded undef topic value";
53     is \$_, \undef, "folded undef topic identity";
54 }
55 given(1 < 3) {
56     is $_, !!1, "folded true topic value";
57     is \$_, \!!1, "folded true topic identity";
58 }
59 given(1 > 3) {
60     is $_, !!0, "folded false topic value";
61     is \$_, \!!0, "folded false topic identity";
62 }
63 my $one = 1;
64 given($one && undef) {
65     is $_, undef, "computed undef topic value";
66     is \$_, \undef, "computed undef topic identity";
67 }
68 given($one < 3) {
69     is $_, !!1, "computed true topic value";
70     is \$_, \!!1, "computed true topic identity";
71 }
72 given($one > 3) {
73     is $_, !!0, "computed false topic value";
74     is \$_, \!!0, "computed false topic identity";
75 }
76
77 sub which_context {
78     return wantarray ? "list" : defined(wantarray) ? "scalar" : "void";
79 }
80 given(which_context) {
81     is $_, "scalar", "topic sub called without parens";
82 }
83 given(which_context()) {
84     is $_, "scalar", "topic sub called with parens";
85 }
86
87 my $ps = "foo";
88 given($ps) {
89     is $_, "foo", "padsv topic value";
90     is \$_, \$ps, "padsv topic identity";
91 }
92 our $gs = "bar";
93 given($gs) {
94     is $_, "bar", "gvsv topic value";
95     is \$_, \$gs, "gvsv topic identity";
96 }
97 my @pa = qw(a b c d e);
98 given(@pa) {
99     is $_, 5, "padav topic";
100 }
101 our @ga = qw(x y z);
102 given(@ga) {
103     is $_, 3, "gvav topic";
104 }
105 my %ph = qw(a b c d e f g h i j);
106 given(%ph) {
107     is $_, 5, "padhv topic";
108 }
109 our %gh = qw(u v w x y z);
110 given(%gh) {
111     is $_, 3, "gvhv topic";
112 }
113
114 given($one + 3) {
115     is $_, 4, "general computed topic";
116 }
117
118 is join(",", 111, 222,
119     do {
120         no warnings "void";
121         given($one, 22, $one, 33) {
122             is $_, 33, "list topic";
123             (1111, 2222);
124         }
125     },
126     333, 444,
127 ), "111,222,1111,2222,333,444", "stack discipline";
128
129 given(()) {
130     is $_, undef, "stub topic value";
131     is \$_, \undef, "stub topic identity";
132 }
133
134 1;