diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index c6927ad8..2c96e0d7 100755 --- 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 baa98b55..f88946cd 100644 --- 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 " ") - (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 index 00000000..97c4dca9 --- /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 + * + * 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 . + */ + +#include + +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; +}