The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# Translated t/scalar.t
use strict;
use Test::More tests => 7;
use Test::Exception;
use Data::Bind;

use Scalar::Util 'refaddr';

sub id_eq {
    my ($x, $y) = @_;
    return refaddr($x) == refaddr($y);
}

# L<S03/"Binding" /replaces the container itself\.  For instance:/>
# Basic scalar binding tests
sub {
  my $x = bless { str => 'Just Another' }, 'Str';
  is($x->{str}, 'Just Another', 'normal assignment works');

  my $y;
  bind_op('$y', \$x);
  is($y->{str}, 'Just Another', 'y is now bound to x');
  is(ref $y, 'Str', 'y is still blessed');

}->();

# Binding subroutine parameters
# XXX! When executed in interactive Pugs, the following test works!
{
  my $a;
  my $b = sub { my $arg; Data::Bind->arg_bind(\@_);
		bind_op2(\$a => \$arg) };
  Data::Bind->sub_signature
    ($b, { var => '$arg' });

  my $val = bless { val => 42 }, 'Int';

  $b->([\$val]);
  is $a->{val}, 42, "bound readonly sub param was bound correctly (1)";
  is(ref $a, 'Int', 'a is still blessed');

}

{
  my $a;
#  my $b = sub($arg is rw) { $a := $arg };
  my $b = sub { my $arg; Data::Bind->arg_bind(\@_); bind_op2(\$a => \$arg) };
  Data::Bind->sub_signature
    ($b, { var => '$arg', is_rw => 1 });
  my $val = bless { val => 42 }, 'Int';

  $b->([\$val]);
  is $a->{val}, 42, "bound rw sub param was bound correctly (1)";
  is(ref $a, 'Int', 'a is still blessed');

}