diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-09-16 20:49:20 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-09-16 20:49:20 +0000 |
| commit | dab28b37d34559bc57653a8b5f63ebd211d469da (patch) | |
| tree | bf15188669b1d6386e4581c1a9b78a38627de518 | |
| parent | 4925e87073b516e3fa4fc60995c6b87138231b29 (diff) | |
| download | ppe42-gcc-dab28b37d34559bc57653a8b5f63ebd211d469da.tar.gz ppe42-gcc-dab28b37d34559bc57653a8b5f63ebd211d469da.zip | |
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
| -rw-r--r-- | gcc/fortran/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 12 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_generic_14.f03 | 27 |
4 files changed, 45 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bf9f0b93ae6..e01ae683f4f 100644 --- 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 482c294ecba..b34885632eb 100644 --- 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 978e3dfc7fe..4b68ef8d9e9 100644 --- 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 index 00000000000..8515cf4378f --- /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" } } |
