This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR35945 and PR36700
- From: "Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 18 Sep 2008 16:21:56 +0200
- Subject: [Patch, fortran] PR35945 and PR36700
Both these PRs originate were caused by previous patches of mine and
both involve host association. The fixes are straightforward and the
tests are the reporters'.
Bootstrapped and regtested on x86_ia64/FC8
OK for trunk?
Paul
PS Sorry this is not a context diff.
2008-09-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35945
* resolve.c (resolve_fl_variable_derived): Remove derived type
comparison for use associated derived types. Host association
of a derived type will not arise if there is a local derived type
whose use name is the same.
PR fortran/36700
* match.c (gfc_match_call): Use the existing symbol even if
it is a function.
2008-09-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35945
* gfortran.dg/host_assoc_types_2.f90: New test.
PR fortran/36700
* gfortran.dg/host_assoc_call_2.f90: New test.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 139704)
+++ gcc/fortran/resolve.c (working copy)
@@ -7039,8 +7039,7 @@
{
gfc_symbol *s;
gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
- if (s && (s->attr.flavor != FL_DERIVED
- || !gfc_compare_derived_types (s, sym->ts.derived)))
+ if (s && s->attr.flavor != FL_DERIVED)
{
gfc_error ("The type '%s' cannot be host associated at %L "
"because it is blocked by an incompatible object "
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 139704)
+++ gcc/fortran/match.c (working copy)
@@ -2541,9 +2541,12 @@
sym = st->n.sym;
- /* If it does not seem to be callable... */
+ /* If it does not seem to be callable (include functions so that the
+ right association is made. They are thrown out in resolution.)
+ ... */
if (!sym->attr.generic
- && !sym->attr.subroutine)
+ && !sym->attr.subroutine
+ && !sym->attr.function)
{
if (!(sym->attr.external && !sym->attr.referenced))
{
Index: gcc/testsuite/gfortran.dg/host_assoc_call_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 (revision 0)
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Tests the fix for PR36700, in which the call to the function would
+! cause an ICE.
+!
+! Contributed by <terry@chem.gu.se>
+!
+module Diatoms
+ implicit none
+contains
+ function InitialDiatomicX () result(v4)
+ real(kind = 8), dimension(4) :: v4
+ v4 = 1
+ end function InitialDiatomicX
+ subroutine FindDiatomicPeriod
+ call InitialDiatomicX () ! { dg-error "has a type" }
+ end subroutine FindDiatomicPeriod
+end module Diatoms
+! { dg-final { cleanup-modules "Diatoms" } }
Index: gcc/testsuite/gfortran.dg/host_assoc_types_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 (revision 0)
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! Tests the fix for PR33945, the host association of overloaded_type_s
+! would be incorrectly blocked by the use associated overloaded_type.
+!
+! Contributed by Jonathan Hogg <J.Hogg@rl.ac.uk>
+!
+module dtype
+ implicit none
+
+ type overloaded_type
+ double precision :: part
+ end type
+
+ interface overloaded_sub
+ module procedure overloaded_sub_d
+ end interface
+
+contains
+ subroutine overloaded_sub_d(otype)
+ type(overloaded_type), intent(in) :: otype
+
+ print *, "d type = ", otype%part
+ end subroutine
+end module
+
+module stype
+ implicit none
+
+ type overloaded_type
+ real :: part
+ end type
+
+ interface overloaded_sub
+ module procedure overloaded_sub_s
+ end interface
+
+contains
+ subroutine overloaded_sub_s(otype)
+ type(overloaded_type), intent(in) :: otype
+
+ print *, "s type = ", otype%part
+ end subroutine
+end module
+
+program test
+ use stype, overloaded_type_s => overloaded_type
+ use dtype, overloaded_type_d => overloaded_type
+ implicit none
+
+ type(overloaded_type_s) :: sval
+ type(overloaded_type_d) :: dval
+
+ sval%part = 1
+ dval%part = 2
+
+ call fred(sval, dval)
+
+contains
+ subroutine fred(sval, dval)
+ use stype
+
+ type(overloaded_type_s), intent(in) :: sval ! This caused an error
+ type(overloaded_type_d), intent(in) :: dval
+
+ call overloaded_sub(sval)
+ call overloaded_sub(dval)
+ end subroutine
+end program
+! { dg-final { cleanup-modules "stype dtype" } }