From 8327f9c2da69615df75f9748308d6fdb38149cea Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 24 Aug 2008 22:31:09 +0200 Subject: [PATCH] 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/ChangeLog | 6 ++++++ gcc/fortran/decl.c | 35 +++++++++++++++++++-------------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/bind_c_18.f90 | 19 ++++++++++++++++++ 4 files changed, 50 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_18.f90 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 PR fortran/37201 + * decl.c (verify_bind_c_sym): Reject array/string returning + functions. + +2008-08-24 Tobias Burnus + + 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 + + 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 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 -- 2.7.4