1 USING: accessors alien alien.accessors alien.c-types alien.libraries
2 alien.syntax arrays byte-arrays continuations fry kernel kernel.private
3 layouts libc math namespaces prettyprint sequences sets system tools.memory
5 FROM: namespaces => set ;
8 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
10 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
11 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
12 [ f ] [ "hello" 1024 <alien> = ] unit-test
13 [ f ] [ 0 <alien> ] unit-test
14 [ f ] [ 0 f <displaced-alien> ] unit-test
16 ! Testing the various bignum accessor
17 10 <byte-array> "dump" set
19 [ "dump" get alien-address ] must-fail
22 123 "dump" get 0 set-alien-signed-1
23 "dump" get 0 alien-signed-1
27 12345 "dump" get 0 set-alien-signed-2
28 "dump" get 0 alien-signed-2
32 12345678 "dump" get 0 set-alien-signed-4
33 "dump" get 0 alien-signed-4
36 [ 12345678901234567 ] [
37 12345678901234567 "dump" get 0 set-alien-signed-8
38 "dump" get 0 alien-signed-8
42 -1 "dump" get 0 set-alien-signed-8
43 "dump" get 0 alien-signed-8
49 0x123412341234 over 0 set-alien-signed-8
55 0x123412341234 over 0 set-alien-signed-cell
60 [ "ALIEN: 1234" ] [ 0x1234 <alien> unparse ] unit-test
62 [ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
64 [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
66 [ 1 1 <displaced-alien> ] must-fail
68 [ f ] [ 1 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
70 [ f ] [ 2 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
72 [ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
74 [ "( displaced alien )" ] [ 1 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
76 SYMBOL: initialize-test
78 f initialize-test set-global
80 [ 31337 ] [ initialize-test [ 31337 ] initialize-alien ] unit-test
82 [ 31337 ] [ initialize-test [ 69 ] initialize-alien ] unit-test
84 [ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
86 [ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
88 [ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test
90 ! Generate callbacks until the whole callback-heap is full, then free
91 ! them. Do it ten times in a row for good measure.
92 : produce-until-error ( quot -- error seq )
93 '[ [ @ t ] [ f ] recover ] [ ] produce ; inline
97 : fill-and-free-callback-heap ( -- )
98 [ \ foo 33 <callback> ] produce-until-error nip [ free-callback ] each ;
101 10 [ fill-and-free-callback-heap ] times
104 : <cb-creator> ( -- alien )
105 \ int { pointer: void pointer: void } \ cdecl
106 [ 2drop 37 ] alien-callback ;
110 \ int { pointer: void pointer: void } \ cdecl
114 ! This function shouldn't leak
116 callback-room occupied>>
118 callback-room occupied>> =
121 ! Will fail if the callbacks cache gets out of sync
124 fill-and-free-callback-heap