From: Janus Weil <janus@gcc.gnu.org>
Date: Fri, 25 Nov 2016 17:22:37 +0000 (+0100)
Subject: re PR fortran/60853 ([OOP] Failure to disambiguate generic with unlimited polymorphic)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f76c4d97aee6c1845baf764ae6b97a530f32858d;p=gcc.git

re PR fortran/60853 ([OOP] Failure to disambiguate generic with unlimited polymorphic)

2016-11-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60853
	* interface.c (gfc_compare_interfaces): Remove bad special case for
	unlimited polymorphism. Refactor for loop.

2016-11-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60853
	* gfortran.dg/typebound_assignment_8.f90: New test case.

From-SVN: r242880
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 737a22c906f..b208f5c5288 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-11-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/60853
+	* interface.c (gfc_compare_interfaces): Remove bad special case for
+	unlimited polymorphism. Refactor for loop.
+
 2016-11-25  Andre Vehreschild  <vehre@gcc.gnu.org>
 	    Paul Thomas  <pault@gcc.gnu.org>
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 4c8d67193ae..f5d3f7762ca 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1728,11 +1728,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
        This is also done when comparing interfaces for dummy procedures and in
        procedure pointer assignments.  */
 
-    for (;;)
+    for (; f1 || f2; f1 = f1->next, f2 = f2->next)
       {
 	/* Check existence.  */
-	if (f1 == NULL && f2 == NULL)
-	  break;
 	if (f1 == NULL || f2 == NULL)
 	  {
 	    if (errmsg != NULL)
@@ -1741,9 +1739,6 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
 	    return 0;
 	  }
 
-	if (UNLIMITED_POLY (f1->sym))
-	  goto next;
-
 	if (strict_flag)
 	  {
 	    /* Check all characteristics.  */
@@ -1772,9 +1767,6 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
 		return 0;
 	      }
 	  }
-next:
-	f1 = f1->next;
-	f2 = f2->next;
       }
 
   return 1;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a4f67e54d13..e741b745d19 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-11-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/60853
+	* gfortran.dg/typebound_assignment_8.f90: New test case.
+
 2016-11-25  Jakub Jelinek  <jakub@redhat.com>
 
 	PR rtl-optimization/78527
diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_8.f90 b/gcc/testsuite/gfortran.dg/typebound_assignment_8.f90
new file mode 100644
index 00000000000..1572777d86e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_assignment_8.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 60853: [OOP] Failure to disambiguate generic with unlimited polymorphic
+!
+! Contributed by tlcclt <Thomas.L.Clune@nasa.gov>
+
+module foo_mod
+   implicit none
+
+   type Vector
+   contains
+      procedure :: copyFromScalar
+      procedure :: copyFromArray
+      generic :: assignment(=) => copyFromScalar, copyFromArray
+   end type
+
+contains
+
+   subroutine copyFromScalar(this, scalar)
+      class (Vector), intent(inout) :: this
+      type  (Vector), intent(in) :: scalar
+   end subroutine
+
+   subroutine copyFromArray(this, array)
+      class (Vector), intent(inout) :: this
+      class (*), intent(in) :: array(:)
+   end subroutine
+
+end module