From 1b922cfc7a3a11fd79902feb781128d9d546b484 Mon Sep 17 00:00:00 2001 From: mikael Date: Sun, 4 Jan 2009 13:01:12 +0000 Subject: [PATCH] 2009-01-04 Mikael Morin PR fortran/38536 * gfortran.h (gfc_is_data_pointer): Added prototype * resolve.c (gfc_iso_c_func_interface): Use gfc_is_data_pointer to test for pointer attribute. * dependency.c (gfc_is_data_pointer): Support pointer-returning functions. 2009-01-04 Mikael Morin PR fortran/38536 * gfortran.dg/c_loc_tests_13.f90: New test. * gfortran.dg/c_loc_tests_14.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@143050 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 ++++++ gcc/fortran/dependency.c | 8 ++++-- gcc/fortran/gfortran.h | 1 + gcc/fortran/resolve.c | 41 ++++------------------------ gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 | 16 +++++++++++ gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 | 29 ++++++++++++++++++++ 7 files changed, 72 insertions(+), 38 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 create mode 100644 gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 28fa368..e3c652c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2009-01-04 Mikael Morin + + PR fortran/38536 + * gfortran.h (gfc_is_data_pointer): Added prototype + * resolve.c (gfc_iso_c_func_interface): + Use gfc_is_data_pointer to test for pointer attribute. + * dependency.c (gfc_is_data_pointer): + Support pointer-returning functions. + 2009-01-03 Daniel Franke * symbol.c (save_symbol): Don't SAVE function results. diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 56a6d36..639d6e3 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -422,16 +422,20 @@ gfc_ref_needs_temporary_p (gfc_ref *ref) } -static int +int gfc_is_data_pointer (gfc_expr *e) { gfc_ref *ref; - if (e->expr_type != EXPR_VARIABLE) + if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION) return 0; + /* No subreference if it is a function */ + gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref); + if (e->symtree->n.sym->attr.pointer) return 1; + for (ref = e->ref; ref; ref = ref->next) if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) return 1; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c05fb88..bb2230d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2579,6 +2579,7 @@ void gfc_global_used (gfc_gsymbol *, locus *); /* dependency.c */ int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); +int gfc_is_data_pointer (gfc_expr *); /* check.c */ gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 18a81e9..27a4d99 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2047,12 +2047,10 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, { char name[GFC_MAX_SYMBOL_LEN + 1]; char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1]; - int optional_arg = 0; + int optional_arg = 0, is_pointer = 0; gfc_try retval = SUCCESS; gfc_symbol *args_sym; gfc_typespec *arg_ts; - gfc_ref *parent_ref; - gfc_ref *curr_ref; if (args->expr->expr_type == EXPR_CONSTANT || args->expr->expr_type == EXPR_OP @@ -2070,32 +2068,8 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, the actual expression could be a part-ref of the expr symbol. */ arg_ts = &(args->expr->ts); - /* Get the parent reference (if any) for the expression. This happens for - cases such as a%b%c. */ - parent_ref = args->expr->ref; - curr_ref = NULL; - if (parent_ref != NULL) - { - curr_ref = parent_ref->next; - while (curr_ref != NULL && curr_ref->next != NULL) - { - parent_ref = curr_ref; - curr_ref = curr_ref->next; - } - } - - /* If curr_ref is non-NULL, we had a part-ref expression. If the curr_ref - is for a REF_COMPONENT, then we need to use it as the parent_ref for - the name, etc. Otherwise, the current parent_ref should be correct. */ - if (curr_ref != NULL && curr_ref->type == REF_COMPONENT) - parent_ref = curr_ref; - - if (parent_ref == args->expr->ref) - parent_ref = NULL; - else if (parent_ref != NULL && parent_ref->type != REF_COMPONENT) - gfc_internal_error ("Unexpected expression reference type in " - "gfc_iso_c_func_interface"); - + is_pointer = gfc_is_data_pointer (args->expr); + if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED) { /* If the user gave two args then they are providing something for @@ -2137,10 +2111,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, else if (sym->intmod_sym_id == ISOCBINDING_LOC) { /* Make sure we have either the target or pointer attribute. */ - if (!(args_sym->attr.target) - && !(args_sym->attr.pointer) - && (parent_ref == NULL || - !parent_ref->u.c.component->attr.pointer)) + if (!args_sym->attr.target && !is_pointer) { gfc_error_now ("Parameter '%s' to '%s' at %L must be either " "a TARGET or an associated pointer", @@ -2223,9 +2194,7 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args, } } } - else if ((args_sym->attr.pointer == 1 || - (parent_ref != NULL - && parent_ref->u.c.component->attr.pointer)) + else if (is_pointer && is_scalar_expr_ptr (args->expr) != SUCCESS) { /* Case 1c, section 15.1.2.5, J3/04-007: an associated diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7e24163..a1d4eb0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-01-04 Mikael Morin + + PR fortran/38536 + * gfortran.dg/c_loc_tests_13.f90: New test. + * gfortran.dg/c_loc_tests_14.f90: New test. + 2009-01-03 Daniel Franke * gfortran.dg/func_result_4.f90: New. diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 new file mode 100644 index 0000000..62bfe0a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR fortran/38536 +! Consecutive array and substring references rejected as C_LOC argument +! +! contributed by Scot Breitenfield + + USE ISO_C_BINDING + TYPE test + CHARACTER(LEN=2), DIMENSION(1:2) :: c + END TYPE test + TYPE(test), TARGET :: chrScalar + TYPE(C_PTR) :: f_ptr + + f_ptr = C_LOC(chrScalar%c(1)(1:1)) + END diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 new file mode 100644 index 0000000..ec455ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } +! +! PR fortran/38536 +! Accept as argument to C_LOC a subcomponent accessed through a pointer. + + USE ISO_C_BINDING + + IMPLICIT NONE + TYPE test3 + INTEGER, DIMENSION(5) :: b + END TYPE test3 + + TYPE test2 + TYPE(test3), DIMENSION(:), POINTER :: a + END TYPE test2 + + TYPE test + TYPE(test2), DIMENSION(2) :: c + END TYPE test + + TYPE(test) :: chrScalar + TYPE(C_PTR) :: f_ptr + TYPE(test3), TARGET :: d(3) + + + chrScalar%c(1)%a => d + f_ptr = C_LOC(chrScalar%c(1)%a(1)%b(1)) + end + -- 2.7.4