summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>2012-09-16 20:49:20 +0000
committerjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>2012-09-16 20:49:20 +0000
commitdab28b37d34559bc57653a8b5f63ebd211d469da (patch)
treebf15188669b1d6386e4581c1a9b78a38627de518 /gcc/fortran
parent4925e87073b516e3fa4fc60995c6b87138231b29 (diff)
downloadgcc-dab28b37d34559bc57653a8b5f63ebd211d469da.tar.gz
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
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog5
-rw-r--r--gcc/fortran/interface.c12
2 files changed, 13 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)