]> gitweb.factorcode.org Git - factor.git/blob - basis/alien/c-types/c-types-tests.factor
use a "pointer" wrapper tuple to indicate pointer types instead of the current slipsh...
[factor.git] / basis / alien / c-types / c-types-tests.factor
1 USING: alien alien.syntax alien.c-types alien.parser
2 eval kernel tools.test sequences system libc alien.strings
3 io.encodings.utf8 math.constants classes.struct classes
4 accessors compiler.units ;
5 IN: alien.c-types.tests
6
7 CONSTANT: xyz 123
8
9 [ 492 ] [ { int xyz } heap-size ] unit-test
10
11 [ -1 ] [ -1 <char> *char ] unit-test
12 [ -1 ] [ -1 <short> *short ] unit-test
13 [ -1 ] [ -1 <int> *int ] unit-test
14
15 UNION-STRUCT: foo
16     { a int }
17     { b int } ;
18
19 [ t ] [ pointer: void c-type void* c-type eq? ] unit-test
20 [ t ] [ pointer: int  c-type void* c-type eq? ] unit-test
21 [ t ] [ pointer: int* c-type void* c-type eq? ] unit-test
22 [ f ] [ pointer: foo  c-type void* c-type eq? ] unit-test
23 [ t ] [ pointer: foo* c-type void* c-type eq? ] unit-test
24
25 [ t ] [ pointer: char c-type c-string c-type eq? ] unit-test
26
27 [ t ] [ pointer: foo c-type-boxer-quot foo c-type-boxer-quot = ] unit-test
28
29 [ t ] [ foo heap-size int heap-size = ] unit-test
30
31 TYPEDEF: int MyInt
32
33 [ t ] [ int   c-type          MyInt c-type eq? ] unit-test
34 [ t ] [ void* c-type pointer: MyInt c-type eq? ] unit-test
35
36 [ 32 ] [ { int 8 } heap-size ] unit-test
37
38 TYPEDEF: char* MyString
39
40 [ t ] [ c-string c-type MyString          c-type eq? ] unit-test
41 [ t ] [ void*    c-type pointer: MyString c-type eq? ] unit-test
42
43 TYPEDEF: int* MyIntArray
44
45 [ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
46
47 TYPEDEF: c-string MyLPBYTE
48
49 [ t ] [ { c-string utf8 } c-type MyLPBYTE c-type = ] unit-test
50
51 [
52     0 B{ 1 2 3 4 } <displaced-alien> <void*>
53 ] must-fail
54
55 C-TYPE: MyOpaqueType
56
57 [ f ] [ pointer: MyOpaqueType c-type void* c-type eq? ] unit-test
58
59 os windows? cpu x86.64? and [
60     [ -2147467259 ] [ 2147500037 <long> *long ] unit-test
61 ] when
62
63 [ 0 ] [ -10 uchar c-type-clamp ] unit-test
64 [ 12 ] [ 12 uchar c-type-clamp ] unit-test
65 [ -10 ] [ -10 char c-type-clamp ] unit-test
66 [ 127 ] [ 230 char c-type-clamp ] unit-test
67 [ t ] [ pi dup float c-type-clamp = ] unit-test
68
69 C-TYPE: opaque
70
71 [ t ] [ void* c-type opaque resolve-pointer-type c-type eq? ] unit-test
72 [ opaque c-type ] [ no-c-type? ] must-fail-with
73
74 [ """
75     USING: alien.syntax ;
76     IN: alien.c-types.tests
77     FUNCTION: opaque return_opaque ( ) ;
78 """ eval( -- ) ] [ no-c-type? ] must-fail-with
79
80 C-TYPE: forward
81 STRUCT: backward { x forward* } ;
82 STRUCT: forward { x backward* } ;
83
84 [ t ] [ forward c-type struct-c-type? ] unit-test
85 [ t ] [ backward c-type struct-c-type? ] unit-test
86
87 DEFER: struct-redefined
88
89 [ f ]
90 [
91
92     """
93     USING: alien.c-types classes.struct ;
94     IN: alien.c-types.tests
95
96     STRUCT: struct-redefined { x int } ;
97     """ eval( -- )
98
99     """
100     USING: alien.syntax ;
101     IN: alien.c-types.tests
102
103     C-TYPE: struct-redefined
104     """ eval( -- )
105
106     \ struct-redefined class?
107 ] unit-test
108
109 [
110     "IN: alien.c-types.tests
111     USE: alien.syntax
112     USE: alien.c-types
113     TYPEDEF: int type-redefinition-test
114     TYPEDEF: int type-redefinition-test" eval( -- )
115 ]
116 [ error>> error>> redefine-error? ]
117 must-fail-with