diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 7 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 3 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/unlimited_polymorphic_9.f90 | 20 |
5 files changed, 39 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0de32dd..d4cc083 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 8d31d1c..3c794b2 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 32b8332..dca9b7e 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 b8bd860..16e6c74 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 0000000..5b7fe92 --- /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 |