From 67b1d0046b856e95b9c2086be14d1af0d91d8f90 Mon Sep 17 00:00:00 2001
From: Janus Weil <janus@gcc.gnu.org>
Date: Thu, 25 Jul 2013 10:26:36 +0200
Subject: [PATCH] re PR fortran/57639 ([OOP] ICE with polymorphism (and illegal
code))
2013-07-25 Janus Weil <janus@gcc.gnu.org>
PR fortran/57639
* interface.c (compare_parameter): Check for class_ok.
* simplify.c (gfc_simplify_same_type_as): Ditto.
2013-07-25 Janus Weil <janus@gcc.gnu.org>
PR fortran/57639
* gfortran.dg/unlimited_polymorphic_9.f90: New.
From-SVN: r201239
---
gcc/fortran/ChangeLog | 6 ++++++
gcc/fortran/interface.c | 7 ++++++-
gcc/fortran/simplify.c | 3 ++-
gcc/testsuite/ChangeLog | 5 +++++
.../gfortran.dg/unlimited_polymorphic_9.f90 | 20 +++++++++++++++++++
5 files changed, 39 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0de32ddda6b5..d4cc08358e19 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-25 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/57639
+ * interface.c (compare_parameter): Check for class_ok.
+ * simplify.c (gfc_simplify_same_type_as): Ditto.
+
2013-07-23 OndÅ™ej BÃlka <neleai@seznam.cz>
* decl.c: Fix comment typos.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8d31d1c73749..3c794b23c0a0 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1966,7 +1966,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
/* F2008, 12.5.2.5; IR F08/0073. */
- if (formal->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL
+ if (formal->ts.type == BT_CLASS && formal->attr.class_ok
+ && actual->expr_type != EXPR_NULL
&& ((CLASS_DATA (formal)->attr.class_pointer
&& !formal->attr.intent == INTENT_IN)
|| CLASS_DATA (formal)->attr.allocatable))
@@ -1978,6 +1979,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
formal->name, &actual->where);
return 0;
}
+
+ if (!gfc_expr_attr (actual).class_ok)
+ return 0;
+
if (!gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
CLASS_DATA (formal)->ts.u.derived))
{
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 32b8332fa9ea..dca9b7e7a9bc 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2300,7 +2300,8 @@ gfc_simplify_same_type_as (gfc_expr *a, gfc_expr *b)
/* Return .false. if the dynamic type can never be the
same. */
- if ((a->ts.type == BT_CLASS || b->ts.type == BT_CLASS)
+ if (((a->ts.type == BT_CLASS && gfc_expr_attr (a).class_ok)
+ || (b->ts.type == BT_CLASS && gfc_expr_attr (b).class_ok))
&& !gfc_type_compatible (&a->ts, &b->ts)
&& !gfc_type_compatible (&b->ts, &a->ts))
return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b8bd8609e51f..16e6c74a976b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-07-25 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/57639
+ * gfortran.dg/unlimited_polymorphic_9.f90: New.
+
2013-07-25 Terry Guo <terry.guo@arm.com>
* gcc.target/arm/thumb1-Os-mult.c: New test case.
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90
new file mode 100644
index 000000000000..5b7fe92e9ee0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 57639: [OOP] ICE with polymorphism (and illegal code)
+!
+! Contributed by Walter Spector <w6ws@earthlink.net>
+
+ implicit none
+
+ class(*) :: t1, t2 ! { dg-error "must be dummy, allocatable or pointer" }
+
+ print *, 'main: compare = ', compare (t1, t2)
+ print *, SAME_TYPE_AS (t1, t2)
+
+contains
+
+ logical function compare (a, b)
+ class(*), intent(in), allocatable :: a, b
+ end function
+
+end
--
GitLab