mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-25 16:46:02 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/37201 (ICE in in gfc_conv_string_parameter)

Browse Source 
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
This commit is contained in:
Tobias Burnus 2008-08-24 22:31:09 +02:00 committed by Tobias Burnus
parent 1d4746214c
commit 8327f9c2da
4 changed files with 49 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
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

33
gcc/fortran/decl.c
View File

@ -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

5
gcc/testsuite/ChangeLog
View File

@ -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.

19
gcc/testsuite/gfortran.dg/bind_c_18.f90 Normal file
View File

@ -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