mescc: Handle struct field lists.

* module/language/c99/compiler.mes (struct-field): Return list of
  fields.  Update callers.
* scaffold/tests/84-struct-field-list.c: Test it.
* build-aux/check-mescc.sh (tests): Add it.

diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh
index c6927ad8e029976173e72a01ec752b32df574f25..2c96e0d7f8cfdbe0812abc1ad0a172353fb87a79 100755 (executable)
--- a/build-aux/check-mescc.sh
+++ b/build-aux/check-mescc.sh
@@ -113,6 +113,7 @@ t
 81-qsort
 82-define
 83-heterogenoous-init
+84-struct-field-list
 "
 
 broken="$broken

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index baa98b55186ccce2ebf4d9f0da0b185c5e1fa398..f88946cdfdfc763b012d500ba1055b1ea5ded4ce 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -1548,58 +1548,64 @@
     (pmatch o
       ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
                   (comp-declr-list (comp-declr (ident ,name))))
-       (list name `("tag" ,type) 4 0))
+       (list (list name `("tag" ,type) 4 0)))
       ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
-       (list name type (ast-type->size info type) 0))
+       (list (list name type (ast-type->size info type) 0)))
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
-       (list name type (ast-type->size info type) 0))
+       (list (list name type (ast-type->size info type) 0)))
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-       (list name type 4 2))
+       (list (list name type 4 2)))
       ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
-       (list name type 4 1))
+       (list (list name type 4 1)))
       ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-       (list name type 4 1))
+       (list (list name type 4 1)))
       ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-       (list name type 4 2))
+       (list (list name type 4 2)))
       ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-       (list name "void" 4 2))
+       (list (list name "void" 4 2)))
       ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-       (list name "void" 4 1))
+       (list (list name "void" 4 1)))
       ((comp-decl (decl-spec-list (type-spec (void))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)))))
-       (list name "void" 4 1))
+       (list (list name "void" 4 1)))
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-       (list name type 4 1))
+       (list (list name type 4 1)))
 
       ;; FIXME: array: -1,-2-3, name??
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
        (let ((size 4)
              (count (expr->number info count)))
-         (list name type (* count size) -2)))
+         (list (list name type (* count size) -2))))
 
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
        (let ((size (ast-type->size info type))
              (count (expr->number info count)))
-         (list name type (* count size) -1)))
+         (list (list name type (* count size) -1))))
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-       (list name `("tag" ,type) 4 2))
+       (list (list name `("tag" ,type) 4 2)))
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-       (list name `("tag" ,type) 4 1))
+       (list (list name `("tag" ,type) 4 1)))
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
        (let ((size (ast-type->size info `("tag" ,type))))
-         (list name `("tag" ,type) size 0)))
+         (list (list name `("tag" ,type) size 0))))
 
       ((comp-decl (decl-spec-list (type-spec (struct-def (field-list . ,fields)))))
-       `(struct ,@(map (struct-field info) fields)))
+       (list `(struct ,@(append-map (struct-field info) fields))))
 
       ((comp-decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
        (let ((size (ast-type->size info `("tag" ,type))))
-         (list name `("tag" ,type) size 0)))
+         (list (list name `("tag" ,type) size 0))))
 
       ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
-       `(union ,@(map (struct-field info) fields)))
+       (list `(union ,@(append-map (struct-field info) fields))))
+
+      ((comp-decl (decl-spec-list ,type) (comp-declr-list . ,decls)) (guard (pair? (cdr decls)))
+       (let loop ((decls decls))
+         (if (null? decls) '()
+             (append ((struct-field info) `(comp-decl (decl-spec-list ,type) (comp-declr-list ,(car decls))))
+                     (loop (cdr decls))))))
 
       (_ (error "struct-field: not supported: " o)))))
 
@@ -1850,12 +1856,12 @@
 
         ;; struct
         ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
-         (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
+         (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
            (clone info #:types (cons type-entry types))))
 
         ;; union
         ((decl (decl-spec-list (type-spec (union-def (ident ,name) (field-list . ,fields)))))
-         (let ((type-entry (union->type-entry name (map (struct-field info) fields))))
+         (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
            (clone info #:types (cons type-entry types))))
 
         ;; enum e i;
@@ -2442,7 +2448,7 @@
   (pmatch o
     ((struct-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
-     (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
+     (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
     (_  info)))
 

diff --git a/scaffold/tests/84-struct-field-list.c b/scaffold/tests/84-struct-field-list.c
new file mode 100644 (file)
index 0000000..97c4dca
--- /dev/null
+++ b/scaffold/tests/84-struct-field-list.c
@@ -0,0 +1,58 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <string.h>
+
+struct foo
+{
+  int i;
+  int *j;
+  struct foo *bar;
+  struct foo *baz;
+};
+
+struct bar
+{
+  int i, *j;
+  struct bar *bar, *baz;
+};
+
+int
+main ()
+{
+  struct foo f = {0, 0, 0, 0};
+  struct foo g = {1, 0, 0, 0};
+  f.j = &f.i;
+  g.j = &g.i;
+  f.bar = &f;
+  f.baz = &g;
+
+  struct bar b;
+  memcpy (&b, &f, sizeof (struct foo));
+  if (b.i != 0)
+    return 1;
+  if (*b.j != 0)
+    return 2;
+  if (b.bar->i != 0)
+    return 3;
+  if (*b.baz->j != 1)
+    return 4;
+  return 0;
+}