From: burnus Date: Mon, 7 Jan 2013 08:36:16 +0000 (+0000) Subject: 2012-01-07 Tobias Burnus X-Git-Tag: upstream/4.9.2~8255 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3facfa3cebe53ec8536aa7b0b8fcd360bae0512c;p=platform%2Fupstream%2Flinaro-gcc.git 2012-01-07 Tobias Burnus PR fortran/55763 * resolve.c (resolve_select_type): Reject intrinsic types for a non-unlimited-polymorphic selector. 2012-01-07 Tobias Burnus 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8c2cb3c..7266110 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-01-07 Tobias Burnus + + PR fortran/55763 + * resolve.c (resolve_select_type): Reject intrinsic types for + a non-unlimited-polymorphic selector. + 2013-01-06 Paul Thomas PR fortran/PR53876 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b81f231..70bfae6 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 217e40f..0d36ca2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-07 Tobias Burnus + + PR fortran/55763 + * gfortran.dg/select_type_32.f90: New. + 2013-01-04 Dodji Seketeli PR c++/52343 diff --git a/gcc/testsuite/gfortran.dg/select_type_32.f90 b/gcc/testsuite/gfortran.dg/select_type_32.f90 new file mode 100644 index 0000000..5e36639 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_32.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! +! PR fortran/55763 +! +! Contributed by Harald Anlauf +! + +module gfcbug122 + implicit none + type myobj + class(*), allocatable :: x + contains + procedure :: print + end type myobj +contains + subroutine print(this) + class(myobj) :: this + select type (this) + type is (integer) ! { dg-error "Unexpected intrinsic type 'INTEGER'" } + type is (real) ! { dg-error "Unexpected intrinsic type 'REAL'" } + type is (complex) ! { dg-error "Unexpected intrinsic type 'COMPLEX'" } + type is (character(len=*)) ! { dg-error "Unexpected intrinsic type 'CHARACTER'" } + end select + end subroutine print +end module gfcbug122