re PR fortran/44917 ([OOP] Detect ambiguous specifics in a generic TBP interface)

2010-10-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44917
	PR fortran/44926
	PR fortran/46196
	* interface.c (count_types_test): Symmetrize type check.
	(generic_correspondence): Ditto.

2010-10-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44917
	PR fortran/44926
	PR fortran/46196
	* gfortran.dg/typebound_generic_10.f03: New.

From-SVN: r166089

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f64d530af4c87ad763d6e160c03d719ea67d7e70..0f783b537292e2196b9b364a839284a18e1b057a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2010-10-30  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/44917
+       PR fortran/44926
+       PR fortran/46196
+       * interface.c (count_types_test): Symmetrize type check.
+       (generic_correspondence): Ditto.
+
 2010-10-27  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/46161

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 16b941cb0be4816bb621ba0c0f5b4eb9f55bf7e5..cf83557be550b2a4fc999cf7c424ae66e72dd716 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -872,7 +872,8 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
       /* Find other nonoptional arguments of the same type/rank.  */
       for (j = i + 1; j < n1; j++)
        if ((arg[j].sym == NULL || !arg[j].sym->attr.optional)
-           && compare_type_rank_if (arg[i].sym, arg[j].sym))
+           && (compare_type_rank_if (arg[i].sym, arg[j].sym)
+               || compare_type_rank_if (arg[j].sym, arg[i].sym)))
          arg[j].flag = k;
 
       k++;
@@ -897,7 +898,8 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
       ac2 = 0;
 
       for (f = f2; f; f = f->next)
-       if (compare_type_rank_if (arg[i].sym, f->sym))
+       if (compare_type_rank_if (arg[i].sym, f->sym)
+           || compare_type_rank_if (f->sym, arg[i].sym))
          ac2++;
 
       if (ac1 > ac2)
@@ -948,7 +950,8 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
       if (f1->sym->attr.optional)
        goto next;
 
-      if (f2 != NULL && compare_type_rank (f1->sym, f2->sym))
+      if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym)
+                        || compare_type_rank (f2->sym, f1->sym)))
        goto next;
 
       /* Now search for a disambiguating keyword argument starting at

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 00e05ef689e6d944dcc0ce4546084d84caeb8d25..7fcf5380d2098c9ad95edc44a69c60fec7057b77 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2010-10-30  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/44917
+       PR fortran/44926
+       PR fortran/46196
+       * gfortran.dg/typebound_generic_10.f03: New.
+
 2010-10-30  Nicola Pero  <nicola.pero@meta-innovation.com>
 
        Implemented Objective-C 2.0 @property, @synthesize and @dynamic.

diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_10.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_10.f03
new file mode 100644 (file)
index 0000000..590fa52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_10.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 49196: [OOP] gfortran compiles invalid generic TBP: dummy arguments are type compatible
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module generic
+
+  type :: a_type
+   contains
+     procedure :: a_subroutine
+  end type a_type
+
+  type,extends(a_type) :: b_type
+   contains
+     procedure :: b_subroutine
+     generic :: g_sub => a_subroutine,b_subroutine  ! { dg-error "are ambiguous" }
+  end type b_type
+
+contains
+
+  subroutine a_subroutine(this)
+    class(a_type)::this
+  end subroutine a_subroutine
+
+  subroutine b_subroutine(this)
+    class(b_type)::this
+  end subroutine b_subroutine
+
+end module generic 
+
+! { dg-final { cleanup-modules "generic" } }