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

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

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))
 	{

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 "

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.

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

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