1! { dg-do compile } 2! 3! Test the most important constraints unlimited polymorphic entities 4! 5! Contributed by Paul Thomas <pault@gcc.gnu.org> 6! and Tobias Burnus <burnus@gcc.gnu.org> 7! 8 CHARACTER(:), allocatable, target :: chr 9! F2008: C5100 10 integer :: i(2) 11 logical :: flag 12 class(*), pointer :: u1, u2(:) ! { dg-error "cannot appear in COMMON" } 13 common u1 14 u1 => chr 15! F2003: C625 16 allocate (u1) ! { dg-error "requires either a type-spec or SOURCE tag" } 17 allocate (real :: u1) 18 Allocate (u1, source = 1.0) 19 20! F2008: C4106 21 u2 = [u1] ! { dg-error "shall not be unlimited polymorphic" } 22 23 i = u2 ! { dg-error "Can\\'t convert CLASS\\(\\*\\)" } 24 25! Repeats same_type_as_1.f03 for unlimited polymorphic u2 26 flag = same_type_as (i, u2) ! { dg-error "cannot be of type INTEGER" } 27 flag = extends_type_of (i, u2) ! { dg-error "cannot be of type INTEGER" } 28 29contains 30 31! C717 (R735) If data-target is unlimited polymorphic, 32! data-pointer-object shall be unlimited polymorphic, of a sequence 33! derived type, or of a type with the BIND attribute. 34! 35 subroutine bar 36 37 type sq 38 sequence 39 integer :: i 40 end type sq 41 42 type(sq), target :: x 43 class(*), pointer :: y 44 integer, pointer :: tgt 45 46 x%i = 42 47 y => x 48 call foo (y) 49 50 y => tgt ! This is OK, of course. 51 tgt => y ! { dg-error "Data-pointer-object at .1. must be unlimited polymorphic" } 52 53 select type (y) ! This is the correct way to accomplish the previous 54 type is (integer) 55 tgt => y 56 end select 57 58 end subroutine bar 59 60 61 subroutine foo(tgt) 62 class(*), pointer, intent(in) :: tgt 63 type t 64 sequence 65 integer :: k 66 end type t 67 68 type(t), pointer :: ptr 69 70 ptr => tgt ! C717 allows this. 71 72 select type (tgt) 73! F03:C815 or F08:C839 74 type is (t) ! { dg-error "shall not specify a sequence derived type" } 75 ptr => tgt ! { dg-error "Expected TYPE IS" } 76 end select 77 78 print *, ptr%k 79 end subroutine foo 80END 81