Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 133 lines (105 sloc) 2.108 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
use v6;

use Test;

plan(13);

unless (try { eval("1", :lang<perl5>) }) {
    skip_rest;
    exit;
}

eval(q/
#line 16 method.t
package FooBar;
our $VERSION = '6.0';
print '';

sub new {
bless {}, __PACKAGE__;
}

sub foo {
return 'foo';
}

sub echo {
my ($self, $what) = @_;
#print "==> echo got $what\n";
return $what;
}

sub callcode {
my ($self, $code) = @_;
#print "==> callcode got $code\n";
return eval { $code->($self) };
}

sub asub {
return sub { return "asub" };
}

sub submany {
return sub { ("many", "return") };
}

sub many {
return ("many", "return") ;
}

sub modify_array {
my ($class, $val) = @_;
$val->[0] = 99;
}

# takes an object and invoke me on that
sub invoke {
my ($class, $obj) = @_;
$obj->me ('invoking');
}

/, :lang<perl5>);

{
    my $r = eval("FooBar->VERSION", :lang<perl5>);
    is($r, '6.0', "class method");
}

my $obj;

{
    $obj = eval("FooBar->new", :lang<perl5>);
    isa_ok($obj, 'FooBar', "blessed");
    like($obj, rx:Perl5/FooBar/, "blessed");
}

{
    is($obj.foo, 'foo', 'invoke method');
}

{
    my $r = $obj.echo("bar");
    is($r, 'bar', 'invoke method with pugs arg');
}

{
    my $r = $obj.asub;

    #?pugs todo
    isa_ok($r, 'CODE', "returning a coderef");

    is($r.(), 'asub', 'invoking p5 coderef');
    my $rr = $obj.callcode($r);
    is($rr, 'asub', 'invoke with p5 coderef');
}

#?pugs todo
{
    my @r = $obj.many;
    is(@r.elems, 2);
}

#?pugs todo
{
    my $r = $obj.submany;
    my @r = $r.();
    is(@r.elems, 2);
}

#?pugs skip 'Invalid ctx: 2'
{
    my $callback = { "baz" };
    my $r = $obj.callcode($callback);
    is($r, 'baz', 'invoke method with callback');
}

#?pugs skip 'Invalid ctx: 2'
{
    class Foo6 {
        method me ($class: $arg) { 'Foo6'~$arg }; #OK not used
    };
    my $obj6 = Foo6.new;
    $obj = eval("FooBar->new", :lang<perl5>);
    is($obj.invoke($obj6), 'Foo6invoking', 'invoke pugs method from p5');
}

#?pugs skip 'Invalid ctx: 2'
{
    my @rw = (1, 2, 3);
    $obj.modify_array(VAR @rw);
    is(@rw[0], 99, 'modify a scalar ref');
}

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