------- Comment #2 from pault at gcc dot gnu dot org  2007-10-11 14:55 -------
(In reply to comment #1)
Ah.... this bug was present before my patch for PR30746.  I can see from my
notes that I was fixated on PR30746, whilst not altering the behaviour of
gfortran in any other way....., whether right or wrong.  Bah!

With the patch below, we get the correct behaviour for 

MODULE m
  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
CONTAINS
  SUBROUTINE s
    if (x(2) .eq. 2.5) call abort ()
  CONTAINS
    FUNCTION x(n, m)
      integer, optional :: m
      if (present(m)) then
        x = REAL(n)**m
      else
        x = 0.0
      end if
    END FUNCTION
  END SUBROUTINE s
END MODULE m
  use m
  call s
end

Paul

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c       (révision 129121)
--- gcc/fortran/resolve.c       (copie de travail)
*************** check_host_association (gfc_expr *e)
*** 3989,3999 ****
      return retval;

    if (gfc_current_ns->parent
-       && gfc_current_ns->parent->parent
        && old_sym->ns != gfc_current_ns)
      {
!       gfc_find_symbol (old_sym->name, gfc_current_ns->parent, 1, &sym);
!       if (sym && old_sym != sym && sym->attr.flavor == FL_PROCEDURE)
        {
          temp_locus = gfc_current_locus;
          gfc_current_locus = e->where;
--- 3989,4000 ----
      return retval;

    if (gfc_current_ns->parent
        && old_sym->ns != gfc_current_ns)
      {
!       gfc_find_symbol (old_sym->name, gfc_current_ns, 1, &sym);
!       if (sym && old_sym != sym
!             && sym->attr.flavor == FL_PROCEDURE
!             && sym->attr.contained)
        {
          temp_locus = gfc_current_locus;
          gfc_current_locus = e->where;

Index: D:/svn/trunk/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
===================================================================
*** D:/svn/trunk/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90   
(révisio
n 129121)
--- D:/svn/trunk/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90    (copie
d
e travail)
*************** MODULE m
*** 19,26 ****
    end interface
  CONTAINS
    SUBROUTINE s
!     if (x(2) .ne. 2.5) call abort ()
!     if (z(3) .ne. real (3)**3) call abort ()
      CALL inner
    CONTAINS
      SUBROUTINE inner
--- 19,26 ----
    end interface
  CONTAINS
    SUBROUTINE s
!     if (x(2, 3) .ne. real (2)**3) call abort ()
!     if (z(3, 3) .ne. real (3)**3) call abort ()
      CALL inner
    CONTAINS
      SUBROUTINE inner


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=33233