mescc: Support functions in expression.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 4 May 2018 11:58:27 +0000 (13:58 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 4 May 2018 11:58:27 +0000 (13:58 +0200)
* module/language/c99/info.scm (<function>): New type.
* module/language/c99/compiler.mes (ast->type): Support function.
  (expr->type-size): Likewise.
  (expr->type): Likewise.
  (expr->accu*): Likewise.
  (function->info): Create <function>.
* module/mes/M1.mes (object->M1): Grok <function>.
* scaffold/tests/47-function-expression.c: Test it.
* build-aux/check-mescc.sh: Add it.

build-aux/check-mescc.sh
module/language/c99/compiler.mes
module/language/c99/info.scm
module/mes/M1.mes
scaffold/tests/47-function-expression.c [new file with mode: 0644]
scaffold/tests/48-function-destruct.c [new file with mode: 0644]

index 6aff3e44ad7118d37931b9c122dac372316b73a8..be84b9cfb55e7b5610f886fd3d5baf4f46c08fce 100755 (executable)
@@ -73,6 +73,8 @@ t
 44-switch
 45-void-call
 46-function-static
+47-function-expression
+48-function-destruct
 50-assert
 51-strcmp
 52-itoa
index d492194dded90c73a1bc4ae8b2494e4a89ad29a4..23a8b95ffbf5095a0345744e2456ac24f8cdf3e0 100644 (file)
@@ -59,6 +59,9 @@
 
 (define mes? (pair? (current-module)))
 
+(define %int-size 4)
+(define %pointer-size %int-size)
+
 (define* (c99-input->full-ast #:key (defines '()) (includes '()))
   (let ((sys-include (if (equal? %prefix "") "include" (string-append %prefix "/share/include"))))
     (parse-c99
     ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
     ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
     ((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
-    (_ (error ".statements: unsupported: " o))))
+    (_ (error ".statements: not supported: " o))))
 
 (define (clone o . rest)
   (cond ((info? o)
     ;; ("unsigned long long int" . ,(make-type 'builtin 8 0 #f))
     ("unsigned long long" . ,(make-type 'builtin 4 0 #f)) ;; FIXME
     ("unsigned long long int" . ,(make-type 'builtin 4 0 #f))
-    ))
+
+    ("float" . ,(make-type 'builtin 4 0 #f))
+    ("double" . ,(make-type 'builtin 8 0 #f))
+    ("long double" . ,(make-type 'builtin 16 0 #f))))
 
 (define (field:name o)
   (pmatch o
     ((,name ,type ,size ,pointer) type)
     (_ (error (format #f "field:type: ~s\n" o)))))
 
-(define (get-type types o)
-  (let ((t (assoc-ref types o)))
+(define (get-type info o)
+  (let ((t (assoc-ref (.types info) o)))
     (pmatch t
-      ((typedef ,next) (get-type types next))
+      ((typedef ,next) (or (get-type info next) o))
       (_ t))))
 
 (define (ast-type->type info o)
-  (pmatch o
-    ((p-expr ,expr) (ast-type->type info (expr->type info o)))
-    ((pre-inc ,expr) (ast-type->type info expr))
-    ((post-inc ,expr) (ast-type->type info expr))
-    ((decl-spec-list ,type-spec)
-     (ast-type->type info type-spec))
-    ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
-     (ast-type->type info type))
-    ((array-ref ,index (p-expr (ident ,array)))
-     (ast-type->type info `(p-expr (ident ,array))))
-    ((struct-ref (ident ,type))
-     (or (get-type (.types info) type)
-         (let ((struct (if (pair? type) type `("tag" ,type))))
-           (ast-type->type info struct))))
-    ((union-ref (ident ,type))
-     (or (get-type (.types info) type)
-         (let ((struct (if (pair? type) type `("tag" ,type))))
-           (ast-type->type info struct))))
-    ((void) (ast-type->type info "void"))
-    ((type-spec ,type) (ast-type->type info type))
-    ((fixed-type ,type) (ast-type->type info type))
-    ((typename ,type) (ast-type->type info type))
-    ((de-ref ,expr)
-     (ast-type->type info expr))
-    ((d-sel (idend ,field) ,struct)
-     (let ((type0 (ast-type->type info struct)))
-       (field-type info type0 field)))
-    ((i-sel (ident ,field) ,struct)
-     (let ((type0 (ast-type->type info struct)))
-       (field-type info type0 field)))
-    (_ (let ((type (get-type (.types info) o)))
-         (if type type
-             (begin
-               (stderr "types: ~s\n" (.types info))
-               (error "ast-type->type: unsupported: " o)))))))
+  (if (type? o) o
+      (pmatch o
+        ((p-expr ,expr) (ast-type->type info (expr->type info o)))
+        ((pre-inc ,expr) (ast-type->type info expr))
+        ((post-inc ,expr) (ast-type->type info expr))
+        ((decl-spec-list ,type-spec)
+         (ast-type->type info type-spec))
+        ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
+         (ast-type->type info type))
+        ((array-ref ,index (p-expr (ident ,array)))
+         (ast-type->type info `(p-expr (ident ,array))))
+        ((struct-ref (ident ,type))
+         (or (get-type info type)
+             (let ((struct (if (pair? type) type `("tag" ,type))))
+               (ast-type->type info struct))))
+        ((union-ref (ident ,type))
+         (or (get-type info type)
+             (let ((struct (if (pair? type) type `("tag" ,type))))
+               (ast-type->type info struct))))
+        ((void) (ast-type->type info "void"))
+        ((type-spec ,type) (ast-type->type info type))
+        ((fixed-type ,type) (ast-type->type info type))
+        ((float-type ,type) (ast-type->type info type))
+        ((typename ,type) (ast-type->type info type))
+        ((de-ref ,expr)
+         (ast-type->type info expr))
+        ((d-sel (idend ,field) ,struct)
+         (let ((type0 (ast-type->type info struct)))
+           (field-type info type0 field)))
+        ((i-sel (ident ,field) ,struct)
+         (let ((type0 (ast-type->type info struct)))
+           (field-type info type0 field)))
+        (_ (let ((type (get-type info o)))
+             (if type type
+                 (begin
+                   (stderr "types: ~s\n" (.types info))
+                   (error "ast-type->type: not supported: " o))))))))
 
 (define (ast-type->description info o)
   (let* ((type (ast-type->type info o))
      type)
     ((struct-ref (ident ,type))
      `("tag" ,type))
-    (_ (stderr "SKIP: type=~s\n" o)
+    (_ (stderr "SKIP: .type=~s\n" o)
        "int")))
 
 (define (decl->ast-type o)
      `("tag" ,name)) ;; FIXME
     ((typename ,name) name)
     (,name name)
-    (_ (error "decl->ast-type: unsupported: " o))))
+    (_ (error "decl->ast-type: not supported: " o))))
 
 (define (byte->hex.m1 o)
   (string-drop o 2))
     ((array-ref ,index ,array) (ptr-dec (expr->pointer info array)))
 
     ((d-sel (ident ,field) ,struct)
-       (let ((type (expr->type info struct)))
-         (field-pointer info type field)))
+     (let ((type (expr->type info struct)))
+       (field-pointer info type field)))
 
     ((i-sel (ident ,field) ,struct)
-       (let ((type (expr->type info struct)))
-         (field-pointer info type field)))
+     (let ((type (expr->type info struct)))
+       (field-pointer info type field)))
 
     ((cast (type-name ,type) ,expr)     ; FIXME: add expr?
      (let* ((type (ast-type->type info type))
             (pointer1 (ptr-declr->pointer pointer))
             (pointer2 (expr->pointer info expr)))
        (+ pointer0 pointer1)))
-    (_ (stderr "expr->pointer: unsupported: ~s\n" o) 0)))
-
-(define %int-size 4)
-(define %pointer-size %int-size)
+    ((type-spec ,type)
+     (or (and=> (ast-type->type info o) type:pointer)
+         (begin
+           (stderr "expr->pointer: not supported: ~a\n" o)
+           0)))
+    ((fctn-call (p-expr (ident ,function)) . ,rest)
+     (or (and=> (and=> (assoc-ref (.functions info) function) function:type)
+                (lambda (t)
+                  (and (type? t) (type:pointer t))))
+         (begin
+           (stderr "expr->pointer: no such function: ~a\n" function)
+           0)))
+    (_ (stderr "expr->pointer: not supported: ~s\n" o) 0)))
 
 (define (expr->type-size info o)
   (pmatch o
     ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
      (let ((type (ast-type->type info type)))
        (type:size type)))
-    (_ (stderr "expr->type-size: unsupported: ~s\n" o) 4)))
+    ((fctn-call (p-expr (ident ,function)) . ,rest)
+     (or (and=> (and=> (assoc-ref (.functions info) function) function:type)
+                (lambda (t)
+                  (and (type? t) (type:size t))))
+         (begin
+           (stderr "expr->type-size: no such function: ~a\n" function)
+           4)))
+    (_ (stderr "expr->type-size: not supported: ~s\n" o) 4)))
 
 (define (expr->size info o)
   (let ((ptr (expr->pointer info o)))
      type)
     ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
      type)
-    ((fctn-call (p-expr (ident ,name)))
-     (stderr "TODO: expr->type: unsupported: ~s\n" o)
-     "int")
-    (_ ;;(error (format #f "expr->type: unsupported: ~s") o)
-     (stderr "TODO: expr->type: unsupported: ~s\n" o)
+    ((fctn-call (p-expr (ident ,function)) . ,rest)
+     (or (and=> (assoc-ref (.functions info) function) function:type)
+         (begin
+           (stderr "expr->type: no such function: ~s\n" function)
+           "int")))
+    (_ ;;(error (format #f "expr->type: not supported: ~s") o)
+     (stderr "TODO: expr->type: not supported: ~s\n" o)
      "int")))
 
 (define (append-text info text)
               (info ((expr->accu* info) struct)))
          (append-text info (wrap-as (i386:accu+value offset)))))
 
+      ((i-sel (ident ,field) (fctn-call (p-expr (ident ,function)) . ,rest))
+       (let* ((type (expr->type info `(fctn-call (p-expr (ident ,function)) ,@rest)))
+              (offset (field-offset info type field))
+              (info ((expr->accu info) `(fctn-call (p-expr (ident ,function)) ,@rest))))
+         (append-text info (wrap-as (i386:accu+value offset)))))
+
       ((i-sel (ident ,field) ,struct)
        (let* ((type (expr->type info struct))
               (offset (field-offset info type field))
               (info ((expr->base info) array)))
          (append-text info (wrap-as (i386:accu+base)))))
 
-      (_ (error "expr->accu*: unsupported: " o)))))
+      (_ (error "expr->accu*: not supported: " o)))))
 
 (define (expr->accu info)
   (lambda (o)
              (_ (let ((info ((expr->base* info) a)))
                   (accu->base-mem*n info (min size-a (max 4 size-b)))))))) ;; FIXME: long long = int
 
-        (_ (error "expr->accu: unsupported: " o))))))
+        (_ (error "expr->accu: not supported: " o))))))
 
 (define (expr->base info)
   (lambda (o)
                    ((p-expr (ident ,constant)) (assoc-ref (.constants info) constant))
                    ((p-expr (fixed ,value)) (cstring->number value))
                    ((neg (p-expr (fixed ,value))) (- (cstring->number value)))
-                   (_ (error "case test: unsupported: " test)))))
+                   (_ (error "case test: not supported: " test)))))
       (append (wrap-as (i386:accu-cmp-value value))
               (jump-z body-label))))
   (define (cases+jump info cases)
       ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
        `(union ,@(map (struct-field info) fields)))
 
-      (_ (error "struct-field: unsupported: " o)))))
+      (_ (error "struct-field: not supported: " o)))))
 
 (define (local-var? o) ;; formals < 0, locals > 0
   (positive? (local:id o)))
     ((pointer) 1)
     ((pointer (pointer)) 2)
     ((pointer (pointer (pointer))) 3)
-    (_ (error "ptr-declr->pointer unsupported: " o))))
+    (_ (error "ptr-declr->pointer not supported: " o))))
 
 (define (init-declr->name o)
   (pmatch o
     ((ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,params)) name)
     ((ptr-declr (pointer) (array-of (ident ,name))) name)
     ((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) name)
-    (_ (error "init-declr->name unsupported: " o))))
+    (_ (error "init-declr->name not supported: " o))))
 
 (define (init-declr->count info o)
   (pmatch o
     ((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) (param-list . ,params)) (ptr-declr->pointer pointer))
     ((ptr-declr (pointer) (array-of (ident ,name))) -2)
     ((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) -2)
-    (_ (error "init-declr->pointer unsupported: " o))))
+    (_ (error "init-declr->pointer not supported: " o))))
 
 (define (statements->clauses statements)
   (let loop ((statements statements) (clauses '()))
                        ((break) (loop (cdr statements) (append clauses (list `(default (compd-stmt (block-item-list ,@(append c (list s)))))))))
 
                        (_ (loop2 (cdr statements) (append c (list s)))))))))
-            (_ (error "statements->clauses: unsupported:" s)))))))
+            (_ (error "statements->clauses: not supported:" s)))))))
 
 (define (global->static function)
   (lambda (o)
           locals))
       (define (declare name)
         (if (member name functions) info
-            (clone info #:functions (cons (cons name #f) functions))))
+            (let* ((type (function->type info o))
+                   (function (make-function name type  #f)))
+              (clone info #:functions (cons (cons name function) functions)))))
+
       (pmatch o
 
         ;; FIXME: Nyacc sometimes produces extra parens: (ident (<struct-name>))
          (declare name))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (get-type types type)) types)))
+         (clone info #:types (cons (cons name (get-type info type)) types)))
 
         ;; int foo ();
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
          info)
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type types type) `(typedef ("tag" ,type)))) types)))
+         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ("tag" ,type)))) types)))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type types type) `(typedef ("tag" ,type)))) types)))
+         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ("tag" ,type)))) types)))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type types type) `(typedef ,type))) types)))
+         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ,type))) types)))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) ,value))))
-         (let* ((type (get-type types type))
+         (let* ((type (get-type info type))
                 (value (expr->number info value))
                 (size (* value 4))
                 (pointer -1)
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
          (let* ((pointer (expr->pointer info pointer))
-                (type (or (get-type types type) `(typedef ,type)))
+                (type (or (get-type info type) `(typedef ,type)))
                 (size 4)
                 (type (make-type 'typedef size pointer type)))
            (clone info #:types (cons (cons name type) types))))
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
          (let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
                 (types (.types info)))
-           (clone info #:types (cons (cons name (or (get-type types `("tag" ,type)) `(typedef ,type))) types))))
+           (clone info #:types (cons (cons name (or (get-type info `("tag" ,type)) `(typedef ,type))) types))))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
          (let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
                 (types (.types info)))
-           (clone info #:types (cons (cons name (or (get-type types `("tag" ,type)) `(typedef ,type))) types))))
+           (clone info #:types (cons (cons name (or (get-type info `("tag" ,type)) `(typedef ,type))) types))))
 
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
-         (let* ((type (get-type types type))
+         (let* ((type (get-type info type))
                 (type (make-type (type:type type)
                                  (type:size type)
                                  (1+ (type:pointer type))
          (format (current-error-port) "SKIP: at=~s\n" o)
          info)
 
-        ((decl . _) (error "decl->info: unsupported: " o))))))
+        ((decl . _) (error "decl->info: not supported: " o))))))
 
 (define (ast->info info)
   (lambda (o)
       (() (int->bv32 0))
       ((initzer ,p-expr)
        (int->bv32 (expr->number info p-expr)))
-      (_ (error "initzer->data: unsupported: " o)))))
+      (_ (error "initzer->data: not supported: " o)))))
 
 (define (initzer->accu info)
   (lambda (o)
        (wrap-as (append (i386:function-preamble)
                         (append-map (formal->text n) formals (iota n))
                         (i386:function-locals)))))
-    (_ (error "formals->text: unsupported: " o))))
+    (_ (error "formals->text: not supported: " o))))
 
 (define (formal:ptr o)
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
        (map make-local-entry (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
-    (_ (error "formals->locals: unsupported: " o))))
+    (_ (error "formals->locals: not supported: " o))))
+
+
+(define (function->type info o)
+  (pmatch o
+    ((fctn-defn (decl-spec-list (type-spec ,type)) (ptr-declr ,pointer ,rest) ,statement)
+     (let ((type (ast-type->type info type))
+           (pointer (ptr-declr->pointer pointer)))
+       (make-type (type:type type)
+                  (type:size type)
+                  (+ (type:pointer type) pointer)
+                  (type:description type))))
+    ((decl (decl-spec-list (type-spec ,type)) (init-declr (ptr-declr ,pointer (ftn-declr . ,rest))))
+     (let ((type (ast-type->type info type))
+           (pointer (ptr-declr->pointer pointer)))
+       (make-type (type:type type)
+                  (type:size type)
+                  (+ (type:pointer type) pointer)
+                  (type:description type))))
+    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer (ftn-declr . ,rest)))))
+     (ast-type->type info type))
+    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ftn-declr . ,rest))))
+     (ast-type->type info type))
+    ((decl (decl-spec-list (stor-spec ,store) (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer (ftn-declr . ,rest)))))
+     (ast-type->type info type))
+    ((decl (decl-spec-list (stor-spec ,store) (type-spec ,type)) (init-declr-list (init-declr (ftn-declr . ,rest))))
+     (ast-type->type info type))
+    ((fctn-defn (decl-spec-list (stor-spec . ,store) (type-spec ,type)) (ptr-declr ,pointer (ftn-declr . ,rest)) ,statement)
+     (ast-type->type info type))
+    ((fctn-defn (decl-spec-list (stor-spec . ,store) (type-spec ,type)) . ,rest)
+     (ast-type->type info type))
+    ((decl (decl-spec-list (type-spec ,type)) (init-declr (ftn-declr . ,rest)))
+     (ast-type->type info type))
+    ((fctn-defn (decl-spec-list (type-spec ,type)) . ,rest)
+     (ast-type->type info type))
+    (_ (stderr "TODO: function->type: not supported: ~s\n" o)
+       (get-type info "info"))))
 
 (define (function->info info)
   (lambda (o)
         (if (equal? (list-tail text (- (length text) (length return))) return) text
             (append text return))))
     (let* ((name (.name o))
+           (type (function->type info o))
            (formals (.formals o))
            (text (formals->text formals))
            (locals (formals->locals formals)))
                                         #:function #f
                                         #:globals (append (.statics info) (.globals info))
                                         #:statics '()
-                                        #:functions (append (.functions info) (list (cons name (assert-return (.text info)))))))
+                                        #:functions (append (.functions info) (list (cons name (make-function name type (assert-return (.text info))))))))
             (let* ((statement (car statements)))
               (loop (cdr statements)
                     ((ast->info info) (car statements)))))))))
 
 (define* (info->object o)
   (stderr "compiling: object\n")
-  `((functions . ,(.functions o))
+  `((functions . ,(filter (compose function:text cdr) (.functions o)))
     (globals . ,(.globals o))))
 
 (define* (c99-input->elf #:key (defines '()) (includes '()))
index e593037105f2bb1972763ed307cd6b4638ab6077..de6c62aecba4371edc40196c5576d478a87165c1 100644 (file)
@@ -43,6 +43,7 @@
             .break
             .continue
 
+            <type>
             make-type
             type?
             type:type
@@ -50,6 +51,7 @@
             type:pointer
             type:description
 
+            <global>
             make-global
             global?
             global:name
             global:function
             global->string
 
+            <local>
             make-local
             local?
             local:type
             local:pointer
-            local:id))
+            local:id
+
+            <function>
+            make-function
+            function?
+            function:name
+            function:type
+            function:text))
 
 (cond-expand
  (guile-2)
   (type local:type)
   (pointer local:pointer)
   (id local:id))
+
+(define-immutable-record-type <function>
+  (make-function name type text)
+  function?
+  (name function:name)
+  (type function:type)
+  (text function:text))
index b6d8085393778519de7c8cc9c06f327682b139bd..8871ef13341525f02f4f0312b1067216b92629d5 100644 (file)
        ((pair? o) (string-join (map text->M1 o)))))
     (define (write-function o)
       (let ((name (car o))
-            (text (cdr o)))
+            (text (function:text (cdr o))))
         (define (line->M1 o)
           (cond ((eq? (car o) #:label)
                  (display (string-append ":" (cadr o))))
diff --git a/scaffold/tests/47-function-expression.c b/scaffold/tests/47-function-expression.c
new file mode 100644 (file)
index 0000000..89d1bd0
--- /dev/null
@@ -0,0 +1,33 @@
+/* -*-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/>.
+ */
+
+int g_time = 1;
+
+int*
+time ()
+{
+  return &g_time;
+}
+
+int
+main ()
+{
+  return *time () - 1;
+}
diff --git a/scaffold/tests/48-function-destruct.c b/scaffold/tests/48-function-destruct.c
new file mode 100644 (file)
index 0000000..6e17169
--- /dev/null
@@ -0,0 +1,38 @@
+/* -*-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/>.
+ */
+
+struct foo
+{
+  int bar;
+};
+
+struct foo*
+test (struct foo* f)
+{
+  return f;
+}
+
+int
+main ()
+{
+  struct foo f = {1};
+  int i = test (&f)->bar;
+  return test (&f)->bar - i;
+}