Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

224 lines (183 sloc) 6.262 kb
use v6;
use Test;
plan 45;
=begin description
Test for 'subset' with a closure
=end description
# L<S02/Polymorphic types/"Fancier type constraints may be expressed through a subtype">
subset Even of Int where { $_ % 2 == 0 };
{
my Even $x = 2;
is $x, 2, 'Can assign value to a type variable with subset';
};
#?pugs todo
dies_ok { eval('my Even $x = 3') },
"Can't assign value that violates type constraint via subset";
# RT # 69518'
#?niecza todo
#?pugs todo
dies_ok { eval('Even.new') }, 'Cannot instantiate a subtype';
#?pugs skip "can't find Even"
{
ok 2 ~~ Even, 'Can smartmatch against subsets 1';
ok 3 !~~ Even, 'Can smartmatch against subsets 2';
}
# L<S02/Polymorphic types/"Fancier type constraints may be expressed through a subtype">
#?pugs emit #
subset Digit of Int where ^10;
{
my Digit $x = 3;
is $x, 3, "Can assign to var with 'subset' type constraint";
$x = 0;
is $x, 0, "one end of range";
$x = 9;
is $x, 9, "other end of range";
}
#?pugs 3 todo
dies_ok { my Digit $x = 10 },
'type constraints prevents assignment 1';
dies_ok { my Digit $x = -1 },
'type constraints prevents assignment 2';
dies_ok { my Digit $x = 3.1 },
'original type prevents assignment';
# RT #67818
{
subset Subhash of Hash;
lives_ok { my Subhash $a = {} },
'can create subset of hash';
subset Person of Hash where { .keys.sort ~~ <firstname lastname> }
lives_ok { my Person $p = { :firstname<Alpha>, :lastname<Bravo> } },
'can create subset of hash with where';
#?pugs todo
dies_ok { my Person $p = { :first<Charlie>, :last<Delta> } },
'subset of hash with where enforces where clause';
subset Austria of Array;
lives_ok { my Austria $a = [] },
'can create subset of array';
subset NumArray of Array where { .elems == .grep: { $_ ~~ Num } }
lives_ok { my NumArray $n = [] },
'can create subset of array with where';
#?rakudo skip '(noauto) succeeds for the wrong reason (need to test the error)'
#?pugs todo
dies_ok { my NumArray $n = <Echo 2> },
'subset of array with where enforces where clause';
subset Meercat of Pair;
lives_ok { my Meercat $p = :a<b> },
'can create subset of pair';
subset Ordered of Pair where { .key < .value }
lives_ok { my Ordered $o = 23 => 42 },
'can create subset of Pair with where';
#?pugs todo
dies_ok { my Ordered $o = 42 => 23 },
'subset of pair with where enforces where clause';
}
#?niecza skip 'Seq NYI'
{
#?rakudo todo 'Seq not implemented in nom'
subset Subseq of Seq;
#?pugs todo
lives_ok { my Subseq $tsil = <a b c>.Seq },
'can create subset of Seq';
#?rakudo todo 'Seq not yet implemented in nom'
subset FewOdds of Seq where { 2 > .grep: { $_ % 2 } }
#?pugs todo
lives_ok { my FewOdds $fe = <78 99 24 36>.Seq },
'can create subset of Seq with where';
dies_ok { my FewOdds $bomb = <78 99 24 36 101>.Seq },
'subset of Seq with where enforces where';
}
{
my subset Str_not2b of Str where /^[isnt|arent|amnot|aint]$/;
my Str_not2b $text;
$text = 'amnot';
is $text, 'amnot', 'assignment to my subset of Str where pattern worked';
#?pugs todo
dies_ok { $text = 'oops' },
'my subset of Str where pattern enforces pattern';
}
{
subset Negation of Str where /^[isnt|arent|amnot|aint]$/;
my Negation $text;
$text = 'amnot';
is $text, 'amnot', 'assignment to subset of Str where pattern worked';
#?pugs todo
dies_ok { $text = 'oops' }, 'subset of Str where pattern enforces pattern';
}
# RT #67256
#?niecza skip "Exception NYI"
#?pugs skip "Exception NYI"
{
subset RT67256 of Int where { $^i > 0 }
my RT67256 $rt67256;
try { $rt67256 = -42 }
ok $! ~~ Exception, 'subset of Int enforces where clause';
ok "$!" ~~ / RT67256 /, 'error for bad assignment mentions subset';
}
# RT #69334
#?pugs skip "Can't find SY"
{
class Y {has $.z};
subset sY of Y where {.z == 0};
lives_ok { 4 ~~ sY }, 'Nominal type is checked first';
ok 4 !~~ sY, 'and if nominal type check fails, it is False';
}
# RT #74234
{
eval_lives_ok 'subset A of Mu; my A $x = 23;',
'subset A of Mu + type check and assignment works';
}
# RT #77356
#?pugs skip "Can't find aboveLexLimit"
{
sub limit() { 0 }
subset aboveLexLimit of Int where { $_ > limit() };
ok 1 ~~ aboveLexLimit, 'can use subset that depends on lexical sub (1)';
nok -1 ~~ aboveLexLimit, 'can use subset that depends on lexical sub (2)';
}
# RT # 77356
#?pugs skip "Can't find aboveLexVarLimit"
{
my $limit = 0;
subset aboveLexVarLimit of Int where { $_ > $limit };
ok 1 ~~ aboveLexVarLimit, 'can use subset that depends on lexical variable (1)';
nok -1 ~~ aboveLexVarLimit, 'can use subset that depends on lexical variable (2)';
}
#?pugs emit #
subset Bug::RT80930 of Int where { $_ %% 2 };
lives_ok { my Bug::RT80930 $rt80930 }, 'subset with "::" in the name';
# RT #95500
#?pugs skip "Can't find SomeStr"
{
subset SomeStr of Str where any <foo bar>;
ok 'foo' ~~ SomeStr, 'subset ... where any(...) (+)';
nok 'fox' ~~ SomeStr, 'subset ... where any(...) (-)';
}
# RT #65308
#?niecza skip 'Methods must be used in some kind of package'
{
subset FooStr of Str where /^foo/;
my multi method uc(FooStr $self:) { return "OH HAI" }; #OK not used
is "foo".uc, 'FOO', 'multi method with subset invocants do not magically find their way into the method dispatch';
}
# RT #73344
my $a = 1;
#?pugs skip 'where'
{
my $a = 3;
sub producer {
my $a = 2;
sub bar($x where $a ) { $x } #OK not used
}
my &bar := producer();
lives_ok { bar(2) }, 'where-constraint picks up the right lexical (+)';
dies_ok { bar(1) }, 'where-constraint picks up the right lexical (-)';
}
#?pugs skip 'MI not found'
{
#RT #113434
my subset MI of Int;
ok MI ~~ Mu, 'subset conforms to Mu';
ok MI ~~ Int, 'subset conforms to base type';
nok Mu ~~ MI, 'Mu does not conform to subset';
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.