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()
31 type is (t1) ! { dg-error "Unexpected TYPE IS statement" }
33 select type (3.5) ! { dg-error "is not a named variable" }
34 select type (a%cp) ! { dg-error "is not a named variable" }
35 select type (b) ! { dg-error "Selector shall be polymorphic" }
39 print *,"hello world!" ! { dg-error "Expected TYPE IS, CLASS IS or END SELECT" }
41 print *,"a is TYPE(t1)"
43 print *,"a is TYPE(t2)"
44 class is (ts) ! { dg-error "must be extensible" }
45 print *,"a is TYPE(ts)"
46 type is (t3) ! { dg-error "must be an extension of" }
47 print *,"a is TYPE(t3)"
48 type is (t4) ! { dg-error "is not an accessible derived type" }
49 print *,"a is TYPE(t3)"
51 print *,"a is CLASS(t1)"
52 class is (t2) label ! { dg-error "Syntax error" }
53 print *,"a is CLASS(t2)"
54 class default ! { dg-error "cannot be followed by a second DEFAULT CASE" }
56 class default ! { dg-error "cannot be followed by a second DEFAULT CASE" }
60 label: select type (a)
62 print *,"a is TYPE(t1)"
63 type is (t2) ! { dg-error "overlaps with CASE label" }
64 print *,"a is TYPE(t2)"
65 type is (t2) ! { dg-error "overlaps with CASE label" }
66 print *,"a is still TYPE(t2)"
67 class is (t1) labe ! { dg-error "Expected block name" }
68 print *,"a is CLASS(t1)"