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

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