t/named_params.t

   1 #!perl
   2 use warnings FATAL => 'all';
   3 use strict;
   4
   5 use Test::More tests => 134;
   6 use Test::Fatal;
   7
   8 use Function::Parameters qw(:strict);
   9
  10 sub compile_fail {
  11         my ($src, $re, $name) = @_;
  12         is eval $src, undef;
  13         like $@, $re, $name || ();
  14 }
  15
  16
  17 compile_fail 'fun (:$n1, $p1) {}', qr/\bpositional\b.+\bnamed\b/;
  18 compile_fail 'fun (@rest, :$n1) {}', qr/\@rest\b.+\$n1\b/;
  19 compile_fail 'fun (:$n1, :$n1) {}', qr/\$n1\b.+\btwice\b/;
  20 compile_fail 'method (:$ni:) {}', qr/\binvocant\b.+\$ni\b.+\bnamed\b/;
  21
  22
  23 fun name_1(:$n1) { [$n1, @_] }
  24
  25 like exception { name_1 }, qr/Not enough arguments/;
  26 like exception { name_1 'n1' }, qr/Not enough arguments/;
  27 like exception { name_1 'asdf' }, qr/Not enough arguments/;
  28 like exception { name_1 huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
  29 is_deeply name_1(n1 => undef), [undef, n1 => undef];
  30 is_deeply name_1(n1 => 'a'), ['a', n1 => 'a'];
  31 is_deeply name_1(n1 => 'a', n1 => 'b'), ['b', n1 => 'a', n1 => 'b'];
  32 is_deeply name_1(n1 => 'a', n1 => undef), [undef, n1 => 'a', n1 => undef];
  33
  34
  35 fun name_0_1(:$n1 = 'd') { [$n1, @_] }
  36
  37 is_deeply name_0_1, ['d'];
  38 like exception { name_0_1 'n1' }, qr/Odd number/;
  39 like exception { name_0_1 'asdf' }, qr/Odd number/;
  40 like exception { name_0_1 huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
  41 is_deeply name_0_1(n1 => 'a'), ['a', n1 => 'a'];
  42 is_deeply name_0_1(n1 => 'a', n1 => 'b'), ['b', n1 => 'a', n1 => 'b'];
  43 is_deeply name_0_1(n1 => 'a', n1 => undef), [undef, n1 => 'a', n1 => undef];
  44
  45
  46 fun pos_1_name_1($p1, :$n1) { [$p1, $n1, @_] }
  47
  48 like exception { pos_1_name_1 }, qr/Not enough arguments/;
  49 like exception { pos_1_name_1 42 }, qr/Not enough arguments/;
  50 like exception { pos_1_name_1 42, 'n1' }, qr/Not enough arguments/;
  51 like exception { pos_1_name_1 42, 'asdf' }, qr/Not enough arguments/;
  52 like exception { pos_1_name_1 42, huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
  53 is_deeply pos_1_name_1(42, n1 => undef), [42, undef, 42, n1 => undef];
  54 is_deeply pos_1_name_1(42, n1 => 'a'), [42, 'a', 42, n1 => 'a'];
  55 is_deeply pos_1_name_1(42, n1 => 'a', n1 => 'b'), [42, 'b', 42, n1 => 'a', n1 => 'b'];
  56 is_deeply pos_1_name_1(42, n1 => 'a', n1 => undef), [42, undef, 42, n1 => 'a', n1 => undef];
  57
  58
  59 compile_fail 'fun pos_0_1_name_1($p1 = "e", :$n1) { [$p1, $n1, @_] }', qr/\boptional positional\b.+\brequired named\b/;
  60
  61
  62 fun pos_1_name_0_1($p1, :$n1 = 'd') { [$p1, $n1, @_] }
  63
  64 like exception { pos_1_name_0_1 }, qr/Not enough arguments/;
  65 is_deeply pos_1_name_0_1(42), [42, 'd', 42];
  66 like exception { pos_1_name_0_1 42, 'n1' }, qr/Odd number/;
  67 like exception { pos_1_name_0_1 42, 'asdf' }, qr/Odd number/;
  68 like exception { pos_1_name_0_1 42, huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
  69 is_deeply pos_1_name_0_1(42, n1 => undef), [42, undef, 42, n1 => undef];
  70 is_deeply pos_1_name_0_1(42, n1 => 'a'), [42, 'a', 42, n1 => 'a'];
  71 is_deeply pos_1_name_0_1(42, n1 => 'a', n1 => 'b'), [42, 'b', 42, n1 => 'a', n1 => 'b'];
  72 is_deeply pos_1_name_0_1(42, n1 => 'a', n1 => undef), [42, undef, 42, n1 => 'a', n1 => undef];
  73
  74
  75 fun pos_0_1_name_0_1($p1 = 'e', :$n1 = 'd') { [$p1, $n1, @_] }
  76
  77 is_deeply pos_0_1_name_0_1, ['e', 'd'];
  78 is_deeply pos_0_1_name_0_1(42), [42, 'd', 42];
  79 like exception { pos_0_1_name_0_1 42, 'n1' }, qr/Odd number/;
  80 like exception { pos_0_1_name_0_1 42, 'asdf' }, qr/Odd number/;
  81 like exception { pos_0_1_name_0_1 42, huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
  82 is_deeply pos_0_1_name_0_1(42, n1 => undef), [42, undef, 42, n1 => undef];
  83 is_deeply pos_0_1_name_0_1(42, n1 => 'a'), [42, 'a', 42, n1 => 'a'];
  84 is_deeply pos_0_1_name_0_1(42, n1 => 'a', n1 => 'b'), [42, 'b', 42, n1 => 'a', n1 => 'b'];
  85 is_deeply pos_0_1_name_0_1(42, n1 => 'a', n1 => undef), [42, undef, 42, n1 => 'a', n1 => undef];
  86
  87
  88 fun name_1_slurp(:$n1, @rest) { [$n1, \@rest, @_] }
  89
  90 like exception { name_1_slurp }, qr/Not enough arguments/;
  91 like exception { name_1_slurp 'n1' }, qr/Not enough arguments/;
  92 like exception { name_1_slurp 'asdf' }, qr/Not enough arguments/;
  93 like exception { name_1_slurp huh => 1 }, qr/Missing named\b.+\bn1\b/;
  94 is_deeply name_1_slurp(n1 => 'a'), ['a', [], n1 => 'a'];
  95 like exception { name_1_slurp n1 => 'a', 'n1' }, qr/Odd number/;
  96 is_deeply name_1_slurp(n1 => 'a', foo => 'bar'), ['a', [foo => 'bar'], n1 => 'a', foo => 'bar'];
  97 is_deeply name_1_slurp(foo => 'bar', n1 => 'a', foo => 'quux'), ['a', [foo => 'bar', foo => 'quux'], foo => 'bar', n1 => 'a', foo => 'quux'];
  98
  99
 100 fun name_0_1_slurp(:$n1 = 'd', @rest) { [$n1, \@rest, @_] }
 101
 102 is_deeply name_0_1_slurp, ['d', []];
 103 like exception { name_0_1_slurp 'n1' }, qr/Odd number/;
 104 like exception { name_0_1_slurp 'asdf' }, qr/Odd number/;
 105 is_deeply name_0_1_slurp(n1 => 'a'), ['a', [], n1 => 'a'];
 106 like exception { name_0_1_slurp n1 => 'a', 'n1' }, qr/Odd number/;
 107 is_deeply name_0_1_slurp(a => 'b'), ['d', [a => 'b'], a => 'b'];
 108 is_deeply name_0_1_slurp(n1 => 'a', foo => 'bar'), ['a', [foo => 'bar'], n1 => 'a', foo => 'bar'];
 109 is_deeply name_0_1_slurp(foo => 'bar', n1 => 'a', foo => 'quux'), ['a', [foo => 'bar', foo => 'quux'], foo => 'bar', n1 => 'a', foo => 'quux'];
 110
 111
 112 fun name_2(:$n1, :$n2) { [$n1, $n2, @_] }
 113
 114 like exception { name_2 }, qr/Not enough arguments/;
 115 like exception { name_2 'n1' }, qr/Not enough arguments/;
 116 like exception { name_2 'asdf' }, qr/Not enough arguments/;
 117 like exception { name_2 huh => 1 }, qr/Not enough arguments/;
 118 like exception { name_2 n1 => 'a' }, qr/Not enough arguments/;
 119 like exception { name_2 n1 => 'a', n1 => 'b' }, qr/Missing named\b.+\bn2\b/;
 120 like exception { name_2 n2 => 'a' }, qr/Not enough arguments/;
 121 like exception { name_2 n2 => 'a', n2 => 'b' }, qr/Missing named\b.+\bn1\b/;
 122 like exception { name_2 n1 => 'a', 'n2' }, qr/Not enough arguments/;
 123 like exception { name_2 n1 => 'a', 'asdf' }, qr/Not enough arguments/;
 124 like exception { name_2 n2 => 'b', n1 => 'a', huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
 125 is_deeply name_2(n2 => 42, n1 => undef), [undef, 42, n2 => 42, n1 => undef];
 126 is_deeply name_2(n2 => 42, n1 => 'a'), ['a', 42, n2 => 42, n1 => 'a'];
 127 is_deeply name_2(n2 => 42, n1 => 'a', n1 => 'b'), ['b', 42, n2 => 42, n1 => 'a', n1 => 'b'];
 128 is_deeply name_2(n2 => 42, n1 => 'a', n1 => undef), [undef, 42, n2 => 42, n1 => 'a', n1 => undef];
 129 is_deeply name_2(n1 => undef, n2 => 42), [undef, 42, n1 => undef, n2 => 42];
 130 is_deeply name_2(n1 => 'a', n2 => 42), ['a', 42, n1 => 'a', n2 => 42];
 131 is_deeply name_2(n1 => 'a', n1 => 'b', n2 => 42), ['b', 42, n1 => 'a', n1 => 'b', n2 => 42];
 132 is_deeply name_2(n1 => 'a', n2 => 42, n1 => undef), [undef, 42, n1 => 'a', n2 => 42, n1 => undef];
 133
 134
 135 fun name_1_2(:$n1, :$n2 = 'f') { [$n1, $n2, @_] }
 136
 137 like exception { name_1_2 }, qr/Not enough arguments/;
 138 like exception { name_1_2 'n1' }, qr/Not enough arguments/;
 139 like exception { name_1_2 'asdf' }, qr/Not enough arguments/;
 140 like exception { name_1_2 huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
 141 is_deeply name_1_2(n1 => 'a'), ['a', 'f', n1 => 'a'];
 142 is_deeply name_1_2(n1 => 'a', n1 => 'b'), ['b', 'f', n1 => 'a', n1 => 'b'];
 143 like exception { name_1_2 n2 => 'a' }, qr/Missing named\b.+\bn1\b/;
 144 like exception { name_1_2 n2 => 'a', n2 => 'b' }, qr/Missing named\b.+\bn1\b/;
 145 like exception { name_1_2 n1 => 'a', 'n2' }, qr/Odd number/;
 146 like exception { name_1_2 n1 => 'a', 'asdf' }, qr/Odd number/;
 147 like exception { name_1_2 n2 => 'b', n1 => 'a', huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
 148 is_deeply name_1_2(n2 => 42, n1 => undef), [undef, 42, n2 => 42, n1 => undef];
 149 is_deeply name_1_2(n2 => 42, n1 => 'a'), ['a', 42, n2 => 42, n1 => 'a'];
 150 is_deeply name_1_2(n2 => 42, n1 => 'a', n1 => 'b'), ['b', 42, n2 => 42, n1 => 'a', n1 => 'b'];
 151 is_deeply name_1_2(n2 => 42, n1 => 'a', n1 => undef), [undef, 42, n2 => 42, n1 => 'a', n1 => undef];
 152 is_deeply name_1_2(n1 => undef, n2 => 42), [undef, 42, n1 => undef, n2 => 42];
 153 is_deeply name_1_2(n1 => 'a', n2 => 42), ['a', 42, n1 => 'a', n2 => 42];
 154 is_deeply name_1_2(n1 => 'a', n1 => 'b', n2 => 42), ['b', 42, n1 => 'a', n1 => 'b', n2 => 42];
 155 is_deeply name_1_2(n1 => 'a', n2 => 42, n1 => undef), [undef, 42, n1 => 'a', n2 => 42, n1 => undef];
 156
 157
 158 fun name_0_2(:$n1 = 'd', :$n2 = 'f') { [$n1, $n2, @_] }
 159
 160 is_deeply name_0_2, ['d', 'f'];
 161 like exception { name_0_2 'n1' }, qr/Odd number/;
 162 like exception { name_0_2 'asdf' }, qr/Odd number/;
 163 like exception { name_0_2 huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
 164 is_deeply name_0_2(n1 => 'a'), ['a', 'f', n1 => 'a'];
 165 is_deeply name_0_2(n1 => 'a', n1 => 'b'), ['b', 'f', n1 => 'a', n1 => 'b'];
 166 is_deeply name_0_2(n2 => 'a'), ['d', 'a', n2 => 'a'];
 167 is_deeply name_0_2(n2 => 'a', n2 => 'b'), ['d', 'b', n2 => 'a', n2 => 'b'];
 168 like exception { name_0_2 n1 => 'a', 'n2' }, qr/Odd number/;
 169 like exception { name_0_2 n1 => 'a', 'asdf' }, qr/Odd number/;
 170 like exception { name_0_2 n2 => 'b', n1 => 'a', huh => 1 }, qr/\bnamed\b.+\bhuh\b/;
 171 is_deeply name_0_2(n2 => 42, n1 => undef), [undef, 42, n2 => 42, n1 => undef];
 172 is_deeply name_0_2(n2 => 42, n1 => 'a'), ['a', 42, n2 => 42, n1 => 'a'];
 173 is_deeply name_0_2(n2 => 42, n1 => 'a', n1 => 'b'), ['b', 42, n2 => 42, n1 => 'a', n1 => 'b'];
 174 is_deeply name_0_2(n2 => 42, n1 => 'a', n1 => undef), [undef, 42, n2 => 42, n1 => 'a', n1 => undef];
 175 is_deeply name_0_2(n1 => undef, n2 => 42), [undef, 42, n1 => undef, n2 => 42];
 176 is_deeply name_0_2(n1 => 'a', n2 => 42), ['a', 42, n1 => 'a', n2 => 42];
 177 is_deeply name_0_2(n1 => 'a', n1 => 'b', n2 => 42), ['b', 42, n1 => 'a', n1 => 'b', n2 => 42];
 178 is_deeply name_0_2(n1 => 'a', n2 => 42, n1 => undef), [undef, 42, n1 => 'a', n2 => 42, n1 => undef];
 179
 180
 181 fun pos_1_2_name_0_3_slurp($p1, $p2 = 'E', :$n1 = undef, :$n2 = 'A', :$n3 = 'F', @rest) { [$p1, $p2, $n1, $n2, $n3, \@rest, @_] }
 182
 183 like exception { pos_1_2_name_0_3_slurp }, qr/Not enough/;
 184 is_deeply pos_1_2_name_0_3_slurp('a'), ['a', 'E', undef, 'A', 'F', [], 'a'];
 185 is_deeply pos_1_2_name_0_3_slurp('a', 'b'), ['a', 'b', undef, 'A', 'F', [], 'a', 'b'];
 186 like exception { pos_1_2_name_0_3_slurp 'a', 'b', 'c' }, qr/Odd number/;
 187 is_deeply pos_1_2_name_0_3_slurp('a', 'b', 'c', 'd'), ['a', 'b', undef, 'A', 'F', ['c', 'd'], 'a', 'b', 'c', 'd'];
 188 like exception { pos_1_2_name_0_3_slurp 'a', 'b', 'c', 'd', 'e' }, qr/Odd number/;
 189 is_deeply pos_1_2_name_0_3_slurp('a', 'b', 'c', 'd', 'e', 'f'), ['a', 'b', undef, 'A', 'F', ['c', 'd', 'e', 'f'], 'a', 'b', 'c', 'd', 'e', 'f'];
 190 is_deeply pos_1_2_name_0_3_slurp('a', 'b', n2 => 'c', n1 => 'd'), ['a', 'b', 'd', 'c', 'F', [], 'a', 'b', n2 => 'c', n1 => 'd'];
 191 is_deeply pos_1_2_name_0_3_slurp('a', 'b', n2 => 'c', beans => 'legume', n1 => 'd'), ['a', 'b', 'd', 'c', 'F', [beans => 'legume'], 'a', 'b', n2 => 'c', beans => 'legume', n1 => 'd'];