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

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

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