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 166 lines (144 sloc) 4.25 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 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
use v6;

use Test;

plan 31;

# L<S12/Fancy method calls/"For a call on your own private method">

class Counter {
    has $!x;
    method init { $!x = 41 }
    method get { $!x }
    method inc { $!x++ }
}

my $c = Counter.new();
dies_ok { $c.x }, 'no public accessor for private attribute';
$c.init();
is($c.get(), 41, 'can assign and get from within the class');
$c.inc();
is($c.get(), 42, 'can auto-increment an attribute');

{
    class WithAlias {
        has $x;
        method set($a) { $x = $a }
        method get { $!x }
    }

    my $wa = WithAlias.new();
    $wa.set(99);
    is($wa.get, 99, 'has with no twigil creates alias');
}

#?niecza skip 'Unhandled parameter twigil !'
{
    class ManyTest {
        has ($a, $b);
        has ($.c, $.d);
        has ($!e, $!f);
        submethod BUILD(:$!a, :$!b, :$!c, :$!d, :$!e, :$!f) { }
        method t1 {
            $a + $b
        }
        method t2 {
            $!a + $!b
        }
        method t3 {
            $!e + $!f
        }
    }

    my $m = ManyTest.new(a => 1, b => 2, c => 3, d => 4, e => 5, f => 6);
    is($m.c, 3, 'list attribute declaration of publics works');
    is($m.d, 4, 'list attribute declaration of publics works');
    is($m.t1, 3, 'list attribute declaration of alias works');
    is($m.t2, 3, 'list attribute declaration of alias works');
    is($m.t3, 11, 'list attribute declaration of privates works');
}

class Foo {
    has %.bar is rw;
    method set_bar {
        %.bar<a> = 'baz';
    }
}
my $foo = Foo.new;
isa_ok($foo.bar, Hash, 'hash attribute initialized');
$foo.set_bar();
is($foo.bar<a>, 'baz', 'hash attribute initialized/works');
my %s = $foo.bar;
is(%s<a>, 'baz', 'hash attribute initialized/works');
$foo.bar<b> = 'wob';
is($foo.bar<b>, 'wob', 'hash attribute initialized/works');

class Bar {
    has @.bar is rw;
    method set_bar {
        @.bar[0] = 100;
        @.bar[1] = 200;
    }
}
my $bar = Bar.new;
isa_ok($bar.bar.WHAT, Array, 'array attribute initialized');
$bar.set_bar();
is($bar.bar[0], 100, 'array attribute initialized/works');
is($bar.bar[1], 200, 'array attribute initialized/works');
my @t = $bar.bar;
is(@t[0], 100, 'array attribute initialized/works');
is(@t[1], 200, 'array attribute initialized/works');
$bar.bar[2] = 300;
is($bar.bar[2], 300, 'array attribute initialized/works');

# RT #73808
#?niecza skip 'Unhandled parameter twigil !'
{
    class RT73808 {
        has ($!a, $!b);
        method foo {
            $!a = 1;
            $!b = 3;
            return $!a + $!b;
        }
    }
    is RT73808.new.foo, 4,
        'Providing a list of attributes to a single "has" works';
}

# RT 81718
eval_dies_ok q[
class RT81718 {
has $.bughunt is rw;
sub bomb { "life is a $.bughunt" }
method meta_bomb { "the good " ~ bomb() }
}
], 'no attr access for sub inside class';

# RT 74850
#?niecza skip "Unhandled exception: Unable to resolve method ctxzyg in type Method"
#?rakudo skip "Cannot use .= to initialize an attribute"
{
    class A { };
    class B { has A $.foo .= new };
    isa_ok B.new.foo, A, 'class attribute can be initialized using .=';
}

#RT #115280
{
    eval_lives_ok '(class A { has $.x }).new.x.HOW',
        "HOW on attributes lives, custom class";
    eval_lives_ok '(1/2).numerator.HOW',
        "HOW on attributes lives, builtin";
}

#RT #114234
#?niecza skip '$b declared but not used. FIXME later.'
{
    eval_lives_ok q{
my class A { state $b; }
}, "No segfault on state variables";
}

#RT #75010
{

    my @y=1,2,3;
    is_deeply( [@y], [ 1, 2, 3 ], 'Plain array' );
    is_deeply( [@y[1 .. +@y]], [ 2, 3, Any ], 'Array from 2-nd element to end+1' );
    is_deeply( [@y[1 ..^ +@y]], [ 2, 3 ], 'Array from 2-nd element to end' );

    class AB {
        has @.x;
        method aa {
            my @y=1,2,3;
            is_deeply( [@y[1 .. +@y]], [ 2, 3, Any ], 'Plain array in the method' );
            is_deeply( [@.x], [ 1, 2, 3 ], 'Array from 2-nd element to end+1 in the method' );
            is_deeply( [@.x[1 ..^ +@.x]], [ 2, 3 ], 'Array from 2-nd element to end in the method' );
        }
    };

    my AB $y.=new(:x(1,2,3));
    $y.aa;

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