Skip to content
Newer
Older
100644 119 lines (91 sloc) 2.86 KB
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
1 use t::CompileTestLib;
2 use NativeCall;
3 use Test;
4
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored Apr 21, 2012
5 plan 21;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
6
7 compile_test_lib('06-struct');
8
9 class MyStruct is repr('CStruct') {
10 has int $.int;
11 has num $.num;
12 has CArray $.arr;
13
14 method init() {
15 $!int = 42;
16 $!num = -3.7e0;
17 my $arr = CArray[int32].new();
18 $arr[0] = 1;
19 $arr[1] = 2;
20 $!arr := $arr;
21 }
22 }
23
24 # Workaround a Rakudo-bug where $!arr := CArray[int].new() won't work if $.arr
25 # is declared as type CArray[int].
26 class MyStruct2 is repr('CStruct') {
27 has int $.int;
28 has num $.num;
29 has CArray[int] $.arr;
30 }
31
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored Apr 21, 2012
32 class IntStruct is repr('CStruct') {
33 has int $.first;
34 has int $.second;
35
36 # Work around struct members not being containerized yet.
37 method init {
38 $!first = 13;
39 $!second = 17;
40 }
41 }
42
43 class NumStruct is repr('CStruct') {
44 has num $.first;
45 has num $.second;
46
47 # Work around struct members not being containerized yet.
48 method init {
49 $!first = 0.9e0;
50 $!second = 3.14e0;
51 }
52 }
53
54 class StructStruct is repr('CStruct') {
55 has IntStruct $.a;
56 has NumStruct $.b;
57
58 # Work around struct members not being containerized yet.
59 method init {
60 $!a := IntStruct.new;
61 $!b := NumStruct.new;
62 $!a.init;
63 $!b.init;
64 }
65 }
66
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored Apr 21, 2012
67 class PointerThing is repr('CPointer') {
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored Apr 26, 2012
68 sub _deref(PointerThing $x) returns int is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored Apr 21, 2012
69 method deref() { return _deref(self); }
70 }
71
72 class PointerStruct is repr('CStruct') {
73 has PointerThing $.p;
74 }
75
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored Apr 26, 2012
76 sub ReturnAStruct() returns MyStruct2 is native('./06-struct') { * }
77 sub TakeAStruct(MyStruct $arg) is native('./06-struct') { * }
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
78
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored Apr 26, 2012
79 sub ReturnAStructStruct() returns StructStruct is native('./06-struct') { * }
80 sub TakeAStructStruct(StructStruct $arg) is native('./06-struct') { * }
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored Apr 21, 2012
81
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored Apr 26, 2012
82 sub ReturnAPointerStruct() returns PointerStruct is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored Apr 21, 2012
83
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
84 # Perl-side tests:
85 my MyStruct $obj .= new;
86 $obj.init;
87
88 is $obj.int, 42, 'getting int';
89 is $obj.num, -3.7e0, 'getting num';
90 is $obj.arr[1], 2, 'getting CArray and element';
91
92 # C-side tests:
3c2dbdf @arnsholt Enable now-passing struct tests.
arnsholt authored Apr 21, 2012
93 my $cobj = ReturnAStruct;
94
95 is $cobj.int, 17, 'getting int from C-created struct';
96 is $cobj.num, 4.2e0, 'getting num from C-created struct';
97 is $cobj.arr[0], 2, 'C-created array member, elem 1';
98 is $cobj.arr[1], 3, 'C-created array member, elem 2';
99 is $cobj.arr[2], 5, 'C-created array member, elem 3';
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
100
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored Apr 21, 2012
101 my StructStruct $ss = ReturnAStructStruct();
102 is $ss.a.first, 7, 'field 1 from struct 1 in struct';
103 is $ss.a.second, 11, 'field 2 from struct 1 in struct';
104
105 is $ss.b.first, 3.7e0, 'field 1 from struct 1 in struct';
106 is $ss.b.second, 0.1e0, 'field 2 from struct 1 in struct';
107
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored Apr 21, 2012
108 my PointerStruct $x = ReturnAPointerStruct();
109 is $x.p.deref, 19, 'CPointer object in struct';
110
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
111 TakeAStruct($obj);
112
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored Apr 21, 2012
113 my StructStruct $ss2 .= new();
114 $ss2.init;
115
116 TakeAStructStruct($ss2);
117
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored Apr 20, 2012
118 # vim:ft=perl6
Something went wrong with that request. Please try again.