From 21a772278801d5143e385999c692da9457db5552 Mon Sep 17 00:00:00 2001 From: "Christopher D. Rickett" Date: Sat, 21 Jul 2007 20:31:17 +0000 Subject: [PATCH] re PR fortran/32801 (USE of ISO_C_BINDING, ONLY: C_LOC causes compiler seg fault) 2007-07-21 Christopher D. Rickett PR fortran/32801 * symbol.c (generate_isocbinding_symbol): Remove unnecessary conditional. PR fortran/32804 * resolve.c (gfc_iso_c_func_interface): Reject assumed-shape and deferred-shape arrays as args to C_LOC. Fix bug in testing character args to C_LOC. 2007-07-21 Christopher D. Rickett PR fortran/32804 * gfortran.dg/c_loc_tests_9.f03: New test case. * gfortran.dg/c_loc_tests_10.f03: Ditto. From-SVN: r126812 --- gcc/fortran/ChangeLog | 11 ++++ gcc/fortran/resolve.c | 60 +++++++++++++++----- gcc/fortran/symbol.c | 8 +-- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 | 8 +++ gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 | 10 ++++ 6 files changed, 85 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 create mode 100644 gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 575e1e947f3..87e5c6afa97 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2007-07-21 Christopher D. Rickett + + PR fortran/32801 + * symbol.c (generate_isocbinding_symbol): Remove unnecessary + conditional. + + PR fortran/32804 + * resolve.c (gfc_iso_c_func_interface): Reject assumed-shape and + deferred-shape arrays as args to C_LOC. Fix bug in testing + character args to C_LOC. + 2007-07-21 Lee Millward PR fortran/32823 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d335f36d955..f50da8c95d8 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1806,19 +1806,53 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, } } else - { + { + /* A non-allocatable target variable with C + interoperable type and type parameters must be + interoperable. */ + if (args_sym && args_sym->attr.dimension) + { + if (args_sym->as->type == AS_ASSUMED_SHAPE) + { + gfc_error ("Assumed-shape array '%s' at %L " + "cannot be an argument to the " + "procedure '%s' because " + "it is not C interoperable", + args_sym->name, + &(args->expr->where), sym->name); + retval = FAILURE; + } + else if (args_sym->as->type == AS_DEFERRED) + { + gfc_error ("Deferred-shape array '%s' at %L " + "cannot be an argument to the " + "procedure '%s' because " + "it is not C interoperable", + args_sym->name, + &(args->expr->where), sym->name); + retval = FAILURE; + } + } + /* Make sure it's not a character string. Arrays of any type should be ok if the variable is of a C interoperable type. */ - if (args_sym->ts.type == BT_CHARACTER - && is_scalar_expr_ptr (args->expr) != SUCCESS) - { - gfc_error_now ("CHARACTER argument '%s' to '%s' at " - "%L must have a length of 1", - args_sym->name, sym->name, - &(args->expr->where)); - retval = FAILURE; - } + if (args_sym->ts.type == BT_CHARACTER) + if (args_sym->ts.cl != NULL + && (args_sym->ts.cl->length == NULL + || args_sym->ts.cl->length->expr_type + != EXPR_CONSTANT + || mpz_cmp_si + (args_sym->ts.cl->length->value.integer, 1) + != 0) + && is_scalar_expr_ptr (args->expr) != SUCCESS) + { + gfc_error_now ("CHARACTER argument '%s' to '%s' " + "at %L must have a length of 1", + args_sym->name, sym->name, + &(args->expr->where)); + retval = FAILURE; + } } } else if (args_sym->attr.pointer == 1 @@ -1848,10 +1882,10 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, retval = FAILURE; } else if (args_sym->ts.type == BT_CHARACTER - && args_sym->ts.cl != NULL) + && is_scalar_expr_ptr (args->expr) != SUCCESS) { - gfc_error_now ("CHARACTER parameter '%s' to '%s' at %L " - "cannot have a length type parameter", + gfc_error_now ("CHARACTER argument '%s' to '%s' at " + "%L must have a length of 1", args_sym->name, sym->name, &(args->expr->where)); retval = FAILURE; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 30afd4bf0f2..f8ca9b31df5 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3765,11 +3765,9 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, /* Create the necessary derived type so we can continue processing the file. */ generate_isocbinding_symbol - (mod_name, s == ISOCBINDING_FUNLOC - || s == ISOCBINDING_F_PROCPOINTER - ? ISOCBINDING_FUNPTR : ISOCBINDING_PTR, - (char *)(s == ISOCBINDING_FUNLOC - || s == ISOCBINDING_F_PROCPOINTER + (mod_name, s == ISOCBINDING_FUNLOC + ? ISOCBINDING_FUNPTR : ISOCBINDING_PTR, + (char *)(s == ISOCBINDING_FUNLOC ? "_gfortran_iso_c_binding_c_funptr" : "_gfortran_iso_c_binding_c_ptr")); tmp_sym->ts.derived = diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d4816ec5f89..b94b0e5cfed 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-07-19 Christopher D. Rickett + + PR fortran/32804 + * gfortran.dg/c_loc_tests_9.f03: New test case. + * gfortran.dg/c_loc_tests_10.f03: Ditto. + 2007-07-21 Lee Millward PR fortran/32823 diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 new file mode 100644 index 00000000000..867ba18cc6c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 @@ -0,0 +1,8 @@ +! { dg-do compile } +subroutine aaa(in) + use iso_c_binding + implicit none + integer(KIND=C_int), DIMENSION(:), TARGET :: in + type(c_ptr) :: cptr + cptr = c_loc(in) ! { dg-error "not C interoperable" } +end subroutine aaa diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 new file mode 100644 index 00000000000..fa3238139a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 @@ -0,0 +1,10 @@ +! { dg-do compile } +subroutine aaa(in) + use iso_c_binding + implicit none + CHARACTER(KIND=C_CHAR), DIMENSION(*), TARGET :: in + type(c_ptr) :: cptr + cptr = c_loc(in) +end subroutine aaa + + -- 2.30.2