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

BEGIN {
    if ($ENV{PERL_CORE}) {
        chdir('t') if -d 't';
        @INC = qw(../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
88587957	1	BEGIN {
6596d39b	2	if ($ENV{PERL_CORE}) {
	3	chdir('t') if -d 't';
	4	@INC = qw(../lib);
	5	}
88587957	6	}
88587957	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
6596d39b	22	eval { when 1 { ok(0) }; ok(0) } \|\| ok(1);
74a6a946	23
	24	# H.O. FUNCS
	25
6596d39b	26	given __ > 2 {
74a6a946	27
6596d39b	28	when 1 { ok(0) } else { ok(1) }
	29	when 2 { ok(0) } else { ok(1) }
	30	when 3 { ok(1) } else { ok(0) }
74a6a946	31	}
	32
	33	given (3) {
	34
6596d39b	35	eval { when __ <= 1 \|\| __ > 2 { ok(0) } } \|\| ok(1);
	36	when __ <= 2 { ok(0) };
	37	when __ <= 3 { ok(1) };
74a6a946	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
6596d39b	48	when ($_) { ok(1) } else { ok(0) }
74a6a946	49
74a6a946	50	# NUMERIC
6596d39b	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) }
74a6a946	56
74a6a946	57	# STRING
6596d39b	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) }
74a6a946	62
74a6a946	63	# ARRAY
6596d39b	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) }
74a6a946	70
74a6a946	71	# HASH
6596d39b	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) }
74a6a946	76
74a6a946	77	# SUB/BLOCK
6596d39b	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
74a6a946	82	}
	83	}
	84
	85
	86	# 2. STRING SWITCH
	87
	88	for ('a'..'c','1')
	89	{
	90	given ($_) {
	91	# SELF
6596d39b	92	when ($_) { ok(1) } else { ok(0) }
74a6a946	93
74a6a946	94	# NUMERIC
6596d39b	95	when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
6596d39b	96	when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
74a6a946	97
74a6a946	98	# STRING
6596d39b	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) }
74a6a946	104
74a6a946	105	# ARRAY
6596d39b	106	when (['a','1']) { ok ($_ eq 'a' \|\| $_ eq '1') }
74a6a946	107	else { ok ($_ ne 'a' && $_ ne '1') }
6596d39b	108	when (['z','2']) { ok (0) } else { ok(1) }
6596d39b	109	when ([]) { ok (0) } else { ok(1) }
74a6a946	110
74a6a946	111	# HASH
6596d39b	112	when ({}) { ok (0) } else { ok (1) }
6596d39b	113	when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' \|\| $_ eq '1') }
74a6a946	114	else { ok ($_ ne 'a' && $_ ne '1') }
	115
	116	# SUB/BLOCK
6596d39b	117	when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
74a6a946	118	else { ok($_ ne 'a') }
6596d39b	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
74a6a946	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
6596d39b	134	when ($_) { ok(1) }
74a6a946	135
74a6a946	136	# NUMERIC
6596d39b	137	when (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
6596d39b	138	when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
74a6a946	139
74a6a946	140	# STRING
6596d39b	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) }
74a6a946	144
74a6a946	145	# ARRAY
6596d39b	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) }
74a6a946	150
74a6a946	151	# HASH
6596d39b	152	when ({}) { ok (0) } else { ok (1) }
6596d39b	153	when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
74a6a946	154	else { ok ($iteration!=2) }
	155
	156	# SUB/BLOCK
6596d39b	157	when {scalar grep /a/, @_} { ok ($iteration==2) }
74a6a946	158	else { ok ($iteration!=2) }
6596d39b	159	when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
74a6a946	160	else { ok ($iteration!=2) }
6596d39b	161	when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
6596d39b	162	when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
74a6a946	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
6596d39b	176	when ($_) { ok(1) } else { ok(0) }
74a6a946	177
74a6a946	178	# NUMERIC
6596d39b	179	when (1) { ok (0) } else { ok (1) }
6596d39b	180	when (1.0) { ok (0) } else { ok (1) }
74a6a946	181
74a6a946	182	# STRING
6596d39b	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) }
74a6a946	186
74a6a946	187	# ARRAY
6596d39b	188	when (['a',2]) { ok ($iteration==2) }
74a6a946	189	else { ok ($iteration!=2) }
6596d39b	190	when (['b','a']) { ok ($iteration==2) }
74a6a946	191	else { ok ($iteration!=2) }
6596d39b	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) }
74a6a946	195
74a6a946	196	# HASH
6596d39b	197	when ({}) { ok (0) } else { ok (1) }
6596d39b	198	when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
74a6a946	199
74a6a946	200	# SUB/BLOCK
6596d39b	201	when {$_[0]{a}} { ok ($iteration==2) }
74a6a946	202	else { ok ($iteration!=2) }
6596d39b	203	when (sub {$_[0]{a}}) { ok ($iteration==2) }
74a6a946	204	else { ok ($iteration!=2) }
6596d39b	205	when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
6596d39b	206	when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
74a6a946	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
6596d39b	227	when ($_) { ok(1) } else { ok(0) }
74a6a946	228
74a6a946	229	# NUMERIC
6596d39b	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) }
74a6a946	233
74a6a946	234	# STRING
6596d39b	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) }
74a6a946	239
74a6a946	240	# ARRAY
6596d39b	241	when ([1, 'a']) { ok ($iteration<=2) }
74a6a946	242	else { ok ($iteration>2) }
6596d39b	243	when (['b','a']) { ok ($iteration==1) }
74a6a946	244	else { ok ($iteration!=1) }
6596d39b	245	when (['b','c']) { ok ($iteration==1) }
74a6a946	246	else { ok ($iteration!=1) }
6596d39b	247	when ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
6596d39b	248	when ([7..100]) { ok ($iteration==1) }
74a6a946	249	else { ok($iteration!=1) }
	250
	251	# HASH
6596d39b	252	when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
6596d39b	253	when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
74a6a946	254	else { ok ($iteration>2) }
	255
	256	# SUB/BLOCK
6596d39b	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
74a6a946	261	}
	262	}
	263
	264
	265	# NESTED SWITCHES
	266
	267	for my $count (1..3)
	268	{
	269	given ([9,"a",11]) {
6596d39b	270	when (qr/\d/) {
74a6a946	271	given ($count) {
6596d39b	272	when (1) { ok($count==1) }
74a6a946	273	else { ok($count!=1) }
6596d39b	274	when ([5,6]) { ok(0) } else { ok(1) }
74a6a946	275	}
	276	}
	277	ok(1) when 11;
	278	}
	279	}