re PR fortran/84073 (In -fc-prototypes fixed (nonzero) length strings are mapped...

2017-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/84073
	* resolve.c (resolve_component): Ensure BIND(C) character
	components have length one.
	(resolve_symbol): Likewise for variables.

2017-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/84073
	* gfortran.dg/bind_c_usage_31.f90: New test.

From-SVN: r257138

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8660530c07388a09d8f6f0b2d3a0f73667888988..96e6fb214029ad054a48fbdc9e82105fce553e45 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/84073
+       * resolve.c (resolve_component): Ensure BIND(C) character
+       components have length one.
+       (resolve_symbol): Likewise for variables.
+
 2018-01-27  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/84065

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8078005d976c043596b2cd4aa522fdadb480d12d..9c8ba868a5a09a0b846a63f059d22f0c0f075599 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13557,6 +13557,17 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
       return false;
     }
 
+  /* F2003, 15.2.1 - length has to be one.  */
+  if (sym->attr.is_bind_c && c->ts.type == BT_CHARACTER
+      && (c->ts.u.cl == NULL || c->ts.u.cl->length == NULL
+         || !gfc_is_constant_expr (c->ts.u.cl->length)
+         || mpz_cmp_si (c->ts.u.cl->length->value.integer, 1) != 0))
+    {
+      gfc_error ("Component %qs of BIND(C) type at %L must have length one",
+                c->name, &c->loc);
+      return false;
+    }
+
   if (c->attr.proc_pointer && c->ts.interface)
     {
       gfc_symbol *ifc = c->ts.interface;
@@ -14804,6 +14815,15 @@ resolve_symbol (gfc_symbol *sym)
                     "module level scope", sym->name, &(sym->declared_at));
          t = false;
        }
+      else if (sym->ts.type == BT_CHARACTER
+              && (sym->ts.u.cl == NULL || sym->ts.u.cl->length == NULL
+                  || !gfc_is_constant_expr (sym->ts.u.cl->length)
+                  || mpz_cmp_si (sym->ts.u.cl->length->value.integer, 1) != 0))
+       {
+         gfc_error ("BIND(C) Variable %qs at %L must have length one",
+                    sym->name, &sym->declared_at);
+         t = false;
+       }
       else if (sym->common_head != NULL && sym->attr.implicit_type == 0)
         {
           t = verify_com_block_vars_c_interop (sym->common_head);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9470667df305d6be858aad337702c6dbd5e0ac30..fa663f297e293f06d8dc784145742d93a8791d6f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-01-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/84073
+       * gfortran.dg/bind_c_usage_31.f90: New test.
+
 2018-01-27  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/83924

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_31.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_31.f90
new file mode 100644 (file)
index 0000000..052713e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_31.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/84073 - this was accepted before.
+module mod
+  use iso_c_binding
+  type, bind(c) :: a
+     character(len=2,kind=c_char) :: b ! { dg-error "must have length one" }
+  end type a
+  character(len=2), bind(C) :: c ! { dg-error "must have length one" }
+end module mod