2012-09-16 Janus Weil <janus@gcc.gnu.org>

	PR fortran/54594
	* interface.c (compare_type_rank): Handle CLASS arrays.

2012-09-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54594
	* gfortran.dg/typebound_generic_14.f03: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@191365 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bf9f0b9..e01ae68 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
 2012-09-16  Janus Weil  <janus@gcc.gnu.org>
 
+       PR fortran/54594
+       * interface.c (compare_type_rank): Handle CLASS arrays.
+
+2012-09-16  Janus Weil  <janus@gcc.gnu.org>
+
        PR fortran/54387
        * expr.c (gfc_check_pointer_assign): Check for result of embracing
        function.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 482c294..b348856 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -507,14 +507,18 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
 static int
 compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
 {
+  gfc_array_spec *as1, *as2;
   int r1, r2;
 
-  r1 = (s1->as != NULL) ? s1->as->rank : 0;
-  r2 = (s2->as != NULL) ? s2->as->rank : 0;
+  as1 = (s1->ts.type == BT_CLASS) ? CLASS_DATA (s1)->as : s1->as;
+  as2 = (s2->ts.type == BT_CLASS) ? CLASS_DATA (s2)->as : s2->as;
+
+  r1 = as1 ? as1->rank : 0;
+  r2 = as2 ? as2->rank : 0;
 
   if (r1 != r2
-      && (!s1->as || s1->as->type != AS_ASSUMED_RANK)
-      && (!s2->as || s2->as->type != AS_ASSUMED_RANK))
+      && (!as1 || as1->type != AS_ASSUMED_RANK)
+      && (!as2 || as2->type != AS_ASSUMED_RANK))
     return 0;                  /* Ranks differ.  */
 
   return gfc_compare_types (&s1->ts, &s2->ts)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 978e3df..4b68ef8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2012-09-16  Janus Weil  <janus@gcc.gnu.org>
 
+       PR fortran/54594
+       * gfortran.dg/typebound_generic_14.f03: New.
+
+2012-09-16  Janus Weil  <janus@gcc.gnu.org>
+
        PR fortran/54387
        * gfortran.dg/proc_ptr_38.f90: New.
 

diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_14.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_14.f03
new file mode 100644 (file)
index 0000000..8515cf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_14.f03
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR 54594: [OOP] Type-bound ASSIGNMENTs (elemental + array version) rejected as ambiguous
+!
+! Contributed by James van Buskirk
+
+module a_mod
+
+  type :: a
+   contains
+     procedure, NOPASS :: a_ass, a_ass_sv
+     generic :: ass => a_ass, a_ass_sv
+  end type
+
+contains
+
+  impure elemental subroutine a_ass (out)
+    class(a), intent(out) :: out
+  end subroutine
+
+  subroutine a_ass_sv (out)
+    class(a), intent(out) :: out(:)
+  end subroutine
+
+end module
+
+! { dg-final { cleanup-modules "a_mod" } }