Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 153 lines (120 sloc) 4.002 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
d9e11ac @jnthn Use subtest syntax for C output.
authored
6 plan 19;
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') {
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
11 has long $.long;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
12 has num $.num;
20b41e7 @arnsholt Add tests for sized ints in structs.
arnsholt authored
13 has int8 $.byte;
ee261c5 @arnsholt Add tests for sized floats, and use is_approx instead of is for compa…
arnsholt authored
14 has num32 $.float;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
15 has CArray $.arr;
16
17 method init() {
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
18 $!long = 42;
20b41e7 @arnsholt Add tests for sized ints in structs.
arnsholt authored
19 $!byte = 7;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
20 $!num = -3.7e0;
ee261c5 @arnsholt Add tests for sized floats, and use is_approx instead of is for compa…
arnsholt authored
21 $!float = 3.14e0;
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
22 my $arr := CArray[long].new();
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
23 $arr[0] = 1;
24 $arr[1] = 2;
25 $!arr := $arr;
26 }
27 }
28
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
29 # Workaround a Rakudo-bug where $!arr := CArray[long].new() won't work if $.arr
30 # is declared as type CArray[long].
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
31 class MyStruct2 is repr('CStruct') {
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
32 has long $.long;
33 has num $.num;
34 has int8 $.byte;
35 has num32 $.float;
36 has CArray[long] $.arr;
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
37 }
38
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
39 class IntStruct is repr('CStruct') {
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
40 has long $.first;
41 has long $.second;
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
42
43 # Work around struct members not being containerized yet.
44 method init {
45 $!first = 13;
46 $!second = 17;
47 }
48 }
49
50 class NumStruct is repr('CStruct') {
51 has num $.first;
52 has num $.second;
53
54 # Work around struct members not being containerized yet.
55 method init {
56 $!first = 0.9e0;
57 $!second = 3.14e0;
58 }
59 }
60
61 class StructStruct is repr('CStruct') {
62 has IntStruct $.a;
63 has NumStruct $.b;
64
65 # Work around struct members not being containerized yet.
66 method init {
67 $!a := IntStruct.new;
68 $!b := NumStruct.new;
69 $!a.init;
70 $!b.init;
71 }
72 }
73
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
74 class StringStruct is repr('CStruct') {
75 has Str $.first;
76 has Str $.second;
77
78 method init {
79 $!first := 'Lorem';
80 $!second := 'ipsum';
81 }
82 }
83
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
84 class PointerThing is repr('CPointer') {
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
85 sub _deref(PointerThing $x) returns long is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
86 method deref() { return _deref(self); }
87 }
88
89 class PointerStruct is repr('CStruct') {
90 has PointerThing $.p;
91 }
92
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
93 sub ReturnAStruct() returns MyStruct2 is native('./06-struct') { * }
94 sub TakeAStruct(MyStruct $arg) is native('./06-struct') { * }
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
95
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
96 sub ReturnAStructStruct() returns StructStruct is native('./06-struct') { * }
97 sub TakeAStructStruct(StructStruct $arg) is native('./06-struct') { * }
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
98
ee280e1 @tadzik Fix another bunch of tests on linux
tadzik authored
99 sub ReturnAPointerStruct() returns PointerStruct is native('./06-struct') { * }
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
100
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
101 sub ReturnAStringStruct() returns StringStruct is native('./06-struct') { * }
102 sub TakeAStringStruct(StringStruct $arg) is native('./06-struct') { * }
103
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
104 # Perl-side tests:
105 my MyStruct $obj .= new;
106 $obj.init;
107
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
108 is $obj.long, 42, 'getting long';
ee261c5 @arnsholt Add tests for sized floats, and use is_approx instead of is for compa…
arnsholt authored
109 is_approx $obj.num, -3.7e0, 'getting num';
110 is $obj.byte, 7, 'getting int8';
111 is_approx $obj.float, 3.14e0, 'getting num32';
112 is $obj.arr[1], 2, 'getting CArray and element';
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
113
114 # C-side tests:
3c2dbdf @arnsholt Enable now-passing struct tests.
arnsholt authored
115 my $cobj = ReturnAStruct;
116
b6c78ed @FROGGS s/int/long/ and use long and int32 correctly
FROGGS authored
117 is $cobj.long, 17, 'getting long from C-created struct';
ee261c5 @arnsholt Add tests for sized floats, and use is_approx instead of is for compa…
arnsholt authored
118 is_approx $cobj.num, 4.2e0, 'getting num from C-created struct';
119 is $cobj.byte, 13, 'getting int8 from C-created struct';
120 is_approx $cobj.float, -6.28e0, 'getting num32 from C-created struct';
121 is $cobj.arr[0], 2, 'C-created array member, elem 1';
122 is $cobj.arr[1], 3, 'C-created array member, elem 2';
123 is $cobj.arr[2], 5, 'C-created array member, elem 3';
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
124
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
125 my StructStruct $ss = ReturnAStructStruct();
126 is $ss.a.first, 7, 'field 1 from struct 1 in struct';
127 is $ss.a.second, 11, 'field 2 from struct 1 in struct';
128
b970480 @jnthn Correct test message.
authored
129 is_approx $ss.b.first, 3.7e0, 'field 1 from struct 2 in struct';
130 is_approx $ss.b.second, 0.1e0, 'field 2 from struct 2 in struct';
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
131
affc3eb @arnsholt Add tests for CPointers in CStructs.
arnsholt authored
132 my PointerStruct $x = ReturnAPointerStruct();
133 is $x.p.deref, 19, 'CPointer object in struct';
134
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
135 my StringStruct $strstr = ReturnAStringStruct();
136 is $strstr.first, 'OMG!', 'first string in struct';
137 is $strstr.second, 'Strings!', 'second string in struct';
138
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
139 TakeAStruct($obj);
140
5560e30 @arnsholt Add tests from CStruct in CStruct.
arnsholt authored
141 my StructStruct $ss2 .= new();
142 $ss2.init;
143
144 TakeAStructStruct($ss2);
145
484fb91 @arnsholt Add tests for strings in structs.
arnsholt authored
146 my StringStruct $strstr2 .= new();
147 $strstr2.init;
148 #$strstr2.first := "Lorem";
149 #$strstr2.second := "ipsum";
150 TakeAStringStruct($strstr2);
151
2a01379 @arnsholt Preliminary tests for structs and CArray members.
arnsholt authored
152 # vim:ft=perl6
Something went wrong with that request. Please try again.