| ! { dg-do compile } |
| ! |
| ! Test the most important constraints unlimited polymorphic entities |
| ! |
| ! Contributed by Paul Thomas <pault@gcc.gnu.org> |
| ! and Tobias Burnus <burnus@gcc.gnu.org> |
| ! |
| CHARACTER(:), allocatable, target :: chr |
| ! F2008: C5100 |
| integer :: i(2) |
| logical :: flag |
| class(*), pointer :: u1, u2(:) ! { dg-error "cannot appear in COMMON" } |
| common u1 |
| u1 => chr |
| ! F2003: C625 |
| allocate (u1) ! { dg-error "requires either a type-spec or SOURCE tag" } |
| allocate (real :: u1) |
| Allocate (u1, source = 1.0) |
| |
| ! F2008: C4106 |
| u2 = [u1] ! { dg-error "shall not be unlimited polymorphic" } |
| |
| i = u2 ! { dg-error "Cannot convert CLASS\\(\\*\\)" } |
| |
| ! Repeats same_type_as_1.f03 for unlimited polymorphic u2 |
| flag = same_type_as (i, u2) ! { dg-error "cannot be of type INTEGER" } |
| flag = extends_type_of (i, u2) ! { dg-error "cannot be of type INTEGER" } |
| |
| contains |
| |
| ! C717 (R735) If data-target is unlimited polymorphic, |
| ! data-pointer-object shall be unlimited polymorphic, of a sequence |
| ! derived type, or of a type with the BIND attribute. |
| ! |
| subroutine bar |
| |
| type sq |
| sequence |
| integer :: i |
| end type sq |
| |
| type(sq), target :: x |
| class(*), pointer :: y |
| integer, pointer :: tgt |
| |
| x%i = 42 |
| y => x |
| call foo (y) |
| |
| y => tgt ! This is OK, of course. |
| tgt => y ! { dg-error "Data-pointer-object at .1. must be unlimited polymorphic" } |
| |
| select type (y) ! This is the correct way to accomplish the previous |
| type is (integer) |
| tgt => y |
| end select |
| |
| end subroutine bar |
| |
| |
| subroutine foo(tgt) |
| class(*), pointer, intent(in) :: tgt |
| type t |
| sequence |
| integer :: k |
| end type t |
| |
| type(t), pointer :: ptr |
| |
| ptr => tgt ! C717 allows this. |
| |
| select type (tgt) |
| ! F03:C815 or F08:C839 |
| type is (t) ! { dg-error "shall not specify a sequence derived type" } |
| ptr => tgt ! { dg-error "Expected TYPE IS" } |
| end select |
| |
| print *, ptr%k |
| end subroutine foo |
| END |