From 8327f9c2da69615df75f9748308d6fdb38149cea Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 24 Aug 2008 22:31:09 +0200 Subject: re PR fortran/37201 (ICE in in gfc_conv_string_parameter) 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 * gfortran.dg/bind_c_18.f90: New. From-SVN: r139545 --- gcc/fortran/decl.c | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/decl.c') 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 -- cgit v1.1