classes.struct: make hashcode and equal? work on structs wrapping null pointers,...

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 4ed7d9b446deb1716e6fa17433d0811bc2633fc8..b42684806bbcc6df1ef0e816fb56fcd53899c87b 100644 (file)
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -245,6 +245,8 @@ STRUCT: struct-test-equality-1
 STRUCT: struct-test-equality-2
     { y int } ;
 
+[ 0 ] [ struct-test-equality-1 new hashcode ] unit-test
+
 [ t ] [
     [
         struct-test-equality-1 <struct> 5 >>x

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 3699cdb7d1743964c6be18326d4a79158409058c..15a7b72c6c2aaabf9dbe49def8313e9d1d473571 100644 (file)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -48,13 +48,18 @@ M: struct >c-ptr
     2 slot { c-ptr } declare ; inline
 
 M: struct equal?
-    {
-        [ [ class ] bi@ = ]
-        [ [ >c-ptr ] [ binary-object ] bi* memory= ]
-    } 2&& ; inline
+    over struct? [
+        2dup [ class ] bi@ = [
+            2dup [ >c-ptr ] both?
+            [ [ >c-ptr ] [ binary-object ] bi* memory= ]
+            [ [ >c-ptr not ] both? ]
+            if
+        ] [ 2drop f ] if
+    ] [ 2drop f ] if ; inline
 
 M: struct hashcode*
-    binary-object <direct-uchar-array> hashcode* ; inline
+    binary-object over
+    [ <direct-uchar-array> hashcode* ] [ 3drop 0 ] if ; inline
 
 : struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
 

diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor
index 0fbf0eeaa017d47ebf84436e7b75af9ce90a73ff..aa64e9a72d2a94e5806f04942e5450fc5f0274b2 100644 (file)
--- a/basis/tuple-arrays/tuple-arrays-tests.factor
+++ b/basis/tuple-arrays/tuple-arrays-tests.factor
@@ -1,5 +1,5 @@
 USING: tuple-arrays sequences tools.test namespaces kernel
-math accessors classes.tuple eval ;
+math accessors classes.tuple eval classes.struct ;
 IN: tuple-arrays.tests
 
 SYMBOL: mat
@@ -41,4 +41,31 @@ TUPLE: non-final x ;
 
 [ "IN: tuple-arrays.tests USE: tuple-arrays TUPLE-ARRAY: non-final" eval( -- ) ]
 [ error>> not-final? ]
-must-fail-with
\ No newline at end of file
+must-fail-with
+
+! Empty tuple
+TUPLE: empty-tuple ; final
+
+TUPLE-ARRAY: empty-tuple
+
+[ 100 ] [ 100 <empty-tuple-array> length ] unit-test
+[ T{ empty-tuple } ] [ 100 <empty-tuple-array> first ] unit-test
+[ ] [ T{ empty-tuple } 100 <empty-tuple-array> set-first ] unit-test
+
+! Changing a tuple into a struct shouldn't break the tuple array to the point
+! of crashing Factor
+TUPLE: tuple-to-struct x ; final
+
+TUPLE-ARRAY: tuple-to-struct
+
+[ f ] [ tuple-to-struct struct-class? ] unit-test
+
+! This shouldn't crash
+[ ] [
+    "IN: tuple-arrays.tests
+    USING: alien.c-types classes.struct ;
+    STRUCT: tuple-to-struct { x int } ;"
+    eval( -- )
+] unit-test
+
+[ t ] [ tuple-to-struct struct-class? ] unit-test
\ No newline at end of file