[Bug fortran/33233] Parent and contained procedure: Wrongly treated as generic procedures
pault at gcc dot gnu dot org
gcc-bugzilla@gcc.gnu.org
Thu Oct 11 14:55:00 GMT 2007
------- 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
More information about the Gcc-bugs
mailing list