diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5700f0fbddd..8c8c679549a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-08-24 Tobias Burnus + + PR fortran/37201 + * decl.c (verify_bind_c_sym): Reject array/string returning + functions. + 2008-08-24 Tobias Burnus PR fortran/37201 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 7ccee8b76a4..406b5af345d 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 7c63b60d118..0a06a36c24c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-08-24 Tobias Burnus + + PR fortran/37201 + * gfortran.dg/bind_c_18.f90: New. + 2008-08-24 Jan Hubicka * 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 00000000000..6360f01aacc --- /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