artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Add 70-function-destruct-declare.c test.

Browse source 
* module/mescc/compile.scm (init-declr->info): Do not attempt to
re-calculate function type.
(ftn-declr:get-type): Remove.
* lib/tests/scaffold/70-function-destruct-declare.c: New file.
* build-aux/check-mescc.sh (TESTS): Add it.
This commit is contained in:
Jan Nieuwenhuizen 2019-07-26 19:09:12 +02:00
parent d5a0ecb3d5
commit 2197252482
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 42 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
lib/tests/scaffold/70-function-destruct-declare.c Normal file
View file

@ -0,0 +1,41 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of GNU Mes.
*
* GNU 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.
*
* GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/
struct foo
{
int bar;
};
struct foo * test (struct foo *f);
int
main ()
{
struct foo f = { 1 };
int i = test (&f)->bar;
return test (&f)->bar - i;
}
struct foo *
test (struct foo *f)
{
void (*fun) () = test;
return f;
}

8
module/mescc/compile.scm
View file

@ -2330,8 +2330,7 @@
(((ftn-declr (ident ,name) . ,_)) (((ftn-declr (ident ,name) . ,_))
(let ((functions (.functions info))) (let ((functions (.functions info)))
(if (member name functions) info (if (member name functions) info
(let* ((type (ftn-declr:get-type info `(ftn-declr (ident ,name) ,@_))) (let ((function (make-function name type #f)))
(function (make-function name type #f)))
(clone info #:functions (cons (cons name function) functions)))))) (clone info #:functions (cons (cons name function) functions))))))
(((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) ,param-list) ,init) (((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) ,param-list) ,init)
(let* ((rank (pointer->rank pointer)) (let* ((rank (pointer->rank pointer))
@ -2623,11 +2622,6 @@
(ast->type type info)) (ast->type type info))
(_ (error "fctn-defn:get-type: not supported:" o)))) (_ (error "fctn-defn:get-type: not supported:" o))))
(define (ftn-declr:get-type info o)
(pmatch o
((ftn-declr (ident _) . _) #f)
(_ (error "fctn-decrl:get-type: not supported:" o))))
(define (fctn-defn:get-statement o) (define (fctn-defn:get-statement o)
(pmatch o (pmatch o
((_ (ftn-declr (ident _) _) ,statement) statement) ((_ (ftn-declr (ident _) _) ,statement) statement)