xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Switch/t/switch.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(__ 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-case THINGS;
15
16$case->{case} = { case => "case" };
17
18*case = \&case;
19
20# PREMATURE case
21
22eval { case 1 { ok(0) }; ok(0) } || ok(1);
23
24# H.O. FUNCS
25
26switch (__ > 2) {
27
28	case 1	{ ok(0) } else { ok(1) }
29	case 2	{ ok(0) } else { ok(1) }
30	case 3	{ ok(1) } else { ok(0) }
31}
32
33switch (3) {
34
35	eval { case __ <= 1 || __ > 2	{ ok(0) } } || ok(1);
36	case __ <= 2 		{ ok(0) };
37	case __ <= 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	switch ($_) {
47		# SELF
48		case ($_) { ok(1) } else { ok(0) }
49
50		# NUMERIC
51		case (1) { ok ($_==1) } else { ok($_!=1) }
52		case  1  { ok ($_==1) } else { ok($_!=1) }
53		case (3) { ok ($_==3) } else { ok($_!=3) }
54		case (4) { ok (0) } else { ok(1) }
55		case (2) { ok ($_==2) } else { ok($_!=2) }
56
57		# STRING
58		case ('a') { ok (0) } else { ok(1) }
59		case  'a'  { ok (0) } else { ok(1) }
60		case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
61		case ('3.0') { ok (0) } else { ok(1) }
62
63		# ARRAY
64		case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
65		case  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
66		case (['a','b']) { ok (0) } else { ok(1) }
67		case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
68		case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
69		case ([]) { ok (0) } else { ok(1) }
70
71		# HASH
72		case ({}) { ok (0) } else { ok (1) }
73		case {} { ok (0) } else { ok (1) }
74		case {1,1} { ok ($_==1) } else { ok($_!=1) }
75		case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
76
77		# SUB/BLOCK
78		case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
79		case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
80		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
81		case {1} { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
82	}
83}
84
85
86# 2. STRING SWITCH
87
88for ('a'..'c','1')
89{
90	switch ($_) {
91		# SELF
92		case ($_) { ok(1) } else { ok(0) }
93
94		# NUMERIC
95		case (1)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
96		case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
97
98		# STRING
99		case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
100		case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
101		case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
102		case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
103		case ('d') { ok (0) } else { ok (1) }
104
105		# ARRAY
106		case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
107			else { ok ($_ ne 'a' && $_ ne '1') }
108		case (['z','2']) { ok (0) } else { ok(1) }
109		case ([]) { ok (0) } else { ok(1) }
110
111		# HASH
112		case ({}) { ok (0) } else { ok (1) }
113		case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
114			else { ok ($_ ne 'a' && $_ ne '1') }
115
116		# SUB/BLOCK
117		case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
118			else { ok($_ ne 'a') }
119		case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
120		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
121		case {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	switch ($_) {
132	$iteration++;
133		# SELF
134		case ($_) { ok(1) }
135
136		# NUMERIC
137		case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
138		case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
139
140		# STRING
141		case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
142		case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
143		case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
144
145		# ARRAY
146		case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
147		case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
148		case ([]) { ok (0) } else { ok(1) }
149		case ([7..100]) { ok (0) } else { ok(1) }
150
151		# HASH
152		case ({}) { ok (0) } else { ok (1) }
153		case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
154			else { ok ($iteration!=2) }
155
156		# SUB/BLOCK
157		case {scalar grep /a/, @_} { ok ($iteration==2) }
158			else { ok ($iteration!=2) }
159		case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
160			else { ok ($iteration!=2) }
161		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
162		case {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	switch ($_) {
173	$iteration++;
174
175		# SELF
176		case ($_) { ok(1) } else { ok(0) }
177
178		# NUMERIC
179		case (1) { ok (0) } else { ok (1) }
180		case (1.0) { ok (0) } else { ok (1) }
181
182		# STRING
183		case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
184		case ('b') { ok (0) } else { ok (1) }
185		case ('c') { ok (0) } else { ok (1) }
186
187		# ARRAY
188		case (['a',2]) { ok ($iteration==2) }
189			else { ok ($iteration!=2) }
190		case (['b','a']) { ok ($iteration==2) }
191			else { ok ($iteration!=2) }
192		case (['b','c']) { ok (0) } else { ok (1) }
193		case ([]) { ok (0) } else { ok(1) }
194		case ([7..100]) { ok (0) } else { ok(1) }
195
196		# HASH
197		case ({}) { ok (0) } else { ok (1) }
198		case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
199
200		# SUB/BLOCK
201		case {$_[0]{a}} { ok ($iteration==2) }
202			else { ok ($iteration!=2) }
203		case (sub {$_[0]{a}}) { ok ($iteration==2) }
204			else { ok ($iteration!=2) }
205		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
206		case {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	switch ($_) {
225	$iteration++;
226		# SELF
227		case ($_) { ok(1) } else { ok(0) }
228
229		# NUMERIC
230		case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
231		case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
232		case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
233
234		# STRING
235		case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
236		case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
237		case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
238		case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
239
240		# ARRAY
241		case ([1, 'a']) { ok ($iteration<=2) }
242			else { ok ($iteration>2) }
243		case (['b','a']) { ok ($iteration==1) }
244			else { ok ($iteration!=1) }
245		case (['b','c']) { ok ($iteration==1) }
246			else { ok ($iteration!=1) }
247		case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
248		case ([7..100]) { ok ($iteration==1) }
249			else { ok($iteration!=1) }
250
251		# HASH
252		case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
253		case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
254			else { ok ($iteration>2) }
255
256		# SUB/BLOCK
257		case {$_[0]->{a}} { ok (0) } else { ok (1) }
258		case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
259		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
260		case {1} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
261	}
262}
263
264
265# NESTED SWITCHES
266
267for my $count (1..3)
268{
269	switch ([9,"a",11]) {
270		case (qr/\d/) {
271				switch ($count) {
272					case (1)     { ok($count==1) }
273						else { ok($count!=1) }
274					case ([5,6]) { ok(0) } else { ok(1) }
275				}
276			    }
277		ok(1) case (11);
278	}
279}
280