Project: Pugs

Revision: 22149

Author: moritz

Date: 04 Sep 2008 09:41:54

• /t/blocks/slurpy_param.t

  ......	@@ -1,148 +0,0 @@
  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,7 +1,22 @@
  1	1	use v6;
  2	2	use Test;
  3	3
  4		plan 8;
  	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
  5	20
  6	21	sub xelems(*@args) { @args.elems }
  7	22	sub xjoin(*@args) { @args.join('|') }
  ......	@@ -23,4 +38,121 @@
  23	38	is x_typed_join(1, 2, 5), '1|2|5', 'Basic slurpy params with types 2';
  24	39	}
  25	40
  	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
  26	158	# vim: ft=perl6