OSDN Git Service

2011-09-26 Janus Weil <janus@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / select_type_17.f03
1 ! { dg-do compile }
2 ! { dg-options "-std=f2003" }
3
4 ! PR fortran/44044
5 ! Definability check for select type to expression.
6 ! This is "bonus feature #2" from comment #3 of the PR.
7
8 ! Contributed by Janus Weil, janus@gcc.gnu.org.
9
10 implicit none
11
12 type :: t1
13   integer :: i
14 end type
15
16 type, extends(t1) :: t2
17 end type
18
19 type(t1),target :: x1
20 type(t2),target :: x2
21
22 select type ( y => fun(1) )
23 type is (t1)
24   y%i = 1 ! { dg-error "variable definition context" }
25 type is (t2)
26   y%i = 2 ! { dg-error "variable definition context" }
27 end select
28
29 contains
30
31   function fun(i)
32     class(t1),pointer :: fun
33     integer :: i
34     if (i>0) then
35       fun => x1
36     else if (i<0) then
37       fun => x2
38     else
39       fun => NULL()
40     end if
41   end function
42
43 end
44