-
Notifications
You must be signed in to change notification settings - Fork 135
/
misc.t
115 lines (90 loc) · 3.14 KB
/
misc.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
use v6;
use Test;
plan 23;
=begin description
Testing parameter traits for subroutines
=end description
# L<S06/"Parameter traits">
my $foo=1;
# test twice, once with assignment and once with increment, rakudo
# used to catch the first but not the latter.
#
#?rakudo.jvm todo "RT #126531"
throws-like '
my $tmp = 1;
sub mods_param ($x) { $x++; }
mods_param($tmp)
',
X::Multi::NoMatch,
'can\'t modify parameter, constant by default';
throws-like '
my $tmp = 1;
sub mods_param ($x) { $x = 1; }
mods_param($tmp)
',
Exception,
'can\'t modify parameter, constant by default';
# is readonly
#?rakudo.jvm todo "RT #126531"
throws-like 'sub mods_param_constant ($x is readonly) { $x++; };
mods_param_constant($foo);',
X::Multi::NoMatch,
'can\'t modify constant parameter, constant by default';
sub mods_param_rw ($x is rw) { $x++; }
dies-ok { mods_param_rw(1) }, 'can\'t modify constant even if we claim it\'s rw';
sub mods_param_rw_enforces ($x is rw) { $x; }
#?rakudo.jvm 2 todo "RT #126531"
throws-like { mods_param_rw_enforces(1) },
X::Parameter::RW,
'is rw dies in signature binding if passed a literal Int';
throws-like { mods_param_rw_enforces($[1,2]) },
X::Parameter::RW,
'is rw dies in signature binding if passed an itemized array';
lives-ok { mods_param_rw($foo) }, 'pass by "is rw" doesn\'t die';
is($foo, 2, 'pass by reference works');
# RT #129812
multi sub param_rw_ro ($x is rw) { "fee $x" }
multi sub param_rw_ro ($x) { "foo $x" }
$foo = "fie";
is param_rw_ro($foo), "fee fie", 'trait "is rw" used to narrow multi-dispatch';
#?rakudo.jvm todo 'RT #129812'
is param_rw_ro("fum"), "foo fum", 'trait "is rw" used to narrow multi-dispatch (converse)';
# is copy
$foo=1;
sub mods_param_copy ($x is copy) {$x++;}
lives-ok { mods_param_copy($foo) }, 'is copy';
is($foo, 1, 'pass by value works');
# same test with default value
sub boom ($arg is copy = 0) { $arg++ }
lives-ok { boom(42) }, "can modify a copy";
# is raw
{
$foo=1;
sub mods_param_raw ($x is raw) { $x++; }
dies-ok { mods_param_raw(1); }, 'is raw with non-lvalue';
lives-ok { mods_param_raw($foo); }, 'is raw with non-lvalue';
is($foo, 2, 'is raw works');
}
# with <-> we should still obey readonly traits
{
my $anon1 = <-> $a is readonly, $b { $b++ };
my $anon2 = <-> $a is readonly, $b { $a++ };
my $x = 1;
$anon1($x, $x);
is($x, 2, '<-> does not override explicit traints (sanity)');
#?rakudo 2 todo 'is readonly does not override'
dies-ok({ $anon2($x, $x) }, '<-> does not override explicit traints');
is($x, 2, '<-> does not override explicit traints (sanity)');
}
{
try { EVAL 'my $gack; sub oh_noes( $gack is nonesuch ) { }' };
ok $! ~~ Exception, "Can't use an unknown trait";
ok "$!" ~~ /trait/, 'error message mentions trait';
ok "$!" ~~ /nonesuch/, 'error message mentions the name of the trait';
}
throws-like
{ sub a($b) { $b = 1 }; a(2); CATCH {} },
X::AdHoc,
message => /'($b)'/,
'error message when assigning to a readonly variable includes the variable name';
# vim: ft=perl6