/core/alien/alien-tests.factor

 1USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
 2kernel kernel.private namespaces tools.test sequences libc math
 3system prettyprint layouts alien.libraries sets ;
 4FROM: namespaces => set ;
 5IN: alien.tests
 6
 7[ t ] [ -1 <alien> alien-address 0 > ] unit-test
 8
 9[ t ] [ 0 <alien> 0 <alien> = ] unit-test
10[ f ] [ 0 <alien> 1024 <alien> = ] unit-test
11[ f ] [ "hello" 1024 <alien> = ] unit-test
12[ f ] [ 0 <alien> ] unit-test
13[ f ] [ 0 f <displaced-alien> ] unit-test
14
15! Testing the various bignum accessor
1610 <byte-array> "dump" set
17
18[ "dump" get alien-address ] must-fail
19
20[ 123 ] [
21    123 "dump" get 0 set-alien-signed-1
22    "dump" get 0 alien-signed-1
23] unit-test
24
25[ 12345 ] [
26    12345 "dump" get 0 set-alien-signed-2
27    "dump" get 0 alien-signed-2
28] unit-test
29
30[ 12345678 ] [
31    12345678 "dump" get 0 set-alien-signed-4
32    "dump" get 0 alien-signed-4
33] unit-test
34
35[ 12345678901234567 ] [
36    12345678901234567 "dump" get 0 set-alien-signed-8
37    "dump" get 0 alien-signed-8
38] unit-test
39
40[ -1 ] [
41    -1 "dump" get 0 set-alien-signed-8
42    "dump" get 0 alien-signed-8
43] unit-test
44
45cell 8 = [
46    [ 0x123412341234 ] [
47      8 <byte-array>
48      0x123412341234 over 0 set-alien-signed-8
49      0 alien-signed-8
50    ] unit-test
51    
52    [ 0x123412341234 ] [
53      8 <byte-array>
54      0x123412341234 over 0 set-alien-signed-cell
55      0 alien-signed-cell
56    ] unit-test
57] when
58
59[ "ALIEN: 1234" ] [ 0x1234 <alien> unparse ] unit-test
60
61[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
62
63[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
64
65[ 1 1 <displaced-alien> ] must-fail
66
67[ f ] [ 1 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
68
69[ f ] [ 2 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
70
71[ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
72
73[ "( displaced alien )" ] [ 1 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
74
75SYMBOL: initialize-test
76
77f initialize-test set-global
78
79[ 31337 ] [ initialize-test [ 31337 ] initialize-alien ] unit-test
80
81[ 31337 ] [ initialize-test [ 69 ] initialize-alien ] unit-test
82
83[ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
84
85[ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
86
87[ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test