This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]