[Patch, Fortran, OOP] PR 60853: Failure to disambiguate generic with unlimited polymorphic

[Janus Weil]

Hi all,

here is a patch that fixes a rejects-valid problem with an
unlimited-polymorphic variable in a generic procedure. Removing the
line with UNLIMITED_POLY fixes the error and the rest of the patch is
just slightly refactoring the for-loop.

Regtested successfully on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2016-11-25  Janus Weil  <ja...@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  <ja...@gcc.gnu.org>

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

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c     (revision 242818)
+++ gcc/fortran/interface.c     (working copy)
@@ -1728,11 +1728,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol
        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
            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
                return 0;
              }
          }
-next:
-       f1 = f1->next;
-       f2 = f2->next;
       }
 
   return 1;

! { dg-do compile }
!
! PR 60853: [OOP] Failure to disambiguate generic with unlimited polymorphic
!
! Contributed by tlcclt <thomas.l.cl...@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