OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/55763 (Issues with some simpler CLASS(*) programs) 

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.

From-SVN: r194962
This commit is contained in:
Tobias Burnus 2013-01-07 09:36:16 +01:00 committed by Tobias Burnus
parent 9bdae0133d
commit 55d8631bfa
4 changed files with 45 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

14
gcc/fortran/resolve.c
View File

@ -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;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2012-01-07 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
* gfortran.dg/select_type_32.f90: New.
2013-01-04 Dodji Seketeli <dodji@redhat.com>
PR c++/52343

25
gcc/testsuite/gfortran.dg/select_type_32.f90 Normal file
View File

@ -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