From 3bbb71baceae7654a0d58fe9475d95f60022303b Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 9 Jan 2013 16:20:33 +0000 Subject: [PATCH] 2013-01-09 Tobias Burnus PR fortran/55758 * resolve.c (resolve_symbol): Reject non-C_Bool logicals in BIND(C) procedures with -std=f*. 2013-01-09 Tobias Burnus PR fortran/55758 * gfortran.dg/bind_c_bool_1.f90: New. * gfortran.dg/do_5.f90: Add dg-warning. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195055 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 26 ++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 | 25 +++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/do_5.f90 | 2 +- 5 files changed, 64 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6d1b2c6..d8c5448 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-01-09 Tobias Burnus + + PR fortran/55758 + * resolve.c (resolve_symbol): Reject non-C_Bool logicals + in BIND(C) procedures with -std=f*. + 2013-01-08 Paul Thomas PR fortran/55618 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 99c1996..e05dfd3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13671,6 +13671,32 @@ resolve_symbol (gfc_symbol *sym) return; } + if (sym->ts.type == BT_LOGICAL + && ((sym->attr.function && sym->attr.is_bind_c && sym->result == sym) + || ((sym->attr.dummy || sym->attr.result) && sym->ns->proc_name + && sym->ns->proc_name->attr.is_bind_c))) + { + int i; + for (i = 0; gfc_logical_kinds[i].kind; i++) + if (gfc_logical_kinds[i].kind == sym->ts.kind) + break; + if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy + && gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument '%s' at %L " + "with non-C_Bool kind in BIND(C) procedure '%s'", + sym->name, &sym->declared_at, + sym->ns->proc_name->name) == FAILURE) + return; + else if (!gfc_logical_kinds[i].c_bool + && gfc_notify_std (GFC_STD_GNU, "LOGICAL result variable '%s' at" + " %L with non-C_Bool kind in BIND(C) " + "procedure '%s'", sym->name, + &sym->declared_at, + sym->attr.function ? sym->name + : sym->ns->proc_name->name) + == FAILURE) + return; + } + switch (sym->attr.flavor) { case FL_VARIABLE: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 74d7ea4..bbb51fb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2013-01-09 Tobias Burnus + + PR fortran/55758 + * gfortran.dg/bind_c_bool_1.f90: New. + * gfortran.dg/do_5.f90: Add dg-warning. + 2013-01-09 Jan Hubicka PR tree-optimiation/55875 diff --git a/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 b/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 new file mode 100644 index 0000000..467bdc1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! PR fortran/55758 +! + +function sub2() bind(C) ! { dg-error "GNU Extension: LOGICAL result variable 'sub2' at .1. with non-C_Bool kind in BIND.C. procedure 'sub2'" } + logical(kind=8) :: sub2 + logical(kind=4) :: local ! OK +end function sub2 + +function sub4() bind(C) result(res) ! { dg-error "GNU Extension: LOGICAL result variable 'res' at .1. with non-C_Bool kind in BIND.C. procedure 'sub4'" } + logical(kind=2) :: res + logical(kind=4) :: local ! OK +end function sub4 + + +subroutine sub(x) bind(C) ! { dg-error "GNU Extension: LOGICAL dummy argument 'x' at .1. with non-C_Bool kind in BIND.C. procedure 'sub'" } + logical(kind=4) :: x +end subroutine sub + +subroutine sub3(y) bind(C) + use iso_c_binding, only : c_bool + logical(kind=c_bool) :: y ! OK +end subroutine sub3 diff --git a/gcc/testsuite/gfortran.dg/do_5.f90 b/gcc/testsuite/gfortran.dg/do_5.f90 index 08cd8e6..f7cec36 100644 --- a/gcc/testsuite/gfortran.dg/do_5.f90 +++ b/gcc/testsuite/gfortran.dg/do_5.f90 @@ -15,7 +15,7 @@ L = .FALSE. END FUNCTION - LOGICAL(8) FUNCTION L2() BIND(C) + LOGICAL(8) FUNCTION L2() BIND(C) ! { dg-warning "GNU Extension: LOGICAL result variable 'l2' at .1. with non-C_Bool kind in BIND.C. procedure 'l2'" } L2 = .FALSE._8 END FUNCTION -- 2.7.4