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  <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.

From-SVN: r195055

5 files changed, 64 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6d1b2c68..d8c5448 100644
--- 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
--- 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  <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
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