From f4781805fc84829f6e859e01cf00055253653599 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 20 May 2022 22:40:53 -0700
Subject: ffi: testing and fixing flexible arrays.

* ffi.c (ffi_flex_struct_in): Check for the last member being
an array, and not null-terminated. We now check the character
conversion disposition of the array. If it has character
conversion, then we store the length right into the slot that
will become the string. In the no-conversion case, we assume
that if the member exists, it's a vector we can resize.
Otherwise we plant a vector of the required size.
(ffi_varray_put): Only call ffi_varray_dynsize if the Lisp
object is a vector. If the Lisp objecct is a number, then use
that as the size. Otherwise the size is zero.

* tests/017/flexstruct.tl: New file.
---
 ffi.c                   | 43 +++++++++++++++++++++++++--------
 tests/017/flexstruct.tl | 64 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 97 insertions(+), 10 deletions(-)
 create mode 100644 tests/017/flexstruct.tl

diff --git a/ffi.c b/ffi.c
index 13e8769b..18382cf6 100644
--- a/ffi.c
+++ b/ffi.c
@@ -2446,17 +2446,33 @@ static void ffi_ptr_in_release(struct txr_ffi_type *tft, val obj,
 static val ffi_flex_struct_in(struct txr_ffi_type *tft, val strct, val self)
 {
   struct smemb *lastm = &tft->memb[tft->nelem - 1];
-  val length_meth = get_special_slot(strct, length_m);
-
+  struct txr_ffi_type *lmtft = lastm->mtft;
   (void) self;
 
-  if (length_meth) {
-    val len = funcall1(length_meth, strct);
-    val memb = slot(strct, lastm->mname);
-    if (vectorp(memb))
-      return vec_set_length(memb, len);
-    else
-      return slotset(strct, lastm->mname, vector(len, nil));
+  if (lmtft->kind == FFI_KIND_ARRAY && !lmtft->null_term) {
+    val length_meth = get_special_slot(strct, length_m);
+
+    if (length_meth) {
+      val len = funcall1(length_meth, strct);
+
+      switch (lmtft->ch_conv) {
+      case conv_char:
+      case conv_zchar:
+      case conv_wchar:
+      case conv_bchar:
+        slotset(strct, lastm->mname, len);
+        break;
+      case conv_none:
+        {
+          val memb = slot(strct, lastm->mname);
+          if (memb)
+            return vec_set_length(memb, len);
+          else
+            return slotset(strct, lastm->mname, vector(len, nil));
+        }
+        break;
+      }
+    }
   }
 
   return slot(strct, lastm->mname);
@@ -2978,7 +2994,14 @@ static val ffi_varray_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 {
   if (copy) {
     struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
-    cnum nelem = if3(vec, ffi_varray_dynsize(tft, vec, self) / etft->size, 0);
+    cnum nelem = 0;
+
+    if (vectorp(vec)) {
+      nelem = ffi_varray_dynsize(tft, vec, self) / etft->size;
+    } else if (numberp(vec)) {
+      nelem = c_num(vec, self);
+      vec = nil;
+    }
 
     switch (tft->ch_conv) {
     case conv_char:
diff --git a/tests/017/flexstruct.tl b/tests/017/flexstruct.tl
new file mode 100644
index 00000000..c8feedef
--- /dev/null
+++ b/tests/017/flexstruct.tl
@@ -0,0 +1,64 @@
+(load "../common")
+
+(typedef fs0 (struct fs0
+               (a uint8)
+               (b (array char))))
+
+(mtest
+  (sizeof fs0) 1
+  (ffi-put #S(fs0 a 3 b "ABC") (ffi fs0)) #b'03414243'
+  (ffi-get #b'03414243' (ffi fs0)) #S(fs0 a 3 b ""))
+
+(defmeth fs0 length (s)
+  s.a)
+
+(mtest
+  (ffi-get #b'03414243' (ffi fs0)) #S(fs0 a 3 b "ABC")
+  (ffi-get #b'02e6bca2e5ad97' (ffi fs0)) #S(fs0 a 2 b "\xDCE6\xDCBC")
+  (ffi-get #b'06e6bca2e5ad97' (ffi fs0)) #S(fs0 a 6 b "漢字"))
+
+(typedef fs1 (struct fs1
+               (a uint8)
+               (b (zarray char))))
+
+(mtest
+  (sizeof fs1) 1
+  (ffi-put #S(fs1 a 3 b "ABCDEF") (ffi fs1)) #b'0341424344454600'
+  (ffi-get #b'FF41424300' (ffi fs1)) #S(fs1 a 255  b "ABC"))
+
+(mtest
+  (ffi-get #b'0341424300' (ffi fs1)) #S(fs1 a 3 b "ABC")
+  (ffi-get #b'02e6bc00' (ffi fs1)) #S(fs1 a 2 b "\xDCE6\xDCBC")
+  (ffi-get #b'06e6bca2e5ad9700' (ffi fs1)) #S(fs1 a 6 b "漢字"))
+
+(typedef fs2 (struct fs2
+               (a int8)
+               (b (array int8))))
+
+(mtest
+  (sizeof fs2) 1
+  (ffi-put #S(fs2 a 3 b "ABCD") (ffi fs2)) #b'0341424344'
+  (ffi-put #S(fs2 a 3 b #(65 66 67 68)) (ffi fs2)) #b'0341424344'
+  (ffi-get #b'FF414243' (ffi fs2)) #S(fs2 a 255  b #()))
+
+(defmeth fs2 length (s)
+  s.a)
+
+(mtest
+  (ffi-get #b'03010203' (ffi fs2)) #S(fs2 a 3 b #(1 2 3)))
+
+(typedef fs3 (struct fs3
+               (a int8)
+               (b (array le-int16))))
+
+(mtest
+  (sizeof fs3) 2
+  (ffi-put #S(fs3 a 3 b "ABCD") (ffi fs3)) #b'03004100420043004400'
+  (ffi-put #S(fs3 a 3 b #(65 66 67 68)) (ffi fs3)) #b'03004100420043004400'
+  (ffi-get #b'FF414243' (ffi fs3)) #S(fs3 a 255 b #()))
+
+(defmeth fs3 length (s)
+  s.a)
+
+(mtest
+  (ffi-get #b'0300010002000300' (ffi fs3)) #S(fs3 a 3 b #(1 2 3)))
-- 
cgit v1.2.3