[p5sagit/p5-mst-13.2.git] / lib / Switch / t / given.t

#! /usr/local/bin/perl -w

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

use Carp;
use Switch qw(Perl6 __ fallthrough);

my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
END{print"1..$C\n$M"}

# NON-when THINGS;

$when->{when} = { when => "when" };

*when = \&when;

# PREMATURE when

eval { when 1: { ok(0) }; ok(0) } || ok(1);

# H.O. FUNCS

given (__ > 2) {

	when 1:	{ ok(0) } else { ok(1) }
	when 2:	{ ok(0) } else { ok(1) }
	when 3:	{ ok(1) } else { ok(0) }
}

given (3) {

	eval { when __ <= 1 || __ > 2:	{ ok(0) } } || ok(1);
	when __ <= 2: 		{ ok(0) };
	when __ <= 3:		{ ok(1) };
}

# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE

# 1. NUMERIC SWITCH

for (1..3)
{
	given ($_) {
		# SELF
		when $_: { ok(1) } else { ok(0) }

		# NUMERIC
		when 1: { ok ($_==1) } else { ok($_!=1) }
		when (1):  { ok ($_==1) } else { ok($_!=1) }
		when 3: { ok ($_==3) } else { ok($_!=3) }
		when (4): { ok (0) } else { ok(1) }
		when (2): { ok ($_==2) } else { ok($_!=2) }

		# STRING
		when ('a'): { ok (0) } else { ok(1) }
		when  'a' : { ok (0) } else { ok(1) }
		when ('3'): { ok ($_ == 3) } else { ok($_ != 3) }
		when ('3.0'): { ok (0) } else { ok(1) }

		# ARRAY
		when ([10,5,1]): { ok ($_==1) } else { ok($_!=1) }
		when  [10,5,1]:  { ok ($_==1) } else { ok($_!=1) }
		when (['a','b']): { ok (0) } else { ok(1) }
		when (['a','b',3]): { ok ($_==3) } else { ok ($_!=3) }
		when (['a','b',2.0]) : { ok ($_==2) } else { ok ($_!=2) }
		when ([]) : { ok (0) } else { ok(1) }

		# HASH
		when ({}) : { ok (0) } else { ok (1) }
		when {} : { ok (0) } else { ok (1) }
		when {1,1} : { ok ($_==1) } else { ok($_!=1) }
		when ({1=>1, 2=>0}) : { ok ($_==1) } else { ok($_!=1) }

		# SUB/BLOCK
		when (sub {$_[0]==2}) : { ok ($_==2) } else { ok($_!=2) }
		when {$_[0]==2} : { ok ($_==2) } else { ok($_!=2) }
		when {0} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		when {1} : { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
	}
}


# 2. STRING SWITCH

for ('a'..'c','1')
{
	given ($_) {
		# SELF
		when ($_) : { ok(1) } else { ok(0) }

		# NUMERIC
		when (1)  : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
		when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }

		# STRING
		when ('a') : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
		when ('b') : { ok ($_ eq 'b') } else { ok($_ ne 'b') }
		when ('c') : { ok ($_ eq 'c') } else { ok($_ ne 'c') }
		when ('1') : { ok ($_ eq '1') } else { ok($_ ne '1') }
		when ('d') : { ok (0) } else { ok (1) }

		# ARRAY
		when (['a','1']) : { ok ($_ eq 'a' || $_ eq '1') }
			else { ok ($_ ne 'a' && $_ ne '1') }
		when (['z','2']) : { ok (0) } else { ok(1) }
		when ([]) : { ok (0) } else { ok(1) }

		# HASH
		when ({}) : { ok (0) } else { ok (1) }
		when ({a=>'a', 1=>1, 2=>0}) : { ok ($_ eq 'a' || $_ eq '1') }
			else { ok ($_ ne 'a' && $_ ne '1') }

		# SUB/BLOCK
		when (sub{$_[0] eq 'a' }) : { ok ($_ eq 'a') }
			else { ok($_ ne 'a') }
		when {$_[0] eq 'a'} : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
		when {0} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		when {1} : { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
	}
}


# 3. ARRAY SWITCH

my $iteration = 0;
for ([],[1,'a'],[2,'b'])
{
	given ($_) {
	$iteration++;
		# SELF
		when ($_) : { ok(1) }

		# NUMERIC
		when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) }
		when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) }

		# STRING
		when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
		when ('b') : { ok ($iteration==3) } else { ok ($iteration!=3) }
		when ('1') : { ok ($iteration==2) } else { ok ($iteration!=2) }

		# ARRAY
		when (['a',2]) : { ok ($iteration>=2) } else { ok ($iteration<2) }
		when ([1,'a']) : { ok ($iteration==2) } else { ok($iteration!=2) }
		when ([]) : { ok (0) } else { ok(1) }
		when ([7..100]) : { ok (0) } else { ok(1) }

		# HASH
		when ({}) : { ok (0) } else { ok (1) }
		when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) }
			else { ok ($iteration!=2) }

		# SUB/BLOCK
		when {scalar grep /a/, @_} : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when (sub {scalar grep /a/, @_ }) : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when {0} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		when {1} : { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
	}
}


# 4. HASH SWITCH

$iteration = 0;
for ({},{a=>1,b=>0})
{
	given ($_) {
	$iteration++;

		# SELF
		when ($_) : { ok(1) } else { ok(0) }

		# NUMERIC
		when (1) : { ok (0) } else { ok (1) }
		when (1.0) : { ok (0) } else { ok (1) }

		# STRING
		when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
		when ('b') : { ok (0) } else { ok (1) }
		when ('c') : { ok (0) } else { ok (1) }

		# ARRAY
		when (['a',2]) : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when (['b','a']) : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when (['b','c']) : { ok (0) } else { ok (1) }
		when ([]) : { ok (0) } else { ok(1) }
		when ([7..100]) : { ok (0) } else { ok(1) }

		# HASH
		when ({}) : { ok (0) } else { ok (1) }
		when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) }

		# SUB/BLOCK
		when {$_[0]{a}} : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when (sub {$_[0]{a}}) : { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		when {0} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		when {1} : { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
	}
}


# 5. CODE SWITCH

$iteration = 0;
for ( sub {1},
      sub { return 0 unless @_;
	    my ($data) = @_;
	    my $type = ref $data;
	    return $type eq 'HASH'   && $data->{a}
		|| $type eq 'Regexp' && 'a' =~ /$data/
		|| $type eq ""       && $data eq '1';
	  },
      sub {0} )
{
	given ($_) {
	$iteration++;
		# SELF
		when ($_) : { ok(1) } else { ok(0) }

		# NUMERIC
		when (1) : { ok ($iteration<=2) } else { ok ($iteration>2) }
		when (1.0) : { ok ($iteration<=2) } else { ok ($iteration>2) }
		when (1.1) : { ok ($iteration==1) } else { ok ($iteration!=1) }

		# STRING
		when ('a') : { ok ($iteration==1) } else { ok ($iteration!=1) }
		when ('b') : { ok ($iteration==1) } else { ok ($iteration!=1) }
		when ('c') : { ok ($iteration==1) } else { ok ($iteration!=1) }
		when ('1') : { ok ($iteration<=2) } else { ok ($iteration>2) }

		# ARRAY
		when ([1, 'a']) : { ok ($iteration<=2) }
			else { ok ($iteration>2) }
		when (['b','a']) : { ok ($iteration==1) }
			else { ok ($iteration!=1) }
		when (['b','c']) : { ok ($iteration==1) }
			else { ok ($iteration!=1) }
		when ([]) : { ok ($iteration==1) } else { ok($iteration!=1) }
		when ([7..100]) : { ok ($iteration==1) }
			else { ok($iteration!=1) }

		# HASH
		when ({}) : { ok ($iteration==1) } else { ok ($iteration!=1) }
		when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration<=2) }
			else { ok ($iteration>2) }

		# SUB/BLOCK
		when {$_[0]->{a}} : { ok (0) } else { ok (1) }
		when (sub {$_[0]{a}}) : { ok (0) } else { ok (1) }
		when {0} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		when {1} : { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
	}
}


# NESTED SWITCHES

for my $count (1..3)
{
	given ([9,"a",11]) {
		when (qr/\d/) : {
				given ($count) {
					when (1)     : { ok($count==1) }
						else { ok($count!=1) }
					when ([5,6]) : { ok(0) } else { ok(1) }
				}
			    }
		ok(1) when 11;
	}
}
Commit	Line	Data
74a6a946	1	#! /usr/local/bin/perl -w
74a6a946	2
88587957	3	BEGIN {
	4	chdir 't' if -d 't';
	5	@INC = '../lib';
	6	}
	7
74a6a946	8	use Carp;
	9	use Switch qw(Perl6 __ fallthrough);
	10
	11	my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
	12	END{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
	22	eval { when 1: { ok(0) }; ok(0) } \|\| ok(1);
	23
	24	# H.O. FUNCS
	25
	26	given (__ > 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
	33	given (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
	44	for (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
88	for ('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
128	my $iteration = 0;
129	for ([],[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;
170	for ({},{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;
214	for ( 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
267	for 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	}