/
scalars.t
170 lines (133 loc) · 3.74 KB
/
scalars.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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
use v6;
use Test;
=begin head1
Binding tests
These tests are derived from the "Item assignment precedence" section of Synopsis 3
# L<S03/Item assignment precedence/replaces the container itself For instance>
=end head1
plan 33;
# Basic scalar binding tests
{
my $x = 'Just Another';
is($x, 'Just Another', 'normal assignment works');
my $y := $x;
is($y, 'Just Another', 'y is now bound to x');
ok($y =:= $x, 'y is bound to x (we checked with the =:= identity op)');
my $z = $x;
is($z, 'Just Another', 'z is not bound to x');
ok(!($z =:= $x), 'z is not bound to x (we checked with the =:= identity op)');
$y = 'Perl Hacker';
is($y, 'Perl Hacker', 'y has been changed to "Perl Hacker"');
is($x, 'Perl Hacker', 'x has also been changed to "Perl Hacker"');
is($z, 'Just Another', 'z is still "Just Another" because it was not bound to x');
}
# RT #77594
eval_dies_ok '0 := 1', 'cannot bind to a literal';
# Binding and $CALLER::
#XXX This can pass bogusly (was doing for Rakudo for a while).
#?niecza skip 'CALLER::'
{
sub bar {
return $CALLER::a eq $CALLER::b;
}
sub foo {
my $a is dynamic = "foo";
my $b is dynamic := $a; #OK not used
return bar(); # && bar2();
}
ok(foo(), "CALLER resolves bindings in caller's dynamic scope");
}
# Binding to swap
#?rakudo skip 'list binding: RT #122369'
#?niecza skip 'list binding'
{
my $a = "a";
my $b = "b";
($a, $b) := ($b, $a);
is($a, 'b', '$a has been changed to "b"');
is($b, 'a', '$b has been changed to "a"');
$a = "c";
is($a, 'c', 'binding to swap didn\'t make the vars readonly');
}
# More tests for binding a list
#?rakudo skip 'list binding: RT #122369'
#?niecza skip 'list binding'
{
my $a = "a";
my $b = "b";
my $c = "c";
($a, $b) := ($c, $c);
is($a, 'c', 'binding a list literal worked (1)');
is($b, 'c', 'binding a list literal worked (2)');
$c = "d";
is($a, 'd', 'binding a list literal really worked (1)');
is($b, 'd', 'binding a list literal really worked (2)');
}
# Binding subroutine parameters
{
my $a;
my $b = sub ($arg) { $a := $arg };
my $val = 42;
$b($val);
is $a, 42, "bound readonly sub param was bound correctly (1)";
$val++;
#?niecza todo "difference of interpretation on ro binding"
is $a, 42, "bound readonly sub param was bound correctly (2) (no change)";
dies_ok { $a = 23 },
"bound readonly sub param remains readonly (1)";
#?niecza todo "difference of interpretation on ro binding"
is $a, 42,
"bound readonly sub param remains readonly (2)";
is $val, 43,
"bound readonly sub param remains readonly (3)";
}
{
my $a;
my $b = sub ($arg is rw) { $a := $arg };
my $val = 42;
$b($val);
is $a, 42, "bound rw sub param was bound correctly (1)";
$val++;
is $a, 43, "bound rw sub param was bound correctly (2)";
lives_ok { $a = 23 }, "bound rw sub param remains rw (1)";
is $a, 23, "bound rw sub param remains rw (2)";
is $val, 23, "bound rw sub param remains rw (3)";
}
# := actually takes subroutine parameter list
#?rakudo skip 'list binding: RT #122369'
#?niecza skip 'list binding'
{
my $a;
:(:$a) := (:a<foo>);
is($a, "foo", "bound keyword");
my @tail;
:($a, *@tail) := (1, 2, 3);
ok($a == 1 && ~@tail eq '2 3', 'bound slurpy');
}
# RT #77462
# binding how has the same precedence as list assignment
{
my $x := 1, 2;
is $x.join, '12', 'binding has same precdence as list assignment'
}
# RT #76508
{
my $a := 2;
$a := $a;
is $a, 2, 'can bind variable to itself (no-oop)';
}
# RT #89484
{
my $x = 5;
sub f($y) { $x := 5 } #OK not used
f($x);
is $x, 5, 'interaction between signature binding and ordinary binding';
}
# RT #87034
{
my $x = 1;
my $y := $x;
$x := 3;
is $y, 1, 'rebinding';
}
# vim: ft=perl6