classes.struct: make hashcode and equal? work on structs wrapping null pointers, to fix another obscure issues arising with tuple arrays

db4
Slava Pestov 2010-08-06 00:15:22 -07:00
parent 53a8f004d0
commit 72dfb3339f
3 changed files with 41 additions and 7 deletions

View File

@ -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

View File

@ -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

View File

@ -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
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