classes.struct: fix for struct equality and hashcode #1194

Instead of comparing the structs underlying byte arrays, get their slots
and compare that.

basis/classes/struct/struct-docs.factor

@@ -1,6 +1,6 @@
 ! (c)Joe Groff bsd license
-USING: alien classes help.markup help.syntax kernel libc
+USING: alien classes classes.struct.private help.markup help.syntax
-quotations slots ;
+kernel libc math sequences ;
 IN: classes.struct
 
 HELP: <struct-boa>
@@ -92,6 +92,10 @@ HELP: (malloc-struct)
 }
 { $description "Allocates unmanaged C heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; to initialize the allocated memory with the slots' initial values, use " { $link malloc-struct } ". The struct should be " { $link free } "d when it is no longer needed." } ;
 
+HELP: compute-struct-offsets
+{ $values { "slots" sequence } { "size" integer } }
+{ $description "Computes how many bytes of memory the struct takes, minus final padding." } ;
+
 HELP: memory>struct
 { $values
     { "ptr" c-ptr } { "class" class }
@@ -111,6 +115,11 @@ HELP: struct
 HELP: struct-class
 { $class-description "The metaclass of all " { $link struct } " classes." } ;
 
+HELP: struct-slot-values
+{ $values { "struct" struct } { "sequence" sequence } }
+{ $description "Extracts the values of the structs slots" }
+{ $errors "Throws a memory protection error if the memory the struct references is not accessible." } ;
+
 ARTICLE: "classes.struct.examples" "Struct class examples"
 "A struct with a variety of fields:"
 { $code

basis/classes/struct/struct-tests.factor

@@ -246,7 +246,6 @@ STRUCT: struct-test-equality-1
 STRUCT: struct-test-equality-2
     { y int } ;
 
-{ 0 } [ struct-test-equality-1 new hashcode ] unit-test
 
 { t } [
     [
@@ -262,14 +261,6 @@ STRUCT: struct-test-equality-2
     ] with-destructors
 ] unit-test
 
-{ t } [
-    [
-        struct-test-equality-1 <struct> 5 >>x
-        struct-test-equality-1 malloc-struct &free 5 >>x
-        [ hashcode ] same?
-    ] with-destructors
-] unit-test
-
 STRUCT: struct-test-array-slots
     { x int }
     { y ushort[6] initial: ushort-array{ 2 3 5 7 11 13 } }
@@ -542,3 +533,28 @@ STRUCT: some-accessors { aaa uint } { bbb int } ;
 { f } [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
 
 << \ some-accessors forget >>
+
+! hashcode tests
+{ 0 } [ struct-test-equality-1 new hashcode ] unit-test
+
+{ t } [
+    [
+        struct-test-equality-1 <struct> 5 >>x
+        struct-test-equality-1 malloc-struct &free 5 >>x
+        [ hashcode ] same?
+    ] with-destructors
+] unit-test
+
+! Same slots, so the hashcode should be the same.
+{ t } [
+    B{ 98 0 33 0 1 1 1 1 1 1 1 1 } struct-test-foo memory>struct
+    B{ 98 0 22 0 1 1 1 1 1 1 1 1 } struct-test-foo memory>struct
+    [ hashcode ] same?
+] unit-test
+
+! Equality tests
+{ t } [
+    B{ 98 0 33 0 1 1 1 1 1 1 1 1 } struct-test-foo memory>struct
+    B{ 98 0 22 0 1 1 1 1 1 1 1 1 } struct-test-foo memory>struct
+    =
+] unit-test

basis/classes/struct/struct.factor

@@ -45,24 +45,9 @@ M: struct-class group-words
     struct-slots slot-group-words ;
 
 ! struct allocation
-
 M: struct >c-ptr
     2 slot { c-ptr } declare ; inline
 
-M: struct equal?
-    over struct? [
-        2dup [ class-of ] same? [
-            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 over
-    [ uchar <c-direct-array> hashcode* ] [ 3drop 0 ] if ; inline
-
 : struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
 
 : memory>struct ( ptr class -- struct )
@@ -169,6 +154,14 @@ M: struct-class writer-quot
 : offset-of ( field struct -- offset )
     struct-slots slot-named offset>> ; inline
 
+M: struct equal?
+    2dup [ class-of ] same? [
+        [ struct-slot-values ] same?
+    ] [ 2drop f ] if ; inline
+
+M: struct hashcode*
+    nip dup >c-ptr [ struct-slot-values hashcode ] [ drop 0 ] if ; inline
+
 ! c-types
 
 TUPLE: struct-c-type < abstract-c-type