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

BEGIN {
    if ($ENV{PERL_CORE}) {
        chdir('t') if -d 't';
        @INC = qw(../lib);
    }
}

use Carp;
use Switch qw(__ 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-case THINGS;

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

*case = \&case;

# PREMATURE case

eval { case 1 { ok(0) }; ok(0) } || ok(1);

# H.O. FUNCS

switch (__ > 2) {

	case 1	{ ok(0) } else { ok(1) }
	case 2	{ ok(0) } else { ok(1) }
	case 3	{ ok(1) } else { ok(0) }
}

switch (3) {

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

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

# 1. NUMERIC SWITCH

for (1..3)
{
	switch ($_) {
		# SELF
		case ($_) { ok(1) } else { ok(0) }

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

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

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

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

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


# 2. STRING SWITCH

for ('a'..'c','1')
{
	switch ($_) {
		# SELF
		case ($_) { ok(1) } else { ok(0) }

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

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

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

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

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


# 3. ARRAY SWITCH

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

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

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

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

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

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


# 4. HASH SWITCH

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

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

		# NUMERIC
		case (1) { ok (0) } else { ok (1) }
		case (1.0) { ok (0) } else { ok (1) }

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

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

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

		# SUB/BLOCK
		case {$_[0]{a}} { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		case (sub {$_[0]{a}}) { ok ($iteration==2) }
			else { ok ($iteration!=2) }
		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
		case {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} )
{
	switch ($_) {
	$iteration++;
		# SELF
		case ($_) { ok(1) } else { ok(0) }

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

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

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

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

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


# NESTED SWITCHES

for my $count (1..3)
{
	switch ([9,"a",11]) {
		case (qr/\d/) {
				switch ($count) {
					case (1)     { ok($count==1) }
						else { ok($count!=1) }
					case ([5,6]) { ok(0) } else { ok(1) }
				}
			    }
		ok(1) case (11);
	}
}
Commit	Line	Data
88587957	1	BEGIN {
6596d39b	2	if ($ENV{PERL_CORE}) {
	3	chdir('t') if -d 't';
	4	@INC = qw(../lib);
	5	}
88587957	6	}
88587957	7
3ed9f206	8	use Carp;
	9	use Switch qw(__ fallthrough);
	10
3961318e	11	my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
3961318e	12	END{print"1..$C\n$M"}
3ed9f206	13
	14	# NON-case THINGS;
	15
	16	$case->{case} = { case => "case" };
	17
	18	*case = \&case;
	19
	20	# PREMATURE case
	21
	22	eval { case 1 { ok(0) }; ok(0) } \|\| ok(1);
	23
	24	# H.O. FUNCS
	25
	26	switch (__ > 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
	33	switch (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
	44	for (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
88	for ('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
128	my $iteration = 0;
129	for ([],[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;
170	for ({},{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;
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	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
267	for 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	}