#!/usr/bin/perl -w
use strict;
use Test::More tests => 48;
use Test::Exception;
use Data::Bind;
# L<S03/"Binding">
# Binding of array elements.
# See thread "Binding of array elements" on p6l started by Ingo Blechschmidt:
# L<"http://www.nntp.perl.org/group/perl.perl6.language/22915">
sub {
my @array = <a b c>;
my $var = "d";
eval { bind_op2(\$array[1] => \$var) };
is $array[1], "d", "basic binding of an array element (1)";
$var = "e";
is $array[1], "e", "basic binding of an array element (2)";
$array[1] = "f";
is $var, "f", "basic binding of an array element (3)";
}->();
sub {
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "binding of array elements works with .delete (1)";
delete $array[1];
# $var unchanged, but assigning to $var doesn't modify @array any
# longer; similarily, changing @array[1] doesn't modify $var now
is $var, "e", "binding of array elements works with .delete (2)";
is_deeply \@array, ['a',undef,'c'], "binding of array elements works with .delete (3)";
$var = "f";
$array[1] = "g";
is $var, "f", "binding of array elements works with .delete (4)";
is $array[1], "g", "binding of array elements works with .delete (5)";
}->();
sub {
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "binding of array elements works with resetting the array (1)";
@array = ();
# $var unchanged, but assigning to $var doesn't modify @array any
# longer; similarily, changing @array[1] doesn't modify $var now
is $var, "e", "binding of array elements works with resetting the array (2)";
is_deeply \@array, [], "binding of array elements works with resetting the array (3)";
$var = "f";
$array[1] = "g";
is $var, "f", "binding of array elements works with resetting the array (4)";
is $array[1], "g", "binding of array elements works with resetting the array (5)";
}->();
sub {
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "binding of array elements works with rebinding the array (1)";
my @other_array = <x y z>;
bind_op('@array' => \@other_array);
# $var unchanged, but assigning to $var doesn't modify @array any
# longer; similarily, changing @array[1] doesn't modify $var now
is $var, "e", "binding of array elements works with rebinding the array (2)";
is_deeply \@array, [qw(x y z)], "binding of array elements works with rebinding the array (3)";
$var = "f";
$array[1] = "g";
is $var, "f", "binding of array elements works with rebinding the array (4)";
is $array[1], "g", "binding of array elements works with rebinding the array (5)";
}->();
sub {
# my sub foo (@arr) { @arr[1] = "new_value" }
my $foo = sub { my @arr; Data::Bind->arg_bind(\@_);
$arr[1] = "new_value";
};
Data::Bind->sub_signature
($foo, { var => '@arr' }),
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1], \$var);
is($array[1], $var, "bind_op2");
lives_ok { $foo->([\@array]) };
is $var, "new_value", "passing an array to a sub expecting an array behaves correctly (1)";
is_deeply \@array, [<a new_value c>], "passing an array to a sub expecting an array behaves correctly (2)";
}->();
sub {
# my sub foo (Array $arr) { $arr[1] = "new_value" }
my $foo = sub { my $arr; Data::Bind->arg_bind(\@_);
$arr->[1] = "new_value";
};
Data::Bind->sub_signature
($foo, { var => '$arr', isa => 'Array' }),
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$foo->([\\@array]);
is $var, "new_value", "passing an array to a sub expecting an arrayref behaves correctly (1)";
is_deeply \@array, [<a new_value c>], "passing an array to a sub expecting an arrayref behaves correctly (2)";
}->();
sub {
# my sub foo (*@args) { @args[1] = "new_value" }
my $foo =sub { my @args; Data::Bind->arg_bind(\@_);
$args[1] = "new_value";
};
Data::Bind->sub_signature
($foo, { var => '@args', is_slurpy => 1 }),
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1], \$var);
$foo->([\@array]);
is $var, "new_value", "passing an array to a slurpying sub behaves correctly (1)";
is_deeply \@array, [<a new_value c>], "passing an array to a slurpying sub behaves correctly (2)";
}->();
sub {
# my sub foo (*@args) { push @args, "new_value" }
my $foo = sub { my @args; Data::Bind->arg_bind(\@_);
push @args, "new_value";
};
Data::Bind->sub_signature
($foo, { var => '@args', is_slurpy => 1 }),
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$foo->([\@array]);
is $var, "d", "passing an array to a slurpying sub behaves correctly (3)";
is_deeply \@array, [<a d c>], "passing an array to a slurpying sub behaves correctly (4)";
}->();
# Binding of not yet existing elements should autovivify
{
my @array;
my $var = "d";
lives_ok { bind_op2(\$array[1] => \$var) }
"binding of not yet existing elements should autovivify (1)";
is $array[1], "d", "binding of not yet existing elements should autovivify (2)";
$var = "e";
is $array[1], "e", "binding of not yet existing elements should autovivify (3)";
is $var, "e", "binding of not yet existing elements should autovivify (4)";
}
# Binding with .splice
{
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "binding of array elements works with splice (1)";
splice @array, 1, 1, ();
# $var unchanged, but assigning to $var doesn't modify @array any
# longer; similarily, changing @array[1] doesn't modify $var now
is $var, "e", "binding of array elements works with splice (2)";
is_deeply \@array, ['a', 'c'], "binding of array elements works with splice (3)";
$var = "f";
$array[1] = "g";
is $var, "f", "binding of array elements works with splice (4)";
is $array[1], "g", "binding of array elements works with splice (5)";
}
# Assignment (not binding) creates new containers
sub {
my @array = <a b c>;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "array assignment creates new containers (1)";
my @new_array = @array;
$var = "f";
# @array[$idx] and $var are now "f", but @new_array is unchanged.
is $var, "f", "array assignment creates new containers (2)";
is_deeply \@array, [<a f c>], "array assignment creates new containers (3)";
is_deeply \@new_array, [<a e c>], "array assignment creates new containers (4)";
}->();
# Binding does not create new containers
sub {
my @array = <a b c>;
my @new_array;
my $var = "d";
bind_op2(\$array[1] => \$var);
$var = "e";
is $array[1], "e", "array binding does not create new containers (1)";
bind_op('@new_array' => \@array);
$var = "f";
# @array[$idx] and $var are now "f", but @new_array is unchanged.
is $var, "f", "array binding does not create new containers (2)";
is_deeply \@array, [qw(a f c)], "array binding does not create new containers (3)";
is_deeply \@new_array, [qw(a f c)], "array binding does not create new containers (4)";
}->();
# Binding @array := $arrayref.
# See
# http://colabti.de/irclogger/irclogger_log/perl6?date=2005-11-06,Sun&sel=388#l564
# and consider the magic behind parameter binding (which is really normal
# binding).
sub {
my $arrayref = [<a b c>];
my @array;
# my @array := $arrayref;
bind_op('@array' => $arrayref);
is +@array, 3, 'binding @array := $arrayref works (1)';
$array[1] = "B";
is_deeply $arrayref, [<a B c>], 'binding @array := $arrayref works (2)';
is_deeply \@array, [<a B c>], 'binding @array := $arrayref works (3)';
}->();