instance.t

use v6;

use Test;

plan 72;

=begin pod

Class attributes tests from L<S12/Attributes>

=end pod

eval_dies_ok 'has $.x;', "'has' only works inside of class|role definitions";

# L<S12/Attributes/the automatic generation of an accessor method of the same name>

class Foo1 { has $.bar; };

{
    my $foo = Foo1.new();
    ok($foo ~~ Foo1, '... our Foo1 instance was created');
    my $val;
    #?pugs 2 todo 'feature'
    lives_ok {
        $val = $foo.can("bar")
    }, '.. checking autogenerated accessor existence';
    ok($val, '... $foo.can("bar") should have returned true');
    ok($foo.bar() ~~ undef, '.. autogenerated accessor works');
    ok($foo.bar ~~ undef, '.. autogenerated accessor works w/out parens');    
}

# L<S12/Attributes/Pseudo-assignment to an attribute declaration specifies the default>

{
    class Foo2 { has $.bar = "baz"; };
    my $foo = eval 'Foo2.new()';
    ok($foo ~~ Foo2, '... our Foo2 instance was created');
    ok($foo.can("bar"), '.. checking autogenerated accessor existence');
    is($foo.bar(), "baz", '.. autogenerated accessor works');
    is($foo.bar, "baz", '.. autogenerated accessor works w/out parens');
    dies_ok { $foo.bar = 'blubb' }, 'attributes are ro by default';
}

# L<S12/Attributes/making it an lvalue method>


#?pugs todo 'instance attributes'
{
    class Foo3 { has $.bar is rw; };
    my $foo = Foo3.new();
    ok($foo ~~ Foo3, '... our Foo3 instance was created');
    my $val;
    lives_ok {
        $val = $foo.can("bar");
    }, '.. checking autogenerated accessor existence';
    ok $val, '... $foo.can("bar") should have returned true';
    is($foo.bar(), undef, '.. autogenerated accessor works');
    lives_ok {
        $foo.bar = "baz";
    }, '.. autogenerated mutator as lvalue works';
    is($foo.bar, "baz", '.. autogenerated mutator as lvalue set the value correctly');    
    lives_ok {
        $foo.bar("baz2");
    }, '.. autogenerated mutator works as method';
    is $foo.bar, "baz2", '.. autogenerated mutator as method set the value correctly';
}

# L<S12/Attributes/Private attributes use an exclamation to indicate that no public accessor is>


{
    class Foo4 { has $!bar; };
    my $foo = Foo4.new();
    ok($foo ~~ Foo4, '... our Foo4 instance was created');
    #?pugs eval 'todo'
    ok(!$foo.can("bar"), '.. checking autogenerated accessor existence', );
}


{
    class Foo4a { has $!bar = "baz"; };
    my $foo = eval 'Foo4a.new()';
    ok($foo ~~ Foo4a, '... our Foo4a instance was created');
    #?pugs eval 'todo'
    ok(!$foo.can("bar"), '.. checking autogenerated accessor existence');
}


# L<S12/Attributes>


{
    class Foo5 {
        has $.tail is rw;
        has @.legs;
        has $!brain;

        method set_legs  (*@legs) { @.legs = @legs }
        method inc_brain ()      { $!brain++ }
        method get_brain ()      { $!brain }
    };
    my $foo = Foo5.new();
    ok($foo ~~ Foo5, '... our Foo5 instance was created');
        
    lives_ok {
        $foo.tail = "a";
    }, "setting a public rw attribute";
    is($foo.tail, "a", "getting a public rw attribute");
    
    lives_ok {
        $foo.set_legs(1,2,3)
    }, "setting a public ro attribute (1)";
    is($foo.legs.[1], 2, "getting a public ro attribute (1)");
    
    dies_ok {
        $foo.legs = (4,5,6);
    }, "setting a public ro attribute (2)";
    is($foo.legs.[1], 2, "getting a public ro attribute (2)");
    
    lives_ok {
        $foo.inc_brain();
    },  "modifiying a private attribute (1)";
    is($foo.get_brain, 1, "getting a private attribute (1)");
    lives_ok {
        $foo.inc_brain();
    },  "modifiying a private attribute (2)";
    is($foo.get_brain, 2, "getting a private attribute (2)");
}

# L<S12/Construction and Initialization/If you name an attribute as a parameter, that attribute is initialized directly, so>


{
    class Foo6 {
        has $.bar is rw;
        has $.baz;
        has $!hidden;

        submethod BUILD($.bar, $.baz, $!hidden) {}
        method get_hidden() { $!hidden }
    }

    my $foo = Foo6.new(bar => 1, baz => 2, hidden => 3);
    ok($foo ~~ Foo6, '... our Foo6 instance was created');
        
    is($foo.bar,        1, "getting a public rw attribute (1)"  );
    is($foo.baz,        2, "getting a public ro attribute (2)"  );
    is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
}

# check that doing something in submethod BUILD works

{
    class Foo6a {
        has $.bar is rw;
        has $.baz;
        has $!hidden;

        submethod BUILD ($!hidden, $.bar = 10, $.baz?) {
            $.baz = 5;
        }
        method get_hidden() { $!hidden }
    }

    my $foo = Foo6a.new(bar => 1, hidden => 3);
    ok($foo ~~ Foo6a, '... our Foo6a instance was created');
        
    is($foo.bar,        1, "getting a public rw attribute (1)"  );
    is($foo.baz,        5, "getting a public rw attribute (2)"  );
    is($foo.get_hidden, 3, "getting a private ro attribute (3)" );
}

# check that assignment in submethod BUILD works with a bare return, too
{
    class Foo6b {
        has $.bar is rw;
        has $.baz;

        submethod BUILD ($.bar = 10, $.baz?) {
            $.baz = 9;
            return;
        }
    }

    my $foo = Foo6b.new(bar => 7);
    ok($foo ~~ Foo6b, '... our Foo6b instance was created');
        
    is($foo.bar,        7, "getting a public rw attribute (1)"  );
    is($foo.baz,        9, "getting a public rw attribute (2)"  );
}

# L<A12/Default Values>
ok eval('class Foo7 { has $.attr = 42 }'), "class definition worked";
is eval('Foo7.new.attr'), 42,              "default attribute value (1)";

# L<A12/Default Values/is equivalent to this:>
ok eval('class Foo8 { has $.attr is build(42) }'),
  "class definition using 'is build' worked";
is eval('Foo8.new.attr'), 42, "default attribute value (2)";

# L<A12/Default Values/is equivalent to this:>
ok eval('class Foo9 { has $.attr will build(42) }'),
  "class definition using 'will build' worked";
is eval('Foo9.new.attr'), 42, "default attribute value (3)";

my $was_in_supplier = 0;
sub forty_two_supplier() { $was_in_supplier++; 42 }
# XXX: Currently hard parsefail!
ok eval('class Foo10 { has $.attr = { forty_two_supplier() } }'),
  "class definition using '= {...}' worked";
is eval('Foo10.new.attr'), 42, "default attribute value (4)";
is      $was_in_supplier, 1,  "forty_two_supplier() was actually executed (1)";

# The same, but using 'is build {...}'
# XXX: Currently hard parsefail!
ok eval('class Foo11 { has $.attr is build { forty_two_supplier() } }'),
  "class definition using 'is build {...}' worked";
is eval('Foo11.new.attr'), 42, "default attribute value (5)";
is      $was_in_supplier, 2,  "forty_two_supplier() was actually executed (2)";

# The same, but using 'will build {...}'
# XXX: Currently hard parsefail!
ok eval('class Foo12 { has $.attr will build { forty_two_supplier() } }'),
  "class definition using 'will build {...}' worked";
is eval('Foo11.new.attr'), 42, "default attribute value (6)";
is      $was_in_supplier, 3,  "forty_two_supplier() was actually executed (3)";

# check that doing something in submethod BUILD works
class Foo7 {
  has $.bar;
  has $.baz;

  submethod BUILD ($.bar = 5, $baz = 10 ) {
    $.baz = 2 * $baz;
  }
}

my $foo7 = Foo7.new();
is( $foo7.bar, 5,
    'optional attribute should take default value without passed-in value' );
is( $foo7.baz, 20,
    '... optional non-attribute should too' );
$foo7    = Foo7.new( :bar(4), :baz(5) );
is( $foo7.bar, 4,
    'optional attribute should take passed-in value over default' );
is( $foo7.baz, 10,
    '... optional non-attribute should too' );


# check that args are passed to BUILD
class Foo8 {
  has $.a;
  has $.b;
  
  submethod BUILD(:$foo, :$bar) {
    $.a = $foo;
    $.b = $bar;
  }
}

{
    my $foo = Foo8.new(foo => 'c', bar => 'd');
    ok($foo.isa(Foo8), '... our Foo8 instance was created');
        
    is($foo.a, 'c', 'BUILD received $foo');
    is($foo.b, 'd', 'BUILD received $bar');
}

# check mixture of positional/named args to BUILD

class Foo9 {
  has $.a;
  has $.b;
  
  submethod BUILD($foo, :$bar) {
    $.a = $foo;
    $.b = $bar;
  }
}

dies_ok({ Foo9.new('pos', bar => 'd') }, 'cannot pass positional to .new');

# check $self is passed to BUILD
class Foo10 {
  has $.a;
  has $.b;
  has $.c;
  
  submethod BUILD(Class $self: :$foo, :$bar) {
    $.a = $foo;
    $.b = $bar;
    $.c = 'y' if $self.isa(Foo10);
  }
}

{
    my $foo = Foo10.new(foo => 'c', bar => 'd');
    ok($foo.isa(Foo10), '... our Foo10 instance was created');
    
    is($foo.a, 'c', 'BUILD received $foo');
    is($foo.b, 'd', 'BUILD received $bar');
    is($foo.c, 'y', 'BUILD received $self');
}