From 72dfb3339f2052822ac01dd591b8586bb1b9d477 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 6 Aug 2010 00:15:22 -0700
Subject: [PATCH] classes.struct: make hashcode and equal? work on structs
 wrapping null pointers, to fix another obscure issues arising with tuple
 arrays

---
 basis/classes/struct/struct-tests.factor     |  2 ++
 basis/classes/struct/struct.factor           | 15 ++++++----
 basis/tuple-arrays/tuple-arrays-tests.factor | 31 ++++++++++++++++++--
 3 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 4ed7d9b446..b42684806b 100644
--- 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 3699cdb7d1..15a7b72c6c 100644
--- 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 0fbf0eeaa0..aa64e9a72d 100644
--- 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