3 ! Error checking for the SELECT TYPE statement
5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
9 class(t1),pointer :: cp
12 type, extends(t1) :: t2
25 class(t1), pointer :: a => NULL()
26 class(t1), allocatable, dimension(:) :: ca
32 type is (t1) ! { dg-error "Unexpected TYPE IS statement" }
34 select type (3.5) ! { dg-error "is not a named variable" }
35 select type (a%cp) ! { dg-error "is not a named variable" }
36 select type (ca(1))! { dg-error "is not a named variable" }
37 select type (b) ! { dg-error "Selector shall be polymorphic" }
41 print *,"hello world!" ! { dg-error "Expected TYPE IS, CLASS IS or END SELECT" }
43 print *,"a is TYPE(t1)"
45 print *,"a is TYPE(t2)"
46 class is (ts) ! { dg-error "must be extensible" }
47 print *,"a is TYPE(ts)"
48 type is (t3) ! { dg-error "must be an extension of" }
49 print *,"a is TYPE(t3)"
50 type is (t4) ! { dg-error "error in TYPE IS specification" }
51 print *,"a is TYPE(t3)"
53 print *,"a is CLASS(t1)"
54 class is (t2) label ! { dg-error "Syntax error" }
55 print *,"a is CLASS(t2)"
56 class default ! { dg-error "cannot be followed by a second DEFAULT CASE" }
58 class default ! { dg-error "cannot be followed by a second DEFAULT CASE" }
62 label: select type (a)
64 print *,"a is TYPE(t1)"
65 type is (t2) ! { dg-error "overlaps with TYPE IS" }
66 print *,"a is TYPE(t2)"
67 type is (t2) ! { dg-error "overlaps with TYPE IS" }
68 print *,"a is still TYPE(t2)"
69 class is (t1) labe ! { dg-error "Expected block name" }
70 print *,"a is CLASS(t1)"