Re: [Patch, Fortran] PR 37201 - fix character-returning bind(c) functions

[Tobias Burnus <tobias dot burnus at physik dot fu-berlin dot de>]

Hello Jerry, hi all,

On Sun, Aug 24, 2008 at 10:11:27AM -0700, Jerry DeLisle wrote:
> OK to commit.  Also add PR for the other situation we discussed on IRC.

I decided not to add a PR and fix it right away. The problem was that
there was no checking for

  function foo() bind(C) RESULT(res)

as  res->attr.function = 0 and res->attr.is_bind_c = 0
The current test only works if sym->result == sym.

Built and regtesting* on x86-64-linux.
OK for the trunk?

Tobias

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.

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 139537)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -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,
 	  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,
 	      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
Index: gcc/testsuite/gfortran.dg/bind_c_18.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bind_c_18.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/bind_c_18.f90	(Revision 0)
@@ -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