]> gitweb.factorcode.org Git - factor.git/blob - core/alien/alien-tests.factor
Fix permission bits
[factor.git] / core / alien / alien-tests.factor
1 IN: alien.tests
2 USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
3 kernel kernel.private namespaces tools.test sequences libc math
4 system prettyprint layouts ;
5
6 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
7
8 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
9 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
10 [ f ] [ "hello" 1024 <alien> = ] unit-test
11 [ f ] [ 0 <alien> ] unit-test
12 [ f ] [ 0 f <displaced-alien> ] unit-test
13
14 ! Testing the various bignum accessor
15 10 <byte-array> "dump" set
16
17 [ "dump" get alien-address ] must-fail
18
19 [ 123 ] [
20     123 "dump" get 0 set-alien-signed-1
21     "dump" get 0 alien-signed-1
22 ] unit-test
23
24 [ 12345 ] [
25     12345 "dump" get 0 set-alien-signed-2
26     "dump" get 0 alien-signed-2
27 ] unit-test
28
29 [ 12345678 ] [
30     12345678 "dump" get 0 set-alien-signed-4
31     "dump" get 0 alien-signed-4
32 ] unit-test
33
34 [ 12345678901234567 ] [
35     12345678901234567 "dump" get 0 set-alien-signed-8
36     "dump" get 0 alien-signed-8
37 ] unit-test
38
39 [ -1 ] [
40     -1 "dump" get 0 set-alien-signed-8
41     "dump" get 0 alien-signed-8
42 ] unit-test
43
44 cell 8 = [
45     [ HEX: 123412341234 ] [
46       8 <byte-array>
47       HEX: 123412341234 over 0 set-alien-signed-8
48       0 alien-signed-8
49     ] unit-test
50     
51     [ HEX: 123412341234 ] [
52       8 <byte-array>
53       HEX: 123412341234 over 0 set-alien-signed-cell
54       0 alien-signed-cell
55     ] unit-test
56 ] when
57
58 [ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
59
60 [ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
61
62 [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
63
64 [ 1 1 <displaced-alien> ] must-fail
65
66 [ f ] [ 0 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
67
68 [ f ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
69
70 [ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
71
72 [ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
73
74 [ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
75
76 [ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test