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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@140474 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d3d3690..c972097 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+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  Daniel Kraft  <d@domob.eu>
 
        PR fortran/37507

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 3b9d3d2..f7ff9bb 100644 (file)
--- 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.
+
 2008-09-18  DJ Delorie  <dj@redhat.com>
 
        * 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 (file)
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 <terry@chem.gu.se>
+!
+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 (file)
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  <J.Hogg@rl.ac.uk>
+!
+module dtype\r
+   implicit none\r
+\r
+   type overloaded_type\r
+      double precision :: part\r
+   end type\r
+\r
+   interface overloaded_sub\r
+      module procedure overloaded_sub_d\r
+   end interface\r
+\r
+contains\r
+   subroutine overloaded_sub_d(otype)\r
+      type(overloaded_type), intent(in) :: otype\r
+\r
+      print *, "d type = ", otype%part\r
+   end subroutine\r
+end module\r
+\r
+module stype\r
+   implicit none\r
+\r
+   type overloaded_type\r
+      real :: part\r
+   end type\r
+\r
+   interface overloaded_sub\r
+      module procedure overloaded_sub_s\r
+   end interface\r
+\r
+contains\r
+   subroutine overloaded_sub_s(otype)\r
+      type(overloaded_type), intent(in) :: otype\r
+\r
+      print *, "s type = ", otype%part\r
+   end subroutine\r
+end module\r
+\r
+program test\r
+   use stype, overloaded_type_s => overloaded_type\r
+   use dtype, overloaded_type_d => overloaded_type\r
+   implicit none\r
+\r
+   type(overloaded_type_s) :: sval\r
+   type(overloaded_type_d) :: dval\r
+\r
+   sval%part = 1\r
+   dval%part = 2\r
+\r
+   call fred(sval, dval)\r
+\r
+contains\r
+   subroutine fred(sval, dval)\r
+      use stype\r
+\r
+      type(overloaded_type_s), intent(in) :: sval  ! This caused an error\r
+      type(overloaded_type_d), intent(in) :: dval\r
+\r
+      call overloaded_sub(sval)\r
+      call overloaded_sub(dval)\r
+   end subroutine\r
+end program\r
+! { dg-final { cleanup-modules "stype dtype" } }\r