kernel libc literals math mirrors namespaces prettyprint
prettyprint.config see sequences specialized-arrays system
tools.test parser lexer eval layouts generic.single classes
-vocabs ;
+vocabs generic classes.private definitions ;
FROM: math => float ;
FROM: specialized-arrays.private => specialized-array-vocab ;
QUALIFIED-WITH: alien.c-types c
{ z bool } ;
STRUCT: struct-test-bar
- { w ushort initial: HEX: ffff }
+ { w ushort initial: 0xffff }
{ foo struct-test-foo } ;
[ 12 ] [ struct-test-foo heap-size ] unit-test
[ {
{ "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
{ { "x" char } 98 }
- { { "y" int } HEX: 7F00007F }
+ { { "y" int } 0x7F00007F }
{ { "z" bool } f }
} ] [
B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
{ type bool }
{ class object }
}
-} ] [ struct-test-foo c-type fields>> ] unit-test
+} ] [ struct-test-foo lookup-c-type fields>> ] unit-test
[ {
T{ struct-slot-spec
{ class $[ cell 4 = integer fixnum ? ] }
{ initial 0 }
}
-} ] [ struct-test-float-and-bits c-type fields>> ] unit-test
+} ] [ struct-test-float-and-bits lookup-c-type fields>> ] unit-test
STRUCT: struct-test-equality-1
{ x int } ;
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
- [ 3 <direct-struct-test-optimization-array> third y>> ]
+ [ 3 struct-test-optimization <c-direct-array> third y>> ]
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
] unit-test
[ t ] [
[ struct-test-optimization memory>struct x>> second ]
- { memory>struct x>> <direct-int-array> <tuple> <tuple-boa> } inlined?
+ { memory>struct x>> int <c-direct-array> <tuple> <tuple-boa> } inlined?
] unit-test
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
clone-test-struct <struct>
1 >>x char-array{ 9 1 1 } >>y
clone
- [ x>> ] [ y>> >char-array ] bi
+ [ x>> ] [ y>> char >c-array ] bi
] unit-test
[ t 1 char-array{ 9 1 1 } ] [
clone-test-struct malloc-struct &free
1 >>x char-array{ 9 1 1 } >>y
clone
- [ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
+ [ >c-ptr byte-array? ] [ x>> ] [ y>> char >c-array ] tri
] with-destructors
] unit-test
{ y int }
{ x longlong } ;
- cpu ppc? 4 cell = and os macosx? and [
- [ 12 ] [ ppc-align-test-2 heap-size ] unit-test
- [ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
- ] [
- [ 16 ] [ ppc-align-test-2 heap-size ] unit-test
- [ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
- ] if
+ [ 16 ] [ ppc-align-test-2 heap-size ] unit-test
+ [ 8 ] [ "x" ppc-align-test-2 offset-of ] unit-test
] when
STRUCT: struct-test-delegate
STRUCT: struct-1-union { a int initial: 0 } ;
" ]
[ \ struct-1-union [ see ] with-string-writer ] unit-test
+
+! Bug #206
+STRUCT: going-to-redefine { a uint } ;
+[ ] [
+ "IN: classes.struct.tests TUPLE: going-to-redefine b ;" eval( -- )
+] unit-test
+[ f ] [ \ going-to-redefine \ clone ?lookup-method ] unit-test
+[ f ] [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test
+
+! Test reset-class on structs, which should forget all the accessors, clone, and struct-slot-values
+STRUCT: some-accessors { aaa uint } { bbb int } ;
+[ ] [ [ \ some-accessors reset-class ] with-compilation-unit ] unit-test
+[ f ] [ \ some-accessors \ a>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ a<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ clone ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
+
+<< \ some-accessors forget >>