alien.c-types: not necessary to import `short` differently anymore

[factor.git] / basis / compiler / tests / intrinsics.factor

diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index 74d84e0d8986718c3a8622c593f312050e408f3b..54cb289e5ba55b998e018656ba70abb1158daa5b 100644 (file)
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -6,7 +6,6 @@ sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.data alien.syntax alien.strings
 namespaces libc io.encodings.ascii classes compiler.test ;
 FROM: math => float ;
-FROM: alien.c-types => short ;
 QUALIFIED-WITH: alien.c-types c
 IN: compiler.tests.intrinsics
 
@@ -49,12 +48,12 @@ IN: compiler.tests.intrinsics
 [ CHAR: b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test
 [ CHAR: b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test
 
-[ HEX: 123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
-[ HEX: 123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test
-[ HEX: 123456 ] [ [ 0 "\u123456bc" string-nth ] compile-call ] unit-test
-[ HEX: 123456 ] [ 1 "a\u123456c" [ string-nth ] compile-call ] unit-test
-[ HEX: 123456 ] [ 1 [ "a\u123456c" string-nth ] compile-call ] unit-test
-[ HEX: 123456 ] [ [ 1 "a\u123456c" string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ [ 0 "\u123456bc" string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ 1 "a\u123456c" [ string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ 1 [ "a\u123456c" string-nth ] compile-call ] unit-test
+[ 0x123456 ] [ [ 1 "a\u123456c" string-nth ] compile-call ] unit-test
 
 [ ] [ [ 0 special-object ] compile-call drop ] unit-test
 [ ] [ 1 special-object [ 1 set-special-object ] compile-call ] unit-test
@@ -244,9 +243,9 @@ IN: compiler.tests.intrinsics
 [ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
 [ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
 
-[ HEX: 10000000 ] [ HEX: 1000000 HEX: 10 [ fixnum* ] compile-call ] unit-test
-[ HEX: 8000000 ] [ HEX: -8000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
-[ HEX: 8000000 ] [ HEX: -7ffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
+[ 0x10000000 ] [ 0x1000000 0x10 [ fixnum* ] compile-call ] unit-test
+[ 0x8000000 ] [ -0x8000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
+[ 0x8000000 ] [ -0x7ffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
 
 [ t ] [ 1 26 fixnum-shift dup [ fixnum+ ] compile-call 1 27 fixnum-shift = ] unit-test
 [ -134217729 ] [ 1 27 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
@@ -263,8 +262,8 @@ IN: compiler.tests.intrinsics
 [ t ] [ f [ f eq? ] compile-call ] unit-test
 
 cell 8 = [
-    [ HEX: 40400000 ] [
-        HEX: 4200 [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ]
+    [ 0x40400000 ] [
+        0x4200 [ 0x7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ]
         compile-call
     ] unit-test
 ] when
@@ -286,9 +285,9 @@ cell 8 = [
 
 ! 64-bit overflow
 cell 8 = [
-    [ t ] [ 1 58 fixnum-shift dup [ fixnum+ ] compile-call 1 59 fixnum-shift = ] unit-test
-    [ -576460752303423489 ] [ 1 59 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
-    
+    [ t ] [ 1 fixnum-bits 2 - fixnum-shift dup [ fixnum+ ] compile-call 1 fixnum-bits 1 - fixnum-shift = ] unit-test
+    [ t ] [ most-negative-fixnum [ -1 fixnum+ ] compile-call first-bignum 1 + neg = ] unit-test
+
     [ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-call 1 80 shift = ] unit-test
     [ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-call 1 80 shift neg = ] unit-test
     [ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
@@ -301,10 +300,10 @@ cell 8 = [
     [ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-call ] unit-test
     [ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-call ] unit-test
     [ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
-    
-    [ 576460752303423488 ] [ -576460752303423488 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
 
-    [ 576460752303423488 0 ] [ -576460752303423488 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
+    [ t ] [ most-negative-fixnum -1 [ fixnum/i ] compile-call first-bignum = ] unit-test
+
+    [ t ] [ most-negative-fixnum -1 [ fixnum/mod ] compile-call [ first-bignum = ] [ zero? ] bi* and ] unit-test
 
     [ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-call ] unit-test
 ] when
@@ -315,17 +314,17 @@ cell 8 = [
 ERROR: bug-in-fixnum* x y a b ;
 
 [ ] [
-    10000 [ 
+    10000 [
         32 random-bits >fixnum
         32 random-bits >fixnum
         2dup [ fixnum* ] [ compiled-fixnum* ] 2bi 2dup =
-        [ 2drop 2drop ] [ bug-in-fixnum* ] if
+        [ 4drop ] [ bug-in-fixnum* ] if
     ] times
 ] unit-test
 
 : compiled-fixnum>bignum ( a -- b ) fixnum>bignum ;
 
-[ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test
+[ bignum ] [ 0 compiled-fixnum>bignum class-of ] unit-test
 
 [ ] [
     10000 [
@@ -339,7 +338,7 @@ ERROR: bug-in-fixnum* x y a b ;
 
 [ ] [
     10000 [
-        5 random iota [ drop 32 random-bits ] map product >bignum
+        5 random <iota> [ drop 32 random-bits ] map product >bignum
         dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
         [ drop ] [ "Oops" throw ] if
     ] times
@@ -467,10 +466,10 @@ ERROR: bug-in-fixnum* x y a b ;
 [ t ] [ pi double <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
 
 ! Silly
-[ t ] [ pi 4 <byte-array> [ [ { c:float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test
+[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test
 [ t ] [ pi c:float <ref> [ { byte-array } declare c:float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
 
-[ t ] [ pi 8 <byte-array> [ [ { c:float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test
+[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test
 
 [ 4 ] [
     2 B{ 1 2 3 4 5 6 } <displaced-alien> [
@@ -479,15 +478,15 @@ ERROR: bug-in-fixnum* x y a b ;
 ] unit-test
 
 [ ALIEN: 123 ] [
-    HEX: 123 [ <alien> ] compile-call
+    0x123 [ <alien> ] compile-call
 ] unit-test
 
 [ ALIEN: 123 ] [
-    HEX: 123 [ { fixnum } declare <alien> ] compile-call
+    0x123 [ { fixnum } declare <alien> ] compile-call
 ] unit-test
 
 [ ALIEN: 123 ] [
-    [ HEX: 123 <alien> ] compile-call
+    [ 0x123 <alien> ] compile-call
 ] unit-test
 
 [ f ] [
@@ -529,17 +528,19 @@ ERROR: bug-in-fixnum* x y a b ;
 [ ALIEN: 1234 ALIEN: 2234 ] [
     ALIEN: 234 [
         { c-ptr } declare
-        [ HEX: 1000 swap <displaced-alien> ]
-        [ HEX: 2000 swap <displaced-alien> ] bi
+        [ 0x1000 swap <displaced-alien> ]
+        [ 0x2000 swap <displaced-alien> ] bi
     ] compile-call
 ] unit-test
 
+! These tests must fail because we're not allowed to store
+! a pointer to a byte array inside of an alien object
 [
-    B{ 0 0 0 0 } [ { byte-array } declare void* deref ] compile-call
+    B{ 0 0 0 0 } [ { byte-array } declare void* <ref> ] compile-call
 ] must-fail
 
 [
-    B{ 0 0 0 0 } [ { c-ptr } declare void* deref ] compile-call
+    B{ 0 0 0 0 } [ { c-ptr } declare void* <ref> ] compile-call
 ] must-fail
 
 [