Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 143 lines (110 sloc) 3.572 kB
2a2c373 @moritz include path fixes
moritz authored
1 use lib '.';
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
2 use t::CompileTestLib;
3 use NativeCall;
4 use Test;
5
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
6 plan 25;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
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
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
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
68 class StringStruct is repr('CStruct') {
69 has Str $.first;
70 has Str $.second;
71
72 method init {
73 $!first := 'Lorem';
74 $!second := 'ipsum';
75 }
76 }
77
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
78 class PointerThing is repr('CPointer') {
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
79 sub _deref(PointerThing $x) returns int is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
80 method deref() { return _deref(self); }
81 }
82
83 class PointerStruct is repr('CStruct') {
84 has PointerThing $.p;
85 }
86
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
87 sub ReturnAStruct() returns MyStruct2 is native('./06-struct') { * }
88 sub TakeAStruct(MyStruct $arg) is native('./06-struct') { * }
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
89
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
90 sub ReturnAStructStruct() returns StructStruct is native('./06-struct') { * }
91 sub TakeAStructStruct(StructStruct $arg) is native('./06-struct') { * }
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
92
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
93 sub ReturnAPointerStruct() returns PointerStruct is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
94
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
95 sub ReturnAStringStruct() returns StringStruct is native('./06-struct') { * }
96 sub TakeAStringStruct(StringStruct $arg) is native('./06-struct') { * }
97
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
98 # Perl-side tests:
99 my MyStruct $obj .= new;
100 $obj.init;
101
102 is $obj.int, 42, 'getting int';
103 is $obj.num, -3.7e0, 'getting num';
104 is $obj.arr[1], 2, 'getting CArray and element';
105
106 # C-side tests:
3c2dbdf @arnsholt Enable now-passing struct tests.
arnsholt authored
107 my $cobj = ReturnAStruct;
108
109 is $cobj.int, 17, 'getting int from C-created struct';
110 is $cobj.num, 4.2e0, 'getting num from C-created struct';
111 is $cobj.arr[0], 2, 'C-created array member, elem 1';
112 is $cobj.arr[1], 3, 'C-created array member, elem 2';
113 is $cobj.arr[2], 5, 'C-created array member, elem 3';
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
114
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
115 my StructStruct $ss = ReturnAStructStruct();
116 is $ss.a.first, 7, 'field 1 from struct 1 in struct';
117 is $ss.a.second, 11, 'field 2 from struct 1 in struct';
118
119 is $ss.b.first, 3.7e0, 'field 1 from struct 1 in struct';
120 is $ss.b.second, 0.1e0, 'field 2 from struct 1 in struct';
121
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
122 my PointerStruct $x = ReturnAPointerStruct();
123 is $x.p.deref, 19, 'CPointer object in struct';
124
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
125 my StringStruct $strstr = ReturnAStringStruct();
126 is $strstr.first, 'OMG!', 'first string in struct';
127 is $strstr.second, 'Strings!', 'second string in struct';
128
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
129 TakeAStruct($obj);
130
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
131 my StructStruct $ss2 .= new();
132 $ss2.init;
133
134 TakeAStructStruct($ss2);
135
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
136 my StringStruct $strstr2 .= new();
137 $strstr2.init;
138 #$strstr2.first := "Lorem";
139 #$strstr2.second := "ipsum";
140 TakeAStringStruct($strstr2);
141
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
142 # vim:ft=perl6
Something went wrong with that request. Please try again.