get classes.struct tests passing

diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor
index 9d0c18feb4ea9d4fc22144f0022df4f33120d611..6e739edb5f04b687c14a2a3d2470df5adc55a28e 100644 (file)
--- a/extra/classes/struct/struct-tests.factor
+++ b/extra/classes/struct/struct-tests.factor
@@ -1,5 +1,6 @@
-USING: classes.struct tools.test ;
-IN: classes.struct.test
+USING: accessors alien.c-types classes.c-types classes.struct
+combinators kernel tools.test ;
+IN: classes.struct.tests
 
 STRUCT: foo
     { x char }
@@ -14,3 +15,13 @@ STRUCT: bar
 [ 16 ] [ bar heap-size ] unit-test
 [ 123 ] [ foo new y>> ] unit-test
 [ 123 ] [ bar new foo>> y>> ] unit-test
+
+[ 1 2 3 t ] [
+    1 2 3 t foo boa bar boa
+    {
+        [ w>> ] 
+        [ foo>> x>> ]
+        [ foo>> y>> ]
+        [ foo>> z>> ]
+    } cleave
+] unit-test

diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor
index 94932f89d90a5831aea2554445a3bdf7f1d71160..b4132c68163898689535b6ef61a2fece46b1c696 100644 (file)
--- a/extra/classes/struct/struct.factor
+++ b/extra/classes/struct/struct.factor
@@ -22,7 +22,7 @@ M: struct >c-ptr
 
 : memory>struct ( ptr class -- struct )
     over c-ptr? [ swap \ c-ptr bad-slot-value ] unless
-    tuple-layout <tuple-boa> ; inline
+    tuple-layout <tuple> [ 2 set-slot ] keep ;
 
 : malloc-struct ( class -- struct )
     [ heap-size malloc ] keep memory>struct ; inline
@@ -100,7 +100,7 @@ M: struct-class heap-size
 
 : struct-prototype ( class -- prototype )
     [ heap-size <byte-array> ]
-    [ tuple-layout <tuple> [ 2 set-slot ] keep ]
+    [ memory>struct ]
     [ "struct-slots" word-prop ] tri
     [
         [ initial>> ]
@@ -122,7 +122,7 @@ M: struct-class heap-size
 : define-struct-class ( class slots -- )
     [ drop struct f define-tuple-class ] [
         make-slots dup
-        [ check-struct-slots ] [ struct-offsets ] [ struct-align ] tri
+        [ check-struct-slots ] [ struct-offsets ] [ struct-align [ align ] keep ] tri
         (define-struct-class)
     ] [ drop dup struct-prototype "prototype" set-word-prop ] 2tri ;