Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 103 lines (84 sloc) 2.45 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
use v6;

use Test;

plan 23;

=begin pod

Test attributes with recursively typed attributes

=end pod

#L<S12/Attributes>
{
    class A {
        has A $.attr is rw;
    };

    my A $a;
    my A $b;
    lives_ok {
        $a .= new();
        $b .= new(:attr($a));
    }, 'Can instantiate class with recursively-typed attribute';
    isa_ok $a, A, 'Sanity check, $a is of type A';
    ok $b.attr === $a, "Recursively-typed attribute stores correctly";
    lives_ok { $a.attr = $b; }, "Cycles are fine";
    ok $b.attr.attr === $b, "Cycles resolve correctly";
}

#L<S12/Class attributes/"Class attributes are declared">
{
    class B {
        my B $.attr;
    };
    
    my B $a;
    #?pugs todo
    lives_ok {
        $a .= new();
        B.attr = $a;
    }, "Can instantiate class with recursively-typed class lexical";
    #?pugs skip 'Undeclared variable'
    ok B.attr === $a, "Recursively-typed class lexical stores correctly";
    
}

#L<S12/Invocants/current lexically-determined class ::?CLASS>
#?niecza skip 'A type must be provided ???'
{
    class C {
        has ::?CLASS $.attr is rw;
    };

    my C $a;
    my C $b;
    lives_ok {
        $a .= new();
        $b .= new(:attr($a));
    }, 'Can instantiate class with ::?CLASS attribute';
    is $b.attr, $a, '::?CLASS attribute stores correctly';
    lives_ok { $a.attr = $b; }, '::?CLASS cycles are fine';
    ok $b.attr.attr === $b, '::?CLASS cycles resolve correctly';
    lives_ok { $a.attr .= new(); }, 'Can instantiate attribute of type ::?CLASS';
    isa_ok $a.attr, C, '::?CLASS instantiates to correct class';


    class D is C { };
    my D $d;
    lives_ok {
        $d .= new();
        $d.attr .= new();
    }, 'Can instantiate derived class with ::?CLASS attribute';
    #?pugs todo 'bug'
    isa_ok $d.attr, C, '::?CLASS is lexical, not virtual';
}

# RT #67236
{
    class Z {
        has Z @.a is rw;
        has Z %.h is rw;
    }

    my $z1 = Z.new;
    #?pugs todo
    #?niecza todo "https://github.com/sorear/niecza/issues/183"
    isa_ok $z1.a[0], Z, "check type-object";
    lives_ok { $z1.a[0] = Z.new }, 'can assign';
    isa_ok $z1.a[0], Z;
    #?pugs todo
    #?niecza todo "https://github.com/sorear/niecza/issues/183"
    isa_ok $z1.h<k>, Z, "check type-object";
    lives_ok { $z1.h<k> = Z.new }, 'can assign';
    isa_ok $z1.h<k>, Z;

    my $z2 = Z.new;
    lives_ok { $z2.a.push( Z.new ) }, 'can push';
    isa_ok $z2.a[0], Z;
}

# vim: ft=perl6
Something went wrong with that request. Please try again.