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 139 lines (111 sloc) 4.556 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
use v6;

use Test;

# L<S12/Method calls/"Indirect object notation now requires a colon after the invocant, even if there are no arguments">

plan 33;


##### Without arguments
class T1
{
    method a
    {
        'test';
    }
}

{
    my T1 $o .= new;
    ok( "Still alive after new" );

    is( $o.a(), 'test', "The indirect object notation call without argument 1" );
    #?rakudo skip 'TTIAR near $o:'
    #?niecza skip 'Invocant handling is NYI'
    is( (a $o:), 'test', "The indirect object notation call without arguments 2" );
}

##### With arguments
class T2
{
    method a( $x )
    {
        $x;
    }
}

{
    my T2 $o .= new;
    ok( "Still alive after new" );
    my $seed = 1000.rand;
    is( $o.a( $seed ), $seed, "The indirect object notation call with argument 1" );
    #?rakudo skip 'TTIAR near $o:'
    #?niecza skip 'Invocant handling is NYI'
    is( (a $o: $seed), $seed, "The indirect object notation call with arguments 2" );
    my $name = 'a';
    eval_dies_ok('$name $o: $seed', 'Indirect object notation and indirect method calls cannot be combined');
}


# L<S12/Fancy method calls/"There are several forms of indirection for the method name">

{
    class A {
        method abc { 'abc' };
        method bcd { 'bcd' };
    }
    my $o = A.new();

    is $o."abc"(), 'abc', 'calling method with $object."methodname"'; #OK use of quotes
    my $bc = 'bc';
    is $o."a$bc"(), 'abc', 'calling method with $object."method$name"';
    is $o."{$bc}d"(), 'bcd', 'calling method with $object."method$name"';


    my $meth = method { self.abc ~ self.bcd };
    is $o.$meth, 'abcbcd', 'calling method with $object.$methodref';
}

# L<S12/Fancy method calls/"$obj.@candidates(1,2,3)">
#?rakudo skip '.@foo not yet working'
#?niecza skip 'Unable to resolve method postcircumfix:<( )> in class Array'
{
    class T3 {
        has $.x;
        has $.y;
        has $.called is rw = 0;

        our method m1 () { $!called++; "$.x|$.y" };
        our method m2 () { $!called++; "$.x,$.y"; nextsame() };
        our method m3 () { $!called++; "$.x~$.y" };
        our method m4 () { $!called++; callsame(); };
    }
    my @c = (&T3::m1, &T3::m2, &T3::m3);
    my $o = T3.new(:x<p>, :y<q>);

    is $o.@c(), 'p|q', 'called the first candidate in the list, which did not defer';
    is $o.called, 1, 'called only one method dispatch';
    
    @c.shift();
    $o.called = 0;
    is $o.@c, 'p~q', 'got result from method we deferred to';
    is $o.called, 2, 'called total two methods during dispatch';

    @c.unshift(&T3::m4);
    $o.called = 0;
    is $o.@c, 'p~q', 'got result from method we deferred to, via call';
    is $o.called, 3, 'called total three methods during dispatch';
}

dies_ok { 23."nonexistingmethod"() }, "Can't call nonexisting method"; #OK use of quotes

#?rakudo skip '.*, .+ and .? with @foo'
#?niecza skip 'Two definitions found for symbol ::GLOBAL::T4::&m, etc'
{
    class T4 {
        has $.called = 0;
        our multi method m(Int $x) { $!called++; 'm-Int' } #OK not used
        our multi method m(Num $x) { $!called++; 'm-Num' } #OK not used

        our multi method n(Int $x) { $!called++; 'n-Int' } #OK not used
        our multi method n(Num $x) { $!called++; 'n-Num' } #OK not used
    }

    my $o = T4.new();
    my @cand-num = &T4::m, &T4::n;
    is ~$o.*@cand-num(3.4).sort, 'm-Num n-Num', '$o.*@cand(arg) (1)';
    is ~$o.*@cand-num(3).sort, 'm-Int m-Num n-Int n-Num', '$o.*@cand(arg) (2)';
    is $o.called, 6, 'right number of method calls';
    lives_ok { $o.*@cand-num() }, "it's ok with .* if no candidate matched (arity)";
    lives_ok { $o.*@cand-num([]) }, "it's ok with .* if no candidate matched (type)";

    $o = T4.new();
    is ~$o.+@cand-num(3.4).sort, 'm-Num n-Num', '$o.+@cand(arg) (1)';
    is ~$o.+@cand-num(3).sort, 'm-Int m-Num n-Int n-Num', '$o.+@cand(arg) (2)';
    is $o.called, 6, 'right number of method calls';
    dies_ok { $o.+@cand-num() }, "it's not ok with .+ if no candidate matched (arity)";
    dies_ok { $o.+@cand-num([]) }, "it's not ok with .+ if no candidate matched (type)";

    $o = T4.new();
    is ~$o.?@cand-num(3.4).sort, 'm-Num', '$o.?@cand(arg) (1)';
    is ~$o.?@cand-num(3).sort, 'm-Int', '$o.?@cand(arg) (2)';
    is $o.called, 2, 'right number of method calls';
    lives_ok { $o.?@cand-num() }, "it's ok with .? if no candidate matched (arity)";
    lives_ok { $o.?@cand-num([]) }, "it's ok with .? if no candidate matched (type)";
}

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