From d0841b5b27a0e5fcd15ca6361dcb19e9c659640a Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 9 Jan 2013 17:20:33 +0100 Subject: [PATCH] re PR fortran/55758 (LOGICAL and BIND(C): Reject kind=2/4/8/16 with -std=f2008, improve warning, switch to nonBOOLEAN_TYPE for those) 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. From-SVN: r195055 --- 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 6d1b2c68b104..d8c54488371d 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 99c1996d9a2a..e05dfd30fbf2 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 74d7ea46d404..bbb51fbbea08 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 000000000000..467bdc1b28ab --- /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 08cd8e6644b4..f7cec363e834 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