diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 6c7a4cf35d..d788b9bdb1 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -4,7 +4,7 @@ alien.structs.fields alien.syntax ascii classes.struct combinators destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc literals math multiline namespaces prettyprint prettyprint.config see sequences specialized-arrays.ushort -system tools.test ; +system tools.test combinators.short-circuit ; IN: classes.struct.tests << @@ -138,6 +138,25 @@ UNION-STRUCT: struct-test-float-and-bits } } ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test +STRUCT: struct-test-equality-1 + { x int } ; +STRUCT: struct-test-equality-2 + { y int } ; + +[ t ] [ + [ + struct-test-equality-1 5 >>x + struct-test-equality-1 malloc-struct &free 5 >>x = + ] with-destructors +] unit-test + +[ f ] [ + [ + struct-test-equality-1 5 >>x + struct-test-equality-2 malloc-struct &free 5 >>y = + ] with-destructors +] unit-test + STRUCT: struct-test-ffi-foo { x int } { y int } ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 81252656a4..07515bc843 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -2,10 +2,10 @@ USING: accessors alien alien.c-types alien.structs alien.structs.fields arrays byte-arrays classes classes.parser classes.tuple classes.tuple.parser classes.tuple.private -combinators combinators.smart fry generalizations generic.parser -kernel kernel.private lexer libc macros make math math.order -parser quotations sequences slots slots.private struct-arrays -vectors words ; +combinators combinators.short-circuit combinators.smart fry +generalizations generic.parser kernel kernel.private lexer +libc macros make math math.order parser quotations sequences +slots slots.private struct-arrays vectors words ; FROM: slots => reader-word writer-word ; IN: classes.struct @@ -28,6 +28,12 @@ PREDICATE: struct-class < tuple-class M: struct >c-ptr 2 slot { c-ptr } declare ; inline +M: struct equal? + { + [ [ class ] bi@ = ] + [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ] + } 2&& ; + : memory>struct ( ptr class -- struct ) over c-ptr? [ swap \ c-ptr bad-slot-value ] unless tuple-layout [ 2 set-slot ] keep ; diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index 926a6c4ec4..4142e40c68 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -83,6 +83,12 @@ PRIVATE> : memcpy ( dst src size -- ) "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; +: memcmp ( a b size -- cmp ) + "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ; + +: memory= ( a b size -- ? ) + memcmp 0 = ; + : strlen ( alien -- len ) "size_t" "libc" "strlen" { "char*" } alien-invoke ;