From 334e912a93187986aa51b980b30b50b42fa109c5 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 18 Sep 2008 20:21:03 +0000 Subject: [PATCH] re PR fortran/35945 (Complex module-based overloading fails) 2008-09-18 Paul Thomas 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 PR fortran/35945 * gfortran.dg/host_assoc_types_2.f90: New test. PR fortran/36700 * gfortran.dg/host_assoc_call_2.f90: New test. From-SVN: r140474 --- gcc/fortran/ChangeLog | 12 +++++ gcc/fortran/match.c | 7 ++- gcc/fortran/resolve.c | 3 +- gcc/testsuite/ChangeLog | 8 +++ gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 | 18 +++++++ gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 | 69 ++++++++++++++++++++++++ 6 files changed, 113 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d3d3690..c972097 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2008-09-18 Paul Thomas + + 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 Daniel Kraft PR fortran/37507 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 3b9d3d2..f7ff9bb 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2589,9 +2589,12 @@ gfc_match_call (void) if (sym->attr.flavor != FL_PROCEDURE && sym->ts.type == BT_DERIVED) return match_typebound_call (st); - /* 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)) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index a11b90d..f8f2df9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7371,8 +7371,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) { 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 " diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f4e5696..ea13346 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-09-18 Paul Thomas + + PR fortran/35945 + * gfortran.dg/host_assoc_types_2.f90: New test. + + PR fortran/36700 + * gfortran.dg/host_assoc_call_2.f90: New test. + 2008-09-18 DJ Delorie * gcc.c-torture/execute/20060420-1.c: Fix alignment logic. diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 new file mode 100644 index 0000000..a74f373 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 @@ -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 +! +module Diatoms + implicit none +contains + function InitialDiatomicX () result(v4) ! { dg-error "has a type" } + real(kind = 8), dimension(4) :: v4 + v4 = 1 + end function InitialDiatomicX + subroutine FindDiatomicPeriod + call InitialDiatomicX () ! { dg-error "which is not consistent with the CALL" } + end subroutine FindDiatomicPeriod +end module Diatoms +! { dg-final { cleanup-modules "Diatoms" } } diff --git a/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 new file mode 100644 index 0000000..824a495 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 @@ -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 +! +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" } } -- 2.7.4