2013-01-09 Tobias Burnus <burnus@net-b.de>

        PR fortran/55758
        * resolve.c (resolve_symbol): Reject non-C_Bool logicals
        in BIND(C) procedures with -std=f*.

2013-01-09  Tobias Burnus  <burnus@net-b.de>

        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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6d1b2c6..d8c5448 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-01-09  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/55758
+       * resolve.c (resolve_symbol): Reject non-C_Bool logicals
+       in BIND(C) procedures with -std=f*.
+
 2013-01-08  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/55618

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 99c1996..e05dfd3 100644 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-01-09  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/55758
+       * gfortran.dg/bind_c_bool_1.f90: New.
+       * gfortran.dg/do_5.f90: Add dg-warning.
+
 2013-01-09  Jan Hubicka  <jh@suse.cz>
 
        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 (file)
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 (file)
--- 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