diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-07 08:36:16 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-07 08:36:16 +0000 |
| commit | 3facfa3cebe53ec8536aa7b0b8fcd360bae0512c (patch) | |
| tree | f99d0a7046c7f966d4961c0524aab97a55725570 /gcc/fortran | |
| parent | 00e5e80956c4c855ef0ff178ac5b680567851a8c (diff) | |
| download | gcc-3facfa3cebe53ec8536aa7b0b8fcd360bae0512c.tar.gz | |
2012-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
* resolve.c (resolve_select_type): Reject intrinsic types for
a non-unlimited-polymorphic selector.
2012-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
* gfortran.dg/select_type_32.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194962 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 14 |
2 files changed, 15 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8c2cb3cc4b1..72661108e4f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-01-07 Tobias Burnus <burnus@net-b.de> + + PR fortran/55763 + * resolve.c (resolve_select_type): Reject intrinsic types for + a non-unlimited-polymorphic selector. + 2013-01-06 Paul Thomas <pault@gcc.gnu.org> PR fortran/PR53876 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b81f2319aa6..70bfae614b3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8388,12 +8388,16 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) } /* Check F03:C816. */ - if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) - && !selector_type->attr.unlimited_polymorphic - && !gfc_type_is_extension_of (selector_type, c->ts.u.derived)) + if (c->ts.type != BT_UNKNOWN && !selector_type->attr.unlimited_polymorphic + && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS) + || !gfc_type_is_extension_of (selector_type, c->ts.u.derived))) { - gfc_error ("Derived type '%s' at %L must be an extension of '%s'", - c->ts.u.derived->name, &c->where, selector_type->name); + if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + gfc_error ("Derived type '%s' at %L must be an extension of '%s'", + c->ts.u.derived->name, &c->where, selector_type->name); + else + gfc_error ("Unexpected intrinsic type '%s' at %L", + gfc_basic_typename (c->ts.type), &c->where); error++; continue; } |