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