From 499335e482fcd12c300381a799e9af36a166de5b Mon Sep 17 00:00:00 2001 From: pault Date: Sun, 4 Jan 2009 23:17:37 +0000 Subject: [PATCH] 2009-01-05 Paul Thomas PR fortran/38665 * gfortran.h : Add bit to gfc_expr 'user_operator' * interface.c (gfc_extend_expr): Set the above if the operator is substituted by a function. * resolve.c (check_host_association): Return if above is set. 2009-01-05 Paul Thomas PR fortran/38665 * gfortran.dg/host_assoc_function_5.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@143064 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/gfortran.h | 4 ++ gcc/fortran/interface.c | 1 + gcc/fortran/resolve.c | 12 +++++- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/host_assoc_function_5.f90 | 47 ++++++++++++++++++++++ 6 files changed, 76 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2bf2a0185a2..b8fdb3b101f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-01-05 Paul Thomas + + PR fortran/38665 + * gfortran.h : Add bit to gfc_expr 'user_operator' + * interface.c (gfc_extend_expr): Set the above if the operator + is substituted by a function. + * resolve.c (check_host_association): Return if above is set. + 2009-01-04 Mikael Morin PR fortran/35681 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index bb2230df8d8..920fbd9bffe 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1553,6 +1553,10 @@ typedef struct gfc_expr /* Sometimes, when an error has been emitted, it is necessary to prevent it from recurring. */ unsigned int error : 1; + + /* Mark and expression where a user operator has been substituted by + a function call in interface.c(gfc_extend_expr). */ + unsigned int user_operator : 1; /* Used to quickly find a given constructor by its offset. */ splay_tree con_by_offset; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 17f70331286..f779dfa04de 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2670,6 +2670,7 @@ gfc_extend_expr (gfc_expr *e) e->value.function.esym = NULL; e->value.function.isym = NULL; e->value.function.name = NULL; + e->user_operator = 1; if (gfc_pure (NULL) && !gfc_pure (sym)) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 27a4d997b7a..74f8fb05114 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4300,7 +4300,12 @@ check_host_association (gfc_expr *e) int n; bool retval = e->expr_type == EXPR_FUNCTION; - if (e->symtree == NULL || e->symtree->n.sym == NULL) + /* If the expression is the result of substitution in + interface.c(gfc_extend_expr) because there is no way in + which the host association can be wrong. */ + if (e->symtree == NULL + || e->symtree->n.sym == NULL + || e->user_operator) return retval; old_sym = e->symtree->n.sym; @@ -4336,6 +4341,11 @@ check_host_association (gfc_expr *e) gfc_free (e->shape); } +/* TODO - Replace this gfc_match_rvalue with a straight replacement of + actual arglists for function to function substitutions and with a + conversion of the reference list to an actual arglist in the case of + a variable to function replacement. This should be quite easy since + only integers and vectors can be involved. */ gfc_match_rvalue (&expr); gfc_clear_error (); gfc_buffer_error (0); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fde2ce2ad74..926a95db8cc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-01-05 Paul Thomas + + PR fortran/38665 + * gfortran.dg/host_assoc_function_5.f90: New test. + 2009-01-04 Mikael Morin PR fortran/38669 diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 new file mode 100644 index 00000000000..c75202e445a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 @@ -0,0 +1,47 @@ +! { dg-do compile } +! +! PR fortran/38665, in which checking for host association +! was wrongly trying to substitute mod_symmon(mult) with +! mod_sympoly(mult) in the user operator expression on line +! 43. +! +! Contributed by Thomas Koenig +! +module mod_symmon + implicit none + + public :: t_symmon, operator(*) + private + + type t_symmon + integer :: ierr = 0 + end type t_symmon + + interface operator(*) + module procedure mult + end interface + +contains + elemental function mult(m1,m2) result(m) + type(t_symmon), intent(in) :: m1, m2 + type(t_symmon) :: m + end function mult +end module mod_symmon + +module mod_sympoly + use mod_symmon + implicit none + + type t_sympol + type(t_symmon), allocatable :: mons(:) + end type t_sympol +contains + + elemental function mult(p1,p2) result(p) + type(t_sympol), intent(in) :: p1,p2 + type(t_sympol) :: p + type(t_symmon), allocatable :: mons(:) + mons(1) = p1%mons(1)*p2%mons(2) + end function +end module +! { dg-final { cleanup-modules "mod_symmon mod_sympoly" } } -- 2.11.4.GIT