]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/classes/struct/struct-tests.factor
use radix literals
[factor.git] / basis / classes / struct / struct-tests.factor
index 79018f577b2eac953e44e6ebf412935855744d26..b619c5abcd6a3fb05f24e9a3c4f608aeabad5f45 100644 (file)
@@ -8,7 +8,7 @@ destructors io.encodings.utf8 io.pathnames io.streams.string
 kernel libc literals math mirrors namespaces prettyprint
 prettyprint.config see sequences specialized-arrays system
 tools.test parser lexer eval layouts generic.single classes
-vocabs ;
+vocabs generic classes.private definitions ;
 FROM: math => float ;
 FROM: specialized-arrays.private => specialized-array-vocab ;
 QUALIFIED-WITH: alien.c-types c
@@ -28,7 +28,7 @@ STRUCT: struct-test-foo
     { z bool } ;
 
 STRUCT: struct-test-bar
-    { w ushort initial: HEX: ffff }
+    { w ushort initial: 0xffff }
     { foo struct-test-foo } ;
 
 [ 12 ] [ struct-test-foo heap-size ] unit-test
@@ -53,7 +53,7 @@ STRUCT: struct-test-bar
 [ {
     { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
     { { "x" char } 98            }
-    { { "y" int  } HEX: 7F00007F }
+    { { "y" int  } 0x7F00007F }
     { { "z" bool } f             }
 } ] [
     B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
@@ -229,7 +229,7 @@ UNION-STRUCT: struct-test-float-and-bits
         { type bool }
         { class object }
     }
-} ] [ struct-test-foo c-type fields>> ] unit-test
+} ] [ struct-test-foo lookup-c-type fields>> ] unit-test
 
 [ {
     T{ struct-slot-spec
@@ -246,7 +246,7 @@ UNION-STRUCT: struct-test-float-and-bits
         { class $[ cell 4 = integer fixnum ? ] }
         { initial 0 }
     }
-} ] [ struct-test-float-and-bits c-type fields>> ] unit-test
+} ] [ struct-test-float-and-bits lookup-c-type fields>> ] unit-test
 
 STRUCT: struct-test-equality-1
     { x int } ;
@@ -297,7 +297,7 @@ SPECIALIZED-ARRAY: struct-test-optimization
 
 [ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
 [ t ] [
-    [ 3 <direct-struct-test-optimization-array> third y>> ]
+    [ 3 struct-test-optimization <c-direct-array> third y>> ]
     { <tuple> <tuple-boa> memory>struct y>> } inlined?
 ] unit-test
 
@@ -468,13 +468,8 @@ cpu ppc? [
         { y int }
         { x longlong } ;
 
-    cpu ppc? 4 cell = and os macosx? and [
-        [ 12 ] [ ppc-align-test-2 heap-size ] unit-test
-        [ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
-    ] [
-        [ 16 ] [ ppc-align-test-2 heap-size ] unit-test
-        [ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
-    ] if
+    [ 16 ] [ ppc-align-test-2 heap-size ] unit-test
+    [ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
 ] when
 
 STRUCT: struct-test-delegate
@@ -534,3 +529,23 @@ IN: classes.struct.tests
 STRUCT: struct-1-union { a int initial: 0 } ;
 " ]
 [ \ struct-1-union [ see ] with-string-writer ] unit-test
+
+! Bug #206
+STRUCT: going-to-redefine { a uint } ;
+[ ] [
+    "IN: classes.struct.tests TUPLE: going-to-redefine b ;" eval( -- )
+] unit-test
+[ f ] [ \ going-to-redefine \ clone ?lookup-method ] unit-test
+[ f ] [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test
+
+! Test reset-class on structs, which should forget all the accessors, clone, and struct-slot-values
+STRUCT: some-accessors { aaa uint } { bbb int } ;
+[ ] [ [ \ some-accessors reset-class ] with-compilation-unit ] unit-test
+[ f ] [ \ some-accessors \ a>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ a<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ clone ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
+
+<< \ some-accessors forget >>