[Patch, Fortran] PR 86116: Ambiguous generic interface not recognised

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

the attached patch fixes PR 86116 by splitting up the function
'compare_type' into two variants: One that is used for checking
generic interfaces and operators (keeping the old name), and one that
is used for checking dummy functions and procedure pointer assignments
('compare_type_characteristics'). The latter calls the former, but
includes an additional check that must not be done when checking
generics.

Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2018-08-05  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/86116
    * interface.c (compare_type): Remove a CLASS/TYPE check.
    (compare_type_characteristics): New function that behaves like the old
    'compare_type'.
    (gfc_check_dummy_characteristics, gfc_check_result_characteristics):
    Call 'compare_type_characteristics' instead of 'compare_type'.

2018-08-05  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/86116
    * gfortran.dg/generic_34.f90: New test case.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 263308)
+++ gcc/fortran/interface.c	(working copy)
@@ -735,6 +735,13 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2)
   if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
     return true;
 
+  return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED;
+}
+
+
+static bool
+compare_type_characteristics (gfc_symbol *s1, gfc_symbol *s2)
+{
   /* TYPE and CLASS of the same declared type are type compatible,
      but have different characteristics.  */
   if ((s1->ts.type == BT_CLASS && s2->ts.type == BT_DERIVED)
@@ -741,7 +748,7 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2)
       || (s1->ts.type == BT_DERIVED && s2->ts.type == BT_CLASS))
     return false;
 
-  return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED;
+  return compare_type (s1, s2);
 }
 
 
@@ -1309,7 +1316,8 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, g
   /* Check type and rank.  */
   if (type_must_agree)
     {
-      if (!compare_type (s1, s2) || !compare_type (s2, s1))
+      if (!compare_type_characteristics (s1, s2)
+	  || !compare_type_characteristics (s2, s1))
 	{
 	  snprintf (errmsg, err_len, "Type mismatch in argument '%s' (%s/%s)",
 		    s1->name, gfc_typename (&s1->ts), gfc_typename (&s2->ts));
@@ -1528,7 +1536,7 @@ gfc_check_result_characteristics (gfc_symbol *s1,
     return true;
 
   /* Check type and rank.  */
-  if (!compare_type (r1, r2))
+  if (!compare_type_characteristics (r1, r2))
     {
       snprintf (errmsg, err_len, "Type mismatch in function result (%s/%s)",
 		gfc_typename (&r1->ts), gfc_typename (&r2->ts));

! { dg-do compile }
!
! PR 86116: [6/7/8/9 Regression] Ambiguous generic interface not recognised
!
! Contributed by martin <mscfd@gmx.net>

module mod

   type :: t
   end type t

   interface sub
      module procedure s1
      module procedure s2
   end interface

contains

   subroutine s1(x)  ! { dg-error "Ambiguous interfaces in generic interface" }
      type(t) :: x
   end subroutine

   subroutine s2(x)  ! { dg-error "Ambiguous interfaces in generic interface" }
      class(*), allocatable :: x
   end subroutine

end