From e520a5e1067185985d5f26f70ef596f6bbd5e7e8 Mon Sep 17 00:00:00 2001 From: pault Date: Mon, 25 Jun 2007 18:27:59 +0000 Subject: [PATCH] 2007-06-25 Paul Thomas PR fortran/32464 * resolve.c (check_host_association): Return if the old symbol is use associated. Introduce retval to reduce the number of evaluations of the first-order return value. PR fortran/31494 * match.c (gfc_match_call): If a host associated symbol is not a subroutine, build a new symtree/symbol in the current name space. 2007-06-25 Paul Thomas PR fortran/32464 * gfortran.dg/host_assoc_function_2.f90: New test. PR fortran/31494 * gfortran.dg/host_assoc_call_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126000 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 12 ++++++ gcc/fortran/match.c | 15 +++++-- gcc/fortran/resolve.c | 11 +++-- gcc/testsuite/ChangeLog | 8 ++++ gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 | 17 ++++++++ .../gfortran.dg/host_assoc_function_2.f90 | 48 ++++++++++++++++++++++ 6 files changed, 104 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6c9c382..5b697d1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2007-06-25 Paul Thomas + + PR fortran/32464 + * resolve.c (check_host_association): Return if the old symbol + is use associated. Introduce retval to reduce the number of + evaluations of the first-order return value. + + PR fortran/31494 + * match.c (gfc_match_call): If a host associated symbol is not + a subroutine, build a new symtree/symbol in the current name + space. + 2007-06-24 Tobias Burnus PR fortran/32460 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index e00c285..ee376f5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2170,13 +2170,20 @@ gfc_match_call (void) return MATCH_ERROR; sym = st->n.sym; - gfc_set_sym_referenced (sym); - if (!sym->attr.generic - && !sym->attr.subroutine - && gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) + if (sym->ns != gfc_current_ns + && !sym->attr.generic + && !sym->attr.subroutine + && gfc_get_sym_tree (name, NULL, &st) == 1) return MATCH_ERROR; + sym = st->n.sym; + + if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) + return MATCH_ERROR; + + gfc_set_sym_referenced (sym); + if (gfc_match_eos () != MATCH_YES) { m = gfc_match_actual_arglist (1, &arglist); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8b3b29e..bc6ba02 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3224,11 +3224,16 @@ check_host_association (gfc_expr *e) locus temp_locus; gfc_expr *expr; int n; + bool retval = e->expr_type == EXPR_FUNCTION; if (e->symtree == NULL || e->symtree->n.sym == NULL) - return e->expr_type == EXPR_FUNCTION; + return retval; old_sym = e->symtree->n.sym; + + if (old_sym->attr.use_assoc) + return retval; + if (gfc_current_ns->parent && gfc_current_ns->parent->parent && old_sym->ns != gfc_current_ns) @@ -3244,7 +3249,7 @@ check_host_association (gfc_expr *e) gfc_free_ref_list (e->ref); e->ref = NULL; - if (e->expr_type == EXPR_FUNCTION) + if (retval) { gfc_free_actual_arglist (e->value.function.actual); e->value.function.actual = NULL; @@ -3271,7 +3276,7 @@ check_host_association (gfc_expr *e) gfc_current_locus = temp_locus; } } - + /* This might have changed! */ return e->expr_type == EXPR_FUNCTION; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 120704f..eb9251f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-06-25 Paul Thomas + + PR fortran/32464 + * gfortran.dg/host_assoc_function_2.f90: New test. + + PR fortran/31494 + * gfortran.dg/host_assoc_call_1.f90: New test. + 2007-06-24 Jerry DeLisle * gfortran.dg/secnds-1.f: Revise test to reduce random errors. diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 new file mode 100644 index 0000000..8049290 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! Tests the fix for PR31494, where the call of sub2 would reference +! the variable, rather than the contained subroutine. +! +! Contributed by Michael Richmond +! +MODULE ksbin2_aux_mod +REAL, DIMENSION(1) :: sub2 +CONTAINS + SUBROUTINE sub1 + CALL sub2 + CONTAINS + SUBROUTINE sub2 + END SUBROUTINE sub2 + END SUBROUTINE sub1 +END MODULE ksbin2_aux_mod +! { dg-final { cleanup-modules "ksbin2_aux_mod" } } diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 new file mode 100644 index 0000000..5d63d7a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! Tests the fix for PR32464, where the use associated procedure would +! mess up the check for "grandparent" host association. +! +! Contributed by Harald Anlauf +! + +module gfcbug64_mod1 + implicit none + + public :: inverse + + interface inverse + module procedure copy + end interface + +contains + + function copy (d) result (y) + real, intent(in) :: d(:) + real :: y(size (d)) ! <- this version kills gfortran +! real, intent(in) :: d +! real :: y + y = d + end function copy + +end module gfcbug64_mod1 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module gfcbug64_mod2 + implicit none +contains + + subroutine foo (x_o) + real, intent(in) :: x_o(:) + + integer :: s(size (x_o)) ! <- this line kills gfortran + + contains + + subroutine bar () + use gfcbug64_mod1, only: inverse ! <- this line kills gfortran + end subroutine bar + + end subroutine foo +end module gfcbug64_mod2 +! { dg-final { cleanup-modules "gfcbug64_mod1 gfcbug64_mod2" } } -- 2.7.4