2008-03-01 17:00:45 -05:00
|
|
|
IN: alien.tests
|
2008-07-04 23:36:55 -04:00
|
|
|
USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
|
2008-03-18 18:46:25 -04:00
|
|
|
kernel kernel.private namespaces tools.test sequences libc math
|
|
|
|
|
system prettyprint layouts ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
[ t ] [ -1 <alien> alien-address 0 > ] unit-test
|
|
|
|
|
|
|
|
|
|
[ t ] [ 0 <alien> 0 <alien> = ] unit-test
|
|
|
|
|
[ f ] [ 0 <alien> 1024 <alien> = ] unit-test
|
|
|
|
|
[ f ] [ "hello" 1024 <alien> = ] unit-test
|
|
|
|
|
[ f ] [ 0 <alien> ] unit-test
|
|
|
|
|
[ f ] [ 0 f <displaced-alien> ] unit-test
|
|
|
|
|
|
|
|
|
|
! Testing the various bignum accessor
|
|
|
|
|
10 <byte-array> "dump" set
|
|
|
|
|
|
2008-02-06 14:47:19 -05:00
|
|
|
[ "dump" get alien-address ] must-fail
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
[ 123 ] [
|
|
|
|
|
123 "dump" get 0 set-alien-signed-1
|
|
|
|
|
"dump" get 0 alien-signed-1
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ 12345 ] [
|
|
|
|
|
12345 "dump" get 0 set-alien-signed-2
|
|
|
|
|
"dump" get 0 alien-signed-2
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ 12345678 ] [
|
|
|
|
|
12345678 "dump" get 0 set-alien-signed-4
|
|
|
|
|
"dump" get 0 alien-signed-4
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ 12345678901234567 ] [
|
|
|
|
|
12345678901234567 "dump" get 0 set-alien-signed-8
|
|
|
|
|
"dump" get 0 alien-signed-8
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ -1 ] [
|
|
|
|
|
-1 "dump" get 0 set-alien-signed-8
|
|
|
|
|
"dump" get 0 alien-signed-8
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
cell 8 = [
|
|
|
|
|
[ HEX: 123412341234 ] [
|
|
|
|
|
8 <byte-array>
|
|
|
|
|
HEX: 123412341234 over 0 set-alien-signed-8
|
|
|
|
|
0 alien-signed-8
|
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
|
|
[ HEX: 123412341234 ] [
|
|
|
|
|
8 <byte-array>
|
|
|
|
|
HEX: 123412341234 over 0 set-alien-signed-cell
|
|
|
|
|
0 alien-signed-cell
|
|
|
|
|
] unit-test
|
|
|
|
|
] when
|
|
|
|
|
|
|
|
|
|
[ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
|
2007-09-28 04:02:06 -04:00
|
|
|
|
2007-09-29 23:57:29 -04:00
|
|
|
[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
|
|
|
|
|
|
2008-02-06 14:47:19 -05:00
|
|
|
[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
|
2007-09-28 04:02:06 -04:00
|
|
|
|
2008-02-06 14:47:19 -05:00
|
|
|
[ 1 1 <displaced-alien> ] must-fail
|
2007-11-07 19:26:39 -05:00
|
|
|
|
|
|
|
|
[ f ] [ 0 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
|
|
|
|
|
|
2008-07-04 23:36:55 -04:00
|
|
|
[ f ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
|
|
|
|
|
|
|
|
|
|
[ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
|
|
|
|
|
|
2007-11-07 19:26:39 -05:00
|
|
|
[ "( displaced alien )" ] [ 0 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
|
2008-03-18 18:46:25 -04:00
|
|
|
|
|
|
|
|
[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
|
|
|
|
|
|
|
|
|
|
[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
|
