re PR fortran/35945 (Complex module-based overloading fails)

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.

From-SVN: r140474

6 files changed, 113 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d3d36903bec..c972097a67b 100644
--- 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 3b9d3d21d71..f7ff9bbdc3b 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 a11b90d21f5..f8f2df972cc 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 f4e569631f7..ea13346e62c 100644
--- 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
index 00000000000..a74f37343bb
--- /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
index 00000000000..824a4959217
--- /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

+   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" } }