From 72dfb3339f2052822ac01dd591b8586bb1b9d477 Mon Sep 17 00:00:00 2001 From: Slava Pestov 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 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 hashcode* ; inline + binary-object over + [ 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 length ] unit-test +[ T{ empty-tuple } ] [ 100 first ] unit-test +[ ] [ T{ empty-tuple } 100 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