mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-23 10:09:39 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/54594 ([OOP] Type-bound ASSIGNMENTs (elemental + array version) rejected as ambiguous)

Browse Source 
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.

From-SVN: r191365
This commit is contained in:
Janus Weil 2012-09-16 22:49:20 +02:00
parent 37bfd49f32
commit aa6590cfbe
4 changed files with 45 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
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

12
gcc/fortran/interface.c
View File

@ -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)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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

27
gcc/testsuite/gfortran.dg/typebound_generic_14.f03 Normal file
View File

@ -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" } }