re PR fortran/37201 (ICE in in gfc_conv_string_parameter)

2008-08-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37201
        * decl.c (verify_bind_c_sym): Reject array/string returning
        functions.

2008-08-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37201
        * gfortran.dg/bind_c_18.f90: New.

From-SVN: r139545

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5700f0fbddd067125dbb85e39df0a7f2b615ab21..8c8c679549abe692bc3abc6fc91d694f4785a9b7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-24  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/37201
+       * decl.c (verify_bind_c_sym): Reject array/string returning
+       functions.
+
 2008-08-24  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/37201

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7ccee8b76a4c4c11d4df62315666b3f78b03e972..406b5af345dd8668589231e868af94e64a5d279a 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3368,8 +3368,12 @@ gfc_try
 verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
                    int is_in_common, gfc_common_head *com_block)
 {
+  bool bind_c_function = false;
   gfc_try retval = SUCCESS;
 
+  if (tmp_sym->attr.function && tmp_sym->attr.is_bind_c)
+    bind_c_function = true;
+
   if (tmp_sym->attr.function && tmp_sym->result != NULL)
     {
       tmp_sym = tmp_sym->result;
@@ -3385,7 +3389,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
          tmp_sym->attr.is_c_interop = 1;
        }
     }
-  
+
   /* Here, we know we have the bind(c) attribute, so if we have
      enough type info, then verify that it's a C interop kind.
      The info could be in the symbol already, or possibly still in
@@ -3451,22 +3455,23 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
              retval = FAILURE;
            }
 
-         /* If it is a BIND(C) function, make sure the return value is a
-            scalar value.  The previous tests in this function made sure
-            the type is interoperable.  */
-         if (tmp_sym->attr.function == 1 && tmp_sym->as != NULL)
-           gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
-                      "be an array", tmp_sym->name, &(tmp_sym->declared_at));
-
-         /* BIND(C) functions can not return a character string.  */
-         if (tmp_sym->attr.function == 1 && tmp_sym->ts.type == BT_CHARACTER)
-           if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
-               || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
-               || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
-             gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+        }
+
+      /* If it is a BIND(C) function, make sure the return value is a
+        scalar value.  The previous tests in this function made sure
+        the type is interoperable.  */
+      if (bind_c_function && tmp_sym->as != NULL)
+       gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+                  "be an array", tmp_sym->name, &(tmp_sym->declared_at));
+
+      /* BIND(C) functions can not return a character string.  */
+      if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
+       if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
+           || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
+           || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
+         gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
                         "be a character string", tmp_sym->name,
                         &(tmp_sym->declared_at));
-       }
     }
 
   /* See if the symbol has been marked as private.  If it has, make sure

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7c63b60d1185677bd98346652bd4971bedc39a17..0a06a36c24c856f9c6436eb02db651b01395ddc4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-08-24  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/37201
+       * gfortran.dg/bind_c_18.f90: New.
+
 2008-08-24  Jan Hubicka <jh@suse.cz>
 
        * gcc.dg/ipa/ipacost-1.c: New testcase.

diff --git a/gcc/testsuite/gfortran.dg/bind_c_18.f90 b/gcc/testsuite/gfortran.dg/bind_c_18.f90
new file mode 100644 (file)
index 0000000..6360f01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_18.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/37201
+!
+! Before character arrays were allowed as bind(C) return value.
+!
+implicit none
+  INTERFACE 
+    FUNCTION my() BIND(C,name="my") RESULT(r) ! { dg-error "cannot be an array" }
+      USE iso_c_binding
+      CHARACTER(kind=C_CHAR) :: r(10)
+    END FUNCTION
+  END INTERFACE
+  INTERFACE 
+    FUNCTION two() BIND(C,name="two") RESULT(r) ! { dg-error "cannot be a character string" }
+      USE iso_c_binding
+      CHARACTER(kind=C_CHAR,len=2) :: r
+    END FUNCTION
+  END INTERFACE
+END