Commit c3a5ee4ef58a1ca481b7a6837554e039040fac8d

Thomas de Grivel 2023-12-18T07:08:56

wip tests

diff --git a/ic3/.ic3_history b/ic3/.ic3_history
index 7a802ef..3d5db01 100644
--- a/ic3/.ic3_history
+++ b/ic3/.ic3_history
@@ -6,3 +6,4 @@ quote %GL.Sphere{segments_u: 100}
 %GL.Sphere{segments_u: 100}
 %GL.Sphere{segments_u: 100 + 1}
 %GL.Sphere{segments_u: (Uw) (100 + 1)}
+a = (U8) { 1, 2 }
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index f68d7b9..60cbde4 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -414,11 +414,10 @@ sw buf_parse_brackets (s_buf *buf, s_call *dest)
   sw r;
   sw result = 0;
   s_buf_save save;
-  s_call tmp;
+  s_call tmp = {0};
   assert(buf);
   assert(dest);
   buf_save_init(buf, &save);
-  call_init(&tmp);
   tmp.arguments = list_new(list_new(NULL));
   arg_addr = &(list_next(tmp.arguments)->tag);
   if ((r = buf_parse_tag_primary(buf, &tmp.arguments->tag)) <= 0)
diff --git a/libc3/call.c b/libc3/call.c
index 842fc13..7ed5948 100644
--- a/libc3/call.c
+++ b/libc3/call.c
@@ -236,28 +236,34 @@ s_call * call_init_1 (s_call *call, const s8 *p)
   return call;
 }
 
-s_call * call_init_cast (s_call *call, const s_sym *type,
-                         const s_tag *tag)
+s_call * call_init_cast (s_call *call, const s_tag *tag)
 {
-  s_call tmp = {0};
-  assert(call);
-  assert(type);
-  assert(sym_is_module(type));
-  assert(tag);
-  ident_init(&tmp.ident, type, sym_1("cast"));
-  tmp.arguments = list_new_copy(tag, NULL);
-  *call = tmp;
-  return call;
+  switch (tag->type) {
+  case TAG_CALL:
+    return call_init_copy(call, &tag->data.call);
+  default:
+    break;
+  }
+  err_write_1("call_init_cast: cannot cast ");
+  err_write_1(tag_type_to_string(tag->type));
+  err_puts(" to Call");
+  assert(! "call_init_cast: cannot cast to Call");
+  return NULL;
 }
 
 s_call * call_init_copy (s_call *call, const s_call *src)
 {
+  s_call tmp = {0};
   assert(src);
   assert(call);
-  ident_init_copy(&call->ident, &src->ident);
-  list_init_copy(&call->arguments, (const s_list **) &src->arguments);
-  call->cfn = src->cfn;
-  call->fn = src->fn;
+  if (! ident_init_copy(&tmp.ident, &src->ident) ||
+      ! list_init_copy(&tmp.arguments,
+                       (const s_list * const *) &src->arguments))
+    return NULL;
+  // TODO: copy cfn and fn ?
+  tmp.cfn = src->cfn;
+  tmp.fn = src->fn;
+  *call = tmp;
   return call;
 }
 
diff --git a/libc3/call.h b/libc3/call.h
index fb44aad..ddd91aa 100644
--- a/libc3/call.h
+++ b/libc3/call.h
@@ -19,8 +19,7 @@
 void     call_clean (s_call *call);
 s_call * call_init (s_call *call);
 s_call * call_init_1 (s_call *call, const s8 *p);
-s_call * call_init_cast (s_call *call, const s_sym *type,
-                         const s_tag *tag);
+s_call * call_init_cast (s_call *call, const s_tag *tag);
 s_call * call_init_copy (s_call *call, const s_call *src);
 s_call * call_init_op (s_call *call);
 s_call * call_init_op_unary (s_call *call);
diff --git a/libc3/env.c b/libc3/env.c
index 91abb54..b2b8b3b 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -10,7 +10,7 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <libgen.h>
 #include <stdio.h>
@@ -167,6 +167,9 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   assert(env);
   assert(call);
   assert(dest);
+  (void) call;
+  io_inspect_call(call);
+  io_write_1("\n");
   call_init_copy(&c, call);
   env_eval_call_resolve(env, &c);
   if (c.cfn)
diff --git a/libc3/io.c b/libc3/io.c
index cab65fa..a811045 100644
--- a/libc3/io.c
+++ b/libc3/io.c
@@ -105,6 +105,7 @@ sw io_write_1 (const s8 *x)
 }
 
 DEF_ERR_IO_INSPECT(array,      const s_array *)
+DEF_ERR_IO_INSPECT(call,       const s_call *)
 DEF_ERR_IO_INSPECT(fact,       const s_fact *)
 DEF_ERR_IO_INSPECT(fn_pattern, const s_list *)
 DEF_ERR_IO_INSPECT(list,       const s_list **)
diff --git a/libc3/list.c b/libc3/list.c
index 9484c87..ce81976 100644
--- a/libc3/list.c
+++ b/libc3/list.c
@@ -96,24 +96,31 @@ s_list ** list_init_copy (s_list **list, const s_list * const *src)
   s_list **i;
   s_list *next;
   const s_list *s;
+  s_list *tmp;
   assert(src);
   assert(list);
-  i = list;
+  i = &tmp;
   *i = NULL;
   s = *src;
   while (s) {
     *i = list_new(NULL);
-    tag_init_copy(&(*i)->tag, &s->tag);
+    if (! tag_init_copy(&(*i)->tag, &s->tag))
+      goto ko;
     if ((next = list_next(s))) {
       s = next;
       i = &(*i)->next.data.list;
     }
     else {
-      tag_init_copy(&(*i)->next, &s->next);
+      if (! tag_init_copy(&(*i)->next, &s->next))
+        goto ko;
       break;
     }
   }
+  *list = tmp;
   return list;
+ ko:
+  list_delete_all(tmp);
+  return NULL;
 }
 
 s_list * list_init_copy_tag (s_list *list, const s_tag *tag, s_list *next)
@@ -265,25 +272,32 @@ s_list * list_new_str_1 (s8 *x_free, const s8 *x, s_list *next)
 }
 */
 
-s_array * list_to_array (s_list *list, const s_sym *type,
+s_array * list_to_array (const s_list *list, const s_sym *type,
                          s_array *dest)
 {
   f_clean clean;
   s8 *data;
-  void *data_list;
+  const void *data_list;
   f_init_copy init_copy;
-  s_list *l;
+  const s_list *l;
   uw len;
   uw size;
   s_array tmp = {0};
   assert(list);
+  assert(type);
   assert(dest);
   len = list_length(list);
   if (! sym_type_size(type, &size))
     return NULL;
+  if (! size) {
+    err_puts("list_to_array: zero item size");
+    assert(! "list_to_array: zero item size");
+    return NULL;
+  }
   tmp.dimension = 1;
   tmp.type = type;
-  if (! (tmp.dimensions = calloc(1, sizeof(s_array_dimension)))) {
+  tmp.dimensions = calloc(1, sizeof(s_array_dimension));
+  if (! tmp.dimensions) {
     err_puts("list_to_array: out of memory: 1");
     assert(! "list_to_array: out of memory: 1");
     return NULL;
@@ -292,7 +306,7 @@ s_array * list_to_array (s_list *list, const s_sym *type,
   tmp.dimensions[0].count = len;
   tmp.dimensions[0].item_size = size;
   tmp.size = len * size;
-  tmp.data = data = calloc(len, size);
+  tmp.data = calloc(len, size);
   if (! tmp.data) {
     err_puts("list_to_array: out of memory: 2");
     assert(! "list_to_array: out of memory: 2");
@@ -304,12 +318,19 @@ s_array * list_to_array (s_list *list, const s_sym *type,
     free(tmp.dimensions);
     return NULL;
   }
+  data = tmp.data;
   l = list;
   while (l) {
-    if (! tag_to_pointer(&l->tag, type, &data_list) ||
-        ! data_list ||
-        ! init_copy(data, data_list))
+    if (! tag_to_const_pointer(&l->tag, type, &data_list))
       goto ko;
+    if (data_list) {
+      if (init_copy) {
+        if (! init_copy(data, data_list))
+          goto ko;
+      }
+      else
+        memcpy(data, data_list, size);
+    }
     data += size;
     l = list_next(l);
   }
diff --git a/libc3/list.h b/libc3/list.h
index e295843..0276b3b 100644
--- a/libc3/list.h
+++ b/libc3/list.h
@@ -50,7 +50,7 @@ s_list ** list_cast (const s_tag *tag, s_list **list);
 bool      list_is_plist (const s_list *list);
 sw        list_length (const s_list *list);
 s_list  * list_next (const s_list *list);
-s_array * list_to_array (s_list *list, const s_sym *type,
+s_array * list_to_array (const s_list *list, const s_sym *type,
                          s_array *dest);
 s_tuple * list_to_tuple_reverse (const s_list *list, s_tuple *dest);
 s_str   * list_inspect (const s_list *list, s_str *dest);
diff --git a/libc3/u.c.in b/libc3/u.c.in
index 406e020..c18bc68 100644
--- a/libc3/u.c.in
+++ b/libc3/u.c.in
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=_BITS$ bits=_bits$ */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>
diff --git a/libc3/u16.c b/libc3/u16.c
index 393bff0..b439da4 100644
--- a/libc3/u16.c
+++ b/libc3/u16.c
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=16 bits=16 */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>
diff --git a/libc3/u32.c b/libc3/u32.c
index 1b79bba..8e7b6dd 100644
--- a/libc3/u32.c
+++ b/libc3/u32.c
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=32 bits=32 */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>
diff --git a/libc3/u64.c b/libc3/u64.c
index cbfd63d..a8b6c6e 100644
--- a/libc3/u64.c
+++ b/libc3/u64.c
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=64 bits=64 */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>
diff --git a/libc3/u8.c b/libc3/u8.c
index 14ddeac..b18aeef 100644
--- a/libc3/u8.c
+++ b/libc3/u8.c
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=8 bits=8 */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>
diff --git a/libc3/uw.c b/libc3/uw.c
index 08537ec..7a0e4a2 100644
--- a/libc3/uw.c
+++ b/libc3/uw.c
@@ -11,7 +11,7 @@
  * THIS SOFTWARE.
  */
 /* Gen from u.h.in BITS=W bits=w */
-#include <assert.h>
+#include "assert.h"
 #include <err.h>
 #include <math.h>
 #include <stdlib.h>