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

176 lines (138 sloc) 3.968 kb
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 context = "foo";
my $b is context := $a; #OK not used
return bar(); # && bar2();
}
ok(foo(), "CALLER resolves bindings in caller's dynamic scope");
}
# Binding to swap
#?rakudo skip 'list binding'
#?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'
#?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
# XXX! When executed in interactive Pugs, the following test works!
{
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"
#?rakudo todo 'nom regression'
is $a, 43, "bound readonly sub param was bound correctly (2)";
dies_ok { $a = 23 },
"bound readonly sub param remains readonly (1)";
#?niecza todo "difference of interpretation on ro binding"
#?rakudo todo 'nom regression'
is $a, 43,
"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'
#?niecza skip 'list binding'
#?pugs skip 'Cannot bind this as lhs'
{
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
#?pugs todo
{
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
Jump to Line
Something went wrong with that request. Please try again.