From a4a6885189bb7a432d4c78638975f7b6a1c9564d Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Wed, 28 Jan 2009 01:58:57 -0600
Subject: [PATCH] Fix setters for value struct slots and add unit test for this
 case; this fixes an io.mmap regression on Windows

---
 basis/alien/arrays/arrays.factor         |  2 +-
 basis/alien/c-types/c-types.factor       | 26 +++++++++++++-----------
 basis/alien/structs/structs-tests.factor | 15 ++++++++++++++
 basis/alien/structs/structs.factor       | 12 +++++++++--
 4 files changed, 40 insertions(+), 15 deletions(-)
 mode change 100644 => 100755 basis/alien/arrays/arrays.factor
 mode change 100644 => 100755 basis/alien/c-types/c-types.factor
 mode change 100644 => 100755 basis/alien/structs/structs-tests.factor
 mode change 100644 => 100755 basis/alien/structs/structs.factor

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
old mode 100644
new mode 100755
index 8253d9458c..6a182f8dbf
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -26,7 +26,7 @@ M: array box-return drop "void*" box-return ;
 
 M: array stack-size drop "void*" stack-size ;
 
-M: array c-type-boxer-quot drop f ;
+M: array c-type-boxer-quot drop [ ] ;
 
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
 
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
old mode 100644
new mode 100755
index a4bc3d3f52..a44b5cf2b6
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry call ;
+accessors combinators effects continuations fry call classes ;
 IN: alien.c-types
 
 DEFER: <int>
@@ -13,18 +13,20 @@ DEFER: *char
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
 TUPLE: c-type
-class
-boxer boxer-quot unboxer unboxer-quot
-getter setter
-reg-class size align stack-align? ;
-
-: new-c-type ( class -- type )
-    new
-        int-regs >>reg-class
-        object >>class ; inline
+{ class class initial: object }
+boxer
+{ boxer-quot callable }
+unboxer
+{ unboxer-quot callable }
+{ getter callable }
+{ setter callable }
+{ reg-class initial: int-regs }
+size
+align
+stack-align? ;
 
 : <c-type> ( -- type )
-    \ c-type new-c-type ;
+    \ c-type new ;
 
 SYMBOL: c-types
 
@@ -224,7 +226,7 @@ M: f byte-length drop 0 ;
 TUPLE: long-long-type < c-type ;
 
 : <long-long-type> ( -- type )
-    long-long-type new-c-type ;
+    long-long-type new ;
 
 M: long-long-type unbox-parameter ( n type -- )
     c-type-unboxer %unbox-long-long ;
diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor
old mode 100644
new mode 100755
index ec0c01c2e7..8bc570c448
--- a/basis/alien/structs/structs-tests.factor
+++ b/basis/alien/structs/structs-tests.factor
@@ -42,3 +42,18 @@ C-UNION: barx
     [ ] [ \ foox-x "help" get execute ] unit-test
     [ ] [ \ set-foox-x "help" get execute ] unit-test
 ] when
+
+C-STRUCT: nested
+    { "int" "x" } ;
+
+C-STRUCT: nested-2
+    { "nested" "y" } ;
+
+[ 4 ] [
+    "nested-2" <c-object>
+    "nested" <c-object>
+    4 over set-nested-x
+    over set-nested-2-y
+    nested-2-y
+    nested-x
+] unit-test
diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
old mode 100644
new mode 100755
index 698518b4e5..8ec694198d
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -2,10 +2,18 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
-alien.c-types alien.structs.fields cpu.architecture math.order ;
+alien.c-types alien.structs.fields cpu.architecture math.order
+quotations ;
 IN: alien.structs
 
-TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
+TUPLE: struct-type
+size
+align
+fields
+{ boxer-quot callable }
+{ unboxer-quot callable }
+{ getter callable }
+{ setter callable } ;
 
 M: struct-type heap-size size>> ;