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

4 files changed, 50 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5700f0fb..8c8c679 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,12 @@
 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
 	* trans-expr.c (gfc_conv_function_call): Add string_length
 	for character-returning bind(C) functions.
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7ccee8b..406b5af 100644
--- 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 7c63b60..0a06a36 100644
--- 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
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