Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

345 lines (286 sloc) 9.152 kb
use v6;
use Test;
# L<S03/Item assignment precedence>
# Tests for binding multidimensional structures.
plan 43;
# Nested refs as RHS in a binding operation
{
my $struct = [
"ignored",
{
key => {
ignored => 23,
subkey => [
"ignored",
42,
],
},
ignored => 19,
},
];
is $struct[1]<key><subkey>[1], 42, "basic sanity (1)";
my $abbrev := $struct[1]<key><subkey>[1];
is $abbrev, 42,
"using a multidimensional structure as RHS in a binding op works (1)";
$struct[1]<key><subkey>[1] = 43;
is $abbrev, 43,
"using a multidimensional structure as RHS in a binding op works (2)";
$abbrev = 44;
is $struct[1]<key><subkey>[1], 44,
"using a multidimensional structure as RHS in a binding op works (3)";
}
# Nested refs as LHS in a binding operation
{
my $struct = [
"ignored",
{
key => {
ignored => 23,
subkey => [
"ignored",
42,
],
},
ignored => 19,
},
];
is $struct[1]<key><subkey>[1], 42, "basic sanity (2)";
my $abbrev = 30;
try { $struct[1]<key><subkey>[1] := $abbrev };
is $abbrev, 30,
"using a multidimensional structure as LHS in a binding op works (1)";
$struct[1]<key><subkey>[1] = 31;
is $abbrev, 31,
"using a multidimensional structure as LHS in a binding op works (2)";
$abbrev = 32;
is $struct[1]<key><subkey>[1], 32,
"using a multidimensional structure as LHS in a binding op works (3)";
}
# Evil more evil structure: with an embedded "is parcel" sub!
# As RHS...
#?niecza skip "is parcel - https://github.com/sorear/niecza/issues/177"
{
my $innerstruct = {
ignored => 23,
subkey => [
"ignored",
42,
],
};
my sub get_innerstruct () is parcel { $innerstruct }
my $struct = [
"ignored",
{
key => &get_innerstruct,
ignored => 19,
},
];
is $struct[1]<key>()<subkey>[1], 42, "basic sanity (3)";
my $abbrev := $struct[1]<key>()<subkey>[1];
is $abbrev, 42,
"using a multidimensional structure with an embedded sub as RHS works (1)";
$struct[1]<key>()<subkey>[1] = 43;
is $abbrev, 43,
"using a multidimensional structure with an embedded sub as RHS works (2)";
$abbrev = 44;
is $struct[1]<key>()<subkey>[1], 44,
"using a multidimensional structure with an embedded sub as RHS works (3)";
}
# ...and as LHS
#?niecza skip "is parcel - https://github.com/sorear/niecza/issues/177"
{
my $innerstruct = {
ignored => 23,
subkey => [
"ignored",
42,
],
};
my sub get_innerstruct () is parcel { $innerstruct }
my $struct = [
"ignored",
{
key => &get_innerstruct,
ignored => 19,
},
];
is $struct[1]<key>()<subkey>[1], 42, "basic sanity (4)";
my $abbrev = 30;
try { $struct[1]<key>()<subkey>[1] := $abbrev };
is $abbrev, 30,
"using a multidimensional structure with an embedded sub as LHS works (1)";
$struct[1]<key>()<subkey>[1] = 31;
is $abbrev, 31,
"using a multidimensional structure with an embedded sub as LHS works (2)";
$abbrev = 32;
is $struct[1]<key>()<subkey>[1], 32,
"using a multidimensional structure with an embedded sub as LHS works (3)";
}
# Binding should cope with a subtree being redefined.
# As RHS...
{
my $struct = [
"ignored",
{
key => {
ignored => 23,
subkey => [
"ignored",
42,
],
},
ignored => 19,
},
];
is $struct[1]<key><subkey>[1], 42, "basic sanity (5)";
my $abbrev := $struct[1]<key><subkey>[1];
is $abbrev, 42,
"RHS binding should cope with a subtree being redefined (1)";
$struct[1]<key><subkey>[1] = 43;
is $abbrev, 43,
"RHS binding should cope with a subtree being redefined (2)";
$struct[1] = "foo";
is $struct[1], "foo",
"RHS binding should cope with a subtree being redefined (3)";
is $abbrev, 43,
"RHS binding should cope with a subtree being redefined (4)";
$abbrev = 44;
is $abbrev, 44,
"RHS binding should cope with a subtree being redefined (5)";
is $struct[1], "foo",
"RHS binding should cope with a subtree being redefined (6)";
}
# ...and as LHS
{
my $struct = [
"ignored",
{
key => {
ignored => 23,
subkey => [
"ignored",
42,
],
},
ignored => 19,
},
];
is $struct[1]<key><subkey>[1], 42, "basic sanity (6)";
my $abbrev = 42;
try { $struct[1]<key><subkey>[1] := $abbrev };
is $abbrev, 42,
"LHS binding should cope with a subtree being redefined (1)";
$struct[1]<key><subkey>[1] = 43;
is $abbrev, 43,
"LHS binding should cope with a subtree being redefined (2)";
$struct[1] = "foo";
is $struct[1], "foo",
"LHS binding should cope with a subtree being redefined (3)";
is $abbrev, 43,
"LHS binding should cope with a subtree being redefined (4)";
$abbrev = 44;
is $abbrev, 44,
"LHS binding should cope with a subtree being redefined (5)";
is $struct[1], "foo",
"LHS binding should cope with a subtree being redefined (6)";
}
# Tests for binding an element of a structure to an element of another
# structure.
{
my $foo = [
"ignored",
{
key => {
ignored => 1,
subkey => [
"ignored",
2,
],
},
ignored => 3,
},
];
my $bar = [
"ignored",
{
key => {
ignored => 4,
subkey => [
"ignored",
5,
],
},
ignored => 6,
},
];
try { $bar[1]<key><subkey> := $foo[1]<key> };
is (try { $bar[1]<key><subkey><subkey>[1] }), 2,
"binding an element of a structure to an element of another structure works (1)";
try { $foo[1]<key><subkey>[1] = 7 };
is (try { $bar[1]<key><subkey><subkey>[1] }), 7,
"binding an element of a structure to an element of another structure works (2)";
try { $bar[1]<key><subkey><subkey>[1] = 8 };
is (try { $foo[1]<key><subkey>[1] }), 8,
"binding an element of a structure to an element of another structure works (3)";
}
# Tests for binding an element of a structure to an element of *the same*
# structure, effectively creating an infinite structure.
{
my $struct = [
"ignored",
{
key => {
foo => "bar",
subkey => [
"ignored",
100,
],
},
ignored => 200,
},
];
try { $struct[1]<key><subkey>[1] := $struct[1]<key> };
is (try { $struct[1]<key><subkey>[1]<foo> }), "bar",
"binding an element of a structure to an element of the same structure works (1)";
try { $struct[1]<key><subkey>[1]<foo> = "new_value" };
is $struct[1]<key><foo>, "new_value",
"binding an element of a structure to an element of the same structure works (2)";
$struct[1]<key><foo> = "very_new_value";
is (try { $struct[1]<key><subkey>[1]<foo> }), "very_new_value",
"binding an element of a structure to an element of the same structure works (3)";
$struct[1]<key><subkey>[1] = 23;
is $struct[1]<key>, 23,
"binding an element of a structure to an element of the same structure works (4)";
}
# Test that rebinding to some other value really breaks up the binding.
{
my $struct = [
"ignored",
{
key => {
ignored => 23,
subkey => [
"ignored",
42,
],
},
ignored => 19,
},
];
is $struct[1]<key><subkey>[1], 42, "basic sanity (7)";
my $abbrev := $struct[1]<key><subkey>[1];
is $abbrev, 42,
"rebinding to some other value destroys the previous binding (1)";
$struct[1]<key><subkey>[1] = 43;
is $abbrev, 43,
"rebinding to some other value destroys the previous binding (2)";
$abbrev = 44;
is $struct[1]<key><subkey>[1], 44,
"rebinding to some other value destroys the previous binding (3)";
$abbrev := 45;
is $abbrev, 45,
"rebinding to some other value destroys the previous binding (4)";
is $struct[1]<key><subkey>[1], 44,
"rebinding to some other value destroys the previous binding (5)";
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.