xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Switch/t/given.t (revision 0:68f95e015346) 
1BEGIN {
2    if ($ENV{PERL_CORE}) {
3        chdir('t') if -d 't';
4        @INC = qw(../lib);
5    }
6}
7
8use Carp;
9use Switch qw(Perl6 __ fallthrough);
10
11my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
12END{print"1..$C\n$M"}
13
14# NON-when THINGS;
15
16$when->{when} = { when => "when" };
17
18*when = \&when;
19
20# PREMATURE when
21
22eval { when 1 { ok(0) }; ok(0) } || ok(1);
23
24# H.O. FUNCS
25
26given __ > 2 {
27
28	when 1	{ ok(0) } else { ok(1) }
29	when 2	{ ok(0) } else { ok(1) }
30	when 3	{ ok(1) } else { ok(0) }
31}
32
33given (3) {
34
35	eval { when __ <= 1 || __ > 2	{ ok(0) } } || ok(1);
36	when __ <= 2 		{ ok(0) };
37	when __ <= 3		{ ok(1) };
38}
39
40# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
41
42# 1. NUMERIC SWITCH
43
44for (1..3)
45{
46	given ($_) {
47		# SELF
48		when ($_) { ok(1) } else { ok(0) }
49
50		# NUMERIC
51		when 1 { ok ($_==1) } else { ok($_!=1) }
52		when (1)  { ok ($_==1) } else { ok($_!=1) }
53		when 3 { ok ($_==3) } else { ok($_!=3) }
54		when (4) { ok (0) } else { ok(1) }
55		when (2) { ok ($_==2) } else { ok($_!=2) }
56
57		# STRING
58		when ('a') { ok (0) } else { ok(1) }
59		when  'a'  { ok (0) } else { ok(1) }
60		when ('3') { ok ($_ == 3) } else { ok($_ != 3) }
61		when ('3.0') { ok (0) } else { ok(1) }
62
63		# ARRAY
64		when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
65		when  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
66		when (['a','b']) { ok (0) } else { ok(1) }
67		when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
68		when (['a','b',2.0])  { ok ($_==2) } else { ok ($_!=2) }
69		when ([])  { ok (0) } else { ok(1) }
70
71		# HASH
72		when ({})  { ok (0) } else { ok (1) }
73		when {}  { ok (0) } else { ok (1) }
74		when {1,1}  { ok ($_==1) } else { ok($_!=1) }
75		when ({1=>1, 2=>0})  { ok ($_==1) } else { ok($_!=1) }
76
77		# SUB/BLOCK
78		when (sub {$_[0]==2})  { ok ($_==2) } else { ok($_!=2) }
79		when {$_[0]==2}  { ok ($_==2) } else { ok($_!=2) }
80		when {0}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
81		when {1}  { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
82	}
83}
84
85
86# 2. STRING SWITCH
87
88for ('a'..'c','1')
89{
90	given ($_) {
91		# SELF
92		when ($_)  { ok(1) } else { ok(0) }
93
94		# NUMERIC
95		when (1)   { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
96		when (1.0)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
97
98		# STRING
99		when ('a')  { ok ($_ eq 'a') } else { ok($_ ne 'a') }
100		when ('b')  { ok ($_ eq 'b') } else { ok($_ ne 'b') }
101		when ('c')  { ok ($_ eq 'c') } else { ok($_ ne 'c') }
102		when ('1')  { ok ($_ eq '1') } else { ok($_ ne '1') }
103		when ('d')  { ok (0) } else { ok (1) }
104
105		# ARRAY
106		when (['a','1'])  { ok ($_ eq 'a' || $_ eq '1') }
107			else { ok ($_ ne 'a' && $_ ne '1') }
108		when (['z','2'])  { ok (0) } else { ok(1) }
109		when ([])  { ok (0) } else { ok(1) }
110
111		# HASH
112		when ({})  { ok (0) } else { ok (1) }
113		when ({a=>'a', 1=>1, 2=>0})  { ok ($_ eq 'a' || $_ eq '1') }
114			else { ok ($_ ne 'a' && $_ ne '1') }
115
116		# SUB/BLOCK
117		when (sub{$_[0] eq 'a' })  { ok ($_ eq 'a') }
118			else { ok($_ ne 'a') }
119		when {$_[0] eq 'a'}  { ok ($_ eq 'a') } else { ok($_ ne 'a') }
120		when {0}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
121		when {1}  { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
122	}
123}
124
125
126# 3. ARRAY SWITCH
127
128my $iteration = 0;
129for ([],[1,'a'],[2,'b'])
130{
131	given ($_) {
132	$iteration++;
133		# SELF
134		when ($_)  { ok(1) }
135
136		# NUMERIC
137		when (1)  { ok ($iteration==2) } else { ok ($iteration!=2) }
138		when (1.0)  { ok ($iteration==2) } else { ok ($iteration!=2) }
139
140		# STRING
141		when ('a')  { ok ($iteration==2) } else { ok ($iteration!=2) }
142		when ('b')  { ok ($iteration==3) } else { ok ($iteration!=3) }
143		when ('1')  { ok ($iteration==2) } else { ok ($iteration!=2) }
144
145		# ARRAY
146		when (['a',2])  { ok ($iteration>=2) } else { ok ($iteration<2) }
147		when ([1,'a'])  { ok ($iteration==2) } else { ok($iteration!=2) }
148		when ([])  { ok (0) } else { ok(1) }
149		when ([7..100])  { ok (0) } else { ok(1) }
150
151		# HASH
152		when ({})  { ok (0) } else { ok (1) }
153		when ({a=>'a', 1=>1, 2=>0})  { ok ($iteration==2) }
154			else { ok ($iteration!=2) }
155
156		# SUB/BLOCK
157		when {scalar grep /a/, @_}  { ok ($iteration==2) }
158			else { ok ($iteration!=2) }
159		when (sub {scalar grep /a/, @_ })  { ok ($iteration==2) }
160			else { ok ($iteration!=2) }
161		when {0}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
162		when {1}  { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
163	}
164}
165
166
167# 4. HASH SWITCH
168
169$iteration = 0;
170for ({},{a=>1,b=>0})
171{
172	given ($_) {
173	$iteration++;
174
175		# SELF
176		when ($_)  { ok(1) } else { ok(0) }
177
178		# NUMERIC
179		when (1)  { ok (0) } else { ok (1) }
180		when (1.0)  { ok (0) } else { ok (1) }
181
182		# STRING
183		when ('a')  { ok ($iteration==2) } else { ok ($iteration!=2) }
184		when ('b')  { ok (0) } else { ok (1) }
185		when ('c')  { ok (0) } else { ok (1) }
186
187		# ARRAY
188		when (['a',2])  { ok ($iteration==2) }
189			else { ok ($iteration!=2) }
190		when (['b','a'])  { ok ($iteration==2) }
191			else { ok ($iteration!=2) }
192		when (['b','c'])  { ok (0) } else { ok (1) }
193		when ([])  { ok (0) } else { ok(1) }
194		when ([7..100])  { ok (0) } else { ok(1) }
195
196		# HASH
197		when ({})  { ok (0) } else { ok (1) }
198		when ({a=>'a', 1=>1, 2=>0})  { ok (0) } else { ok (1) }
199
200		# SUB/BLOCK
201		when {$_[0]{a}}  { ok ($iteration==2) }
202			else { ok ($iteration!=2) }
203		when (sub {$_[0]{a}})  { ok ($iteration==2) }
204			else { ok ($iteration!=2) }
205		when {0}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
206		when {1}  { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
207	}
208}
209
210
211# 5. CODE SWITCH
212
213$iteration = 0;
214for ( sub {1},
215      sub { return 0 unless @_;
216	    my ($data) = @_;
217	    my $type = ref $data;
218	    return $type eq 'HASH'   && $data->{a}
219		|| $type eq 'Regexp' && 'a' =~ /$data/
220		|| $type eq ""       && $data eq '1';
221	  },
222      sub {0} )
223{
224	given ($_) {
225	$iteration++;
226		# SELF
227		when ($_)  { ok(1) } else { ok(0) }
228
229		# NUMERIC
230		when (1)  { ok ($iteration<=2) } else { ok ($iteration>2) }
231		when (1.0)  { ok ($iteration<=2) } else { ok ($iteration>2) }
232		when (1.1)  { ok ($iteration==1) } else { ok ($iteration!=1) }
233
234		# STRING
235		when ('a')  { ok ($iteration==1) } else { ok ($iteration!=1) }
236		when ('b')  { ok ($iteration==1) } else { ok ($iteration!=1) }
237		when ('c')  { ok ($iteration==1) } else { ok ($iteration!=1) }
238		when ('1')  { ok ($iteration<=2) } else { ok ($iteration>2) }
239
240		# ARRAY
241		when ([1, 'a'])  { ok ($iteration<=2) }
242			else { ok ($iteration>2) }
243		when (['b','a'])  { ok ($iteration==1) }
244			else { ok ($iteration!=1) }
245		when (['b','c'])  { ok ($iteration==1) }
246			else { ok ($iteration!=1) }
247		when ([])  { ok ($iteration==1) } else { ok($iteration!=1) }
248		when ([7..100])  { ok ($iteration==1) }
249			else { ok($iteration!=1) }
250
251		# HASH
252		when ({})  { ok ($iteration==1) } else { ok ($iteration!=1) }
253		when ({a=>'a', 1=>1, 2=>0})  { ok ($iteration<=2) }
254			else { ok ($iteration>2) }
255
256		# SUB/BLOCK
257		when {$_[0]->{a}}  { ok (0) } else { ok (1) }
258		when (sub {$_[0]{a}})  { ok (0) } else { ok (1) }
259		when {0}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
260		when {1}  { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
261	}
262}
263
264
265# NESTED SWITCHES
266
267for my $count (1..3)
268{
269	given ([9,"a",11]) {
270		when (qr/\d/)  {
271				given ($count) {
272					when (1)      { ok($count==1) }
273						else { ok($count!=1) }
274					when ([5,6])  { ok(0) } else { ok(1) }
275				}
276			    }
277		ok(1) when 11;
278	}
279}
280