Project: Pugs

Revision: 22150

Author: moritz

Date: 04 Sep 2008 09:58:57

• /t/spec/S06-signature/slurpy-params-2.t

  ......	@@ -0,0 +1,148 @@
  	1	use v6;
  	2
  	3	use Test;
  	4
  	5	=begin pod
  	6
  	7	=head1 List parameter test
  	8
  	9	These tests are the testing for "List paameters" section of Synopsis 06
  	10
  	11	L<<S06/List parameters/Slurpy parameters follow any required>>
  	12
  	13	You might also be interested in the thread Calling positionals by name in
  	14	presence of a slurpy hash" on p6l started by Ingo
  	15	Blechschmidt L<http://www.nntp.perl.org/group/perl.perl6.language/22883>
  	16
  	17	=end pod
  	18
  	19	plan 26;
  	20
  	21	{
  	22	# Positional with slurpy *%h and slurpy *@a
  	23	my sub foo($n, *%h, *@a) { };
  	24	my sub foo1($n, *%h, *@a) { $n }
  	25	my sub foo2($n, *%h, *@a) { %h<x> + %h<y> + %h<n> }
  	26	my sub foo3($n, *%h, *@a) { @a.sum }
  	27
  	28	## all pairs will be slurped into hash, except the key which has the same name
  	29	## as positional parameter
  	30	diag('Testing with positional arguments');
  	31	lives_ok { foo 1, x => 20, y => 300, 4000 },
  	32	'Testing: `sub foo($n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
  	33	is (foo1 1, x => 20, y => 300, 4000), 1,
  	34	'Testing the value for positional';
  	35	is (foo2 1, x => 20, y => 300, 4000), 320,
  	36	'Testing the value for slurpy *%h';
  	37	is (foo3 1, x => 20, y => 300, 4000), 4000,
  	38	'Testing the value for slurpy *@a';
  	39
  	40	dies_ok { foo 1, n => 20, y => 300, 4000 },
  	41	'Testing: `sub foo($n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`', :todo<bug>;
  	42
  	43	## We *can* pass positional arguments as a 'named' pair with slurpy *%h.
  	44	## Only *remaining* pairs are slurped into the *%h
  	45	# Note: with slurpy *@a, you can pass positional params, But will be slurped into *@a
  	46	diag('Testing without positional arguments');
  	47	lives_ok { foo n => 20, y => 300, 4000 },
  	48	'Testing: `sub foo($n, *%h, *@a){ }; foo n => 20, y => 300, 4000`';
  	49	is (foo1 n => 20, y => 300, 4000), 20,
  	50	'Testing the value for positional';
  	51	is (foo2 n => 20, y => 300, 4000), 300,
  	52	'Testing the value for slurpy *%h';
  	53	is (foo3 n => 20, y => 300, 4000), 4000,
  	54	'Testing the value for slurpy *@a';
  	55	}
  	56
  	57
  	58	{
  	59	my sub foo ($n, *%h) { };
  	60	## NOTE: *NOT* sub foo ($n, *%h, *@a)
  	61	dies_ok { foo 1, n => 20, y => 300 },
  	62	'Testing: `sub foo($n, *%h) { }; foo 1, n => 20, y => 300`', :todo<bug>;
  	63	}
  	64
  	65	{
  	66	my sub foo ($n, *%h) { };
  	67	## NOTE: *NOT* sub foo ($n, *%h, *@a)
  	68	dies_ok { foo 1, x => 20, y => 300, 4000 },
  	69	'Testing: `sub foo($n, *%h) { }; foo 1, x => 20, y => 300, 4000`';
  	70	}
  	71
  	72
  	73	# Named with slurpy *%h and slurpy *@a
  	74	# named arguments aren't required in tests below
  	75	{
  	76	my sub foo(:$n, *%h, *@a) { };
  	77	my sub foo1(:$n, *%h, *@a) { $n };
  	78	my sub foo2(:$n, *%h, *@a) { %h<x> + %h<y> + %h<n> };
  	79	my sub foo3(:$n, *%h, *@a) { return @a.sum };
  	80
  	81	diag("Testing with named arguments (named param isn't required)");
  	82	lives_ok { foo 1, x => 20, y => 300, 4000 },
  	83	'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
  	84	is (foo1 1, x => 20, y => 300, 4000), undef,
  	85	'Testing value for named argument';
  	86	is (foo2 1, x => 20, y => 300, 4000), 320,
  	87	'Testing value for slurpy *%h';
  	88	is (foo3 1, x => 20, y => 300, 4000), 4001,
  	89	'Testing the value for slurpy *@a';
  	90
  	91	### named parameter pair will always have a higher "priority" while passing
  	92	### so %h<n> will always be undef
  	93	lives_ok { foo1 1, n => 20, y => 300, 4000 },
  	94	'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
  	95	is (foo1 1, n => 20, y => 300, 4000), 20,
  	96	'Testing the named argument';
  	97	is (foo2 1, n => 20, y => 300, 4000), 300,
  	98	'Testing value for slurpy *%h';
  	99	is (foo3 1, n => 20, y => 300, 4000), 4001,
  	100	'Testing the value for slurpy *@a';
  	101	}
  	102
  	103
  	104	# named with slurpy *%h and slurpy *@a
  	105	## Named arguments **ARE** required in tests below
  	106
  	107	#### ++ version
  	108	{
  	109	my sub foo(:$n!, *%h, *@a){ };
  	110	diag('Testing with named arguments (named param is required) (++ version)');
  	111	lives_ok { foo 1, n => 20, y => 300, 4000 },
  	112	'Testing: `my sub foo(+:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
  	113	dies_ok { foo 1, x => 20, y => 300, 4000 }, :todo<bug>;
  	114	}
  	115
  	116	#### "trait" version
  	117	{
  	118	my sub foo(:$n is required, *%h, *@a) { };
  	119	diag('Testing with named arguments (named param is required) (trait version)');
  	120	lives_ok { foo 1, n => 20, y => 300, 4000 },
  	121	'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
  	122	dies_ok { foo 1, x => 20, y => 300, 4000 },
  	123	'Testing: `my sub foo(:$n is required, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000 }`', :todo<bug>;
  	124	}
  	125
  	126	##### Now slurpy scalar tests here.
  	127	=begin desc
  	128
  	129	=head1 List parameter test
  	130
  	131	These tests are the testing for "List paameters" section of Synopsis 06
  	132
  	133	L<<S06/List parameters/Slurpy scalar parameters capture what would otherwise be the first elements of the variadic array:>>
  	134
  	135	=end desc
  	136
  	137	sub first(*$f, *$s, *@r){ return $f };
  	138	sub second(*$f, *$s, *@r){ return $s };
  	139	sub rest(*$f, *$s, *@r){ return @r.sum };
  	140	diag 'Testing with slurpy scalar';
  	141	is first(1, 2, 3, 4, 5), 1,
  	142	'Testing the first slurpy scalar...';
  	143	is second(1, 2, 3, 4, 5), 2,
  	144	'Testing the second slurpy scalar...';
  	145	is rest(1, 2, 3, 4, 5), 12,
  	146	'Testing the rest slurpy *@r';
  	147
  	148	# vim: ft=perl6

• /t/spec/S06-signature/slurpy-params.t

  ......	@@ -1,22 +1,7 @@
  1	1	use v6;
  2	2	use Test;
  3	3
  4		plan 32;
  5
  6		=begin pod
  7
  8		=head1 List parameter test
  9
  10		These tests are the testing for "List paameters" section of Synopsis 06
  11
  12		L<<S06/List parameters/Slurpy parameters follow any required>>
  13
  14		You might also be interested in the thread Calling positionals by name in
  15		presence of a slurpy hash" on p6l started by Ingo
  16		Blechschmidt L<http://www.nntp.perl.org/group/perl.perl6.language/22883>
  17
  18		=end pod
  19
  	4	plan 8;
  20	5
  21	6	sub xelems(*@args) { @args.elems }
  22	7	sub xjoin(*@args) { @args.join('|') }
  ......	@@ -38,121 +23,4 @@
  38	23	is x_typed_join(1, 2, 5), '1|2|5', 'Basic slurpy params with types 2';
  39	24	}
  40	25
  41		{
  42		# Positional with slurpy *%h and slurpy *@a
  43		my sub foo($n, *%h, *@a) { };
  44		my sub foo1($n, *%h, *@a) { $n }
  45		my sub foo2($n, *%h, *@a) { %h<x> + %h<y> + %h<n> }
  46		my sub foo3($n, *%h, *@a) { @a.sum }
  47
  48		## all pairs will be slurped into hash, except the key which has the same name
  49		## as positional parameter
  50		diag('Testing with positional arguments');
  51		lives_ok { foo 1, x => 20, y => 300, 4000 },
  52		'Testing: `sub foo($n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
  53		is (foo1 1, x => 20, y => 300, 4000), 1,
  54		'Testing the value for positional';
  55		is (foo2 1, x => 20, y => 300, 4000), 320,
  56		'Testing the value for slurpy *%h';
  57		is (foo3 1, x => 20, y => 300, 4000), 4000,
  58		'Testing the value for slurpy *@a';
  59
  60		dies_ok { foo 1, n => 20, y => 300, 4000 },
  61		'Testing: `sub foo($n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`', :todo<bug>;
  62
  63		## We *can* pass positional arguments as a 'named' pair with slurpy *%h.
  64		## Only *remaining* pairs are slurped into the *%h
  65		# Note: with slurpy *@a, you can pass positional params, But will be slurped into *@a
  66		diag('Testing without positional arguments');
  67		lives_ok { foo n => 20, y => 300, 4000 },
  68		'Testing: `sub foo($n, *%h, *@a){ }; foo n => 20, y => 300, 4000`';
  69		is (foo1 n => 20, y => 300, 4000), 20,
  70		'Testing the value for positional';
  71		is (foo2 n => 20, y => 300, 4000), 300,
  72		'Testing the value for slurpy *%h';
  73		is (foo3 n => 20, y => 300, 4000), 4000,
  74		'Testing the value for slurpy *@a';
  75		}
  76
  77
  78		{
  79		my sub foo ($n, *%h) { };
  80		## NOTE: *NOT* sub foo ($n, *%h, *@a)
  81		dies_ok { foo 1, n => 20, y => 300 },
  82		'Testing: `sub foo($n, *%h) { }; foo 1, n => 20, y => 300`', :todo<bug>;
  83		}
  84
  85		{
  86		my sub foo ($n, *%h) { };
  87		## NOTE: *NOT* sub foo ($n, *%h, *@a)
  88		dies_ok { foo 1, x => 20, y => 300, 4000 },
  89		'Testing: `sub foo($n, *%h) { }; foo 1, x => 20, y => 300, 4000`';
  90		}
  91
  92
  93		# Named with slurpy *%h and slurpy *@a
  94		# named arguments aren't required in tests below
  95		{
  96		my sub foo(:$n, *%h, *@a) { };
  97		my sub foo1(:$n, *%h, *@a) { $n };
  98		my sub foo2(:$n, *%h, *@a) { %h<x> + %h<y> + %h<n> };
  99		my sub foo3(:$n, *%h, *@a) { return @a.sum };
  100
  101		diag("Testing with named arguments (named param isn't required)");
  102		lives_ok { foo 1, x => 20, y => 300, 4000 },
  103		'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, x => 20, y => 300, 4000`';
  104		is (foo1 1, x => 20, y => 300, 4000), undef,
  105		'Testing value for named argument';
  106		is (foo2 1, x => 20, y => 300, 4000), 320,
  107		'Testing value for slurpy *%h';
  108		is (foo3 1, x => 20, y => 300, 4000), 4001,
  109		'Testing the value for slurpy *@a';
  110
  111		### named parameter pair will always have a higher "priority" while passing
  112		### so %h<n> will always be undef
  113		lives_ok { foo1 1, n => 20, y => 300, 4000 },
  114		'Testing: `sub foo(:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
  115		is (foo1 1, n => 20, y => 300, 4000), 20,
  116		'Testing the named argument';
  117		is (foo2 1, n => 20, y => 300, 4000), 300,
  118		'Testing value for slurpy *%h';
  119		is (foo3 1, n => 20, y => 300, 4000), 4001,
  120		'Testing the value for slurpy *@a';
  121		}
  122
  123
  124		# named with slurpy *%h and slurpy *@a
  125		## Named arguments **ARE** required in tests below
  126
  127		#### ++ version
  128		{
  129		my sub foo(:$n!, *%h, *@a){ };
  130		diag('Testing with named arguments (named param is required) (++ version)');
  131		lives_ok { foo 1, n => 20, y => 300, 4000 },
  132		'Testing: `my sub foo(+:$n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000 }`';
  133		dies_ok { foo 1, x => 20, y => 300, 4000 }, :todo<bug>;
  134		}
  135
  136		##### Now slurpy scalar tests here.
  137		=begin desc
  138
  139		=head1 List parameter test
  140
  141		These tests are the testing for "List paameters" section of Synopsis 06
  142
  143		L<<S06/List parameters/Slurpy scalar parameters capture what would otherwise be the first elements of the variadic array:>>
  144
  145		=end desc
  146
  147		sub first(*$f, *$s, *@r){ return $f };
  148		sub second(*$f, *$s, *@r){ return $s };
  149		sub rest(*$f, *$s, *@r){ return @r.sum };
  150		diag 'Testing with slurpy scalar';
  151		is first(1, 2, 3, 4, 5), 1,
  152		'Testing the first slurpy scalar...';
  153		is second(1, 2, 3, 4, 5), 2,
  154		'Testing the second slurpy scalar...';
  155		is rest(1, 2, 3, 4, 5), 12,
  156		'Testing the rest slurpy *@r';
  157
  158	26	# vim: ft=perl6