Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

file 119 lines (92 sloc) 2.943 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
use lib '.';
use t::CompileTestLib;
use NativeCall;
use Test;

plan 21;

compile_test_lib('06-struct');

class MyStruct is repr('CStruct') {
    has int $.int;
    has num $.num;
    has CArray $.arr;

    method init() {
        $!int = 42;
        $!num = -3.7e0;
        my $arr = CArray[int32].new();
        $arr[0] = 1;
        $arr[1] = 2;
        $!arr := $arr;
    }
}

# Workaround a Rakudo-bug where $!arr := CArray[int].new() won't work if $.arr
# is declared as type CArray[int].
class MyStruct2 is repr('CStruct') {
    has int $.int;
    has num $.num;
    has CArray[int] $.arr;
}

class IntStruct is repr('CStruct') {
    has int $.first;
    has int $.second;

    # Work around struct members not being containerized yet.
    method init {
        $!first = 13;
        $!second = 17;
    }
}

class NumStruct is repr('CStruct') {
    has num $.first;
    has num $.second;

    # Work around struct members not being containerized yet.
    method init {
        $!first = 0.9e0;
        $!second = 3.14e0;
    }
}

class StructStruct is repr('CStruct') {
    has IntStruct $.a;
    has NumStruct $.b;

    # Work around struct members not being containerized yet.
    method init {
        $!a := IntStruct.new;
        $!b := NumStruct.new;
        $!a.init;
        $!b.init;
    }
}

class PointerThing is repr('CPointer') {
    sub _deref(PointerThing $x) returns int is native('./06-struct') { * }
    method deref() { return _deref(self); }
}

class PointerStruct is repr('CStruct') {
    has PointerThing $.p;
}

sub ReturnAStruct() returns MyStruct2 is native('./06-struct') { * }
sub TakeAStruct(MyStruct $arg) is native('./06-struct') { * }

sub ReturnAStructStruct() returns StructStruct is native('./06-struct') { * }
sub TakeAStructStruct(StructStruct $arg) is native('./06-struct') { * }

sub ReturnAPointerStruct() returns PointerStruct is native('./06-struct') { * }

# Perl-side tests:
my MyStruct $obj .= new;
$obj.init;

is $obj.int, 42, 'getting int';
is $obj.num, -3.7e0, 'getting num';
is $obj.arr[1], 2, 'getting CArray and element';

# C-side tests:
my $cobj = ReturnAStruct;

is $cobj.int, 17, 'getting int from C-created struct';
is $cobj.num, 4.2e0, 'getting num from C-created struct';
is $cobj.arr[0], 2, 'C-created array member, elem 1';
is $cobj.arr[1], 3, 'C-created array member, elem 2';
is $cobj.arr[2], 5, 'C-created array member, elem 3';

my StructStruct $ss = ReturnAStructStruct();
is $ss.a.first, 7, 'field 1 from struct 1 in struct';
is $ss.a.second, 11, 'field 2 from struct 1 in struct';

is $ss.b.first, 3.7e0, 'field 1 from struct 1 in struct';
is $ss.b.second, 0.1e0, 'field 2 from struct 1 in struct';

my PointerStruct $x = ReturnAPointerStruct();
is $x.p.deref, 19, 'CPointer object in struct';

TakeAStruct($obj);

my StructStruct $ss2 .= new();
$ss2.init;

TakeAStructStruct($ss2);

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