|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! PR fortran/54618
|
|
|
4 !
|
|
|
5 ! Check whether default initialization works with INTENT(OUT)
|
|
|
6 ! and ALLOCATABLE and no segfault occurs with OPTIONAL.
|
|
|
7 !
|
|
|
8
|
|
|
9 subroutine test1()
|
|
|
10 type typ1
|
|
|
11 integer :: i = 6
|
|
|
12 end type typ1
|
|
|
13
|
|
|
14 type(typ1) :: x
|
|
|
15
|
|
|
16 x%i = 77
|
|
|
17 call f(x)
|
|
131
|
18 if (x%i /= 6) STOP 1
|
|
111
|
19 call f()
|
|
|
20 contains
|
|
|
21 subroutine f(y1)
|
|
|
22 class(typ1), intent(out), optional :: y1
|
|
|
23 end subroutine f
|
|
|
24 end subroutine test1
|
|
|
25
|
|
|
26 subroutine test2()
|
|
|
27 type mytype
|
|
|
28 end type mytype
|
|
|
29 type, extends(mytype):: mytype2
|
|
|
30 end type mytype2
|
|
|
31
|
|
|
32 class(mytype), allocatable :: x,y
|
|
|
33 allocate (mytype2 :: x)
|
|
|
34 call g(x)
|
|
131
|
35 if (allocated (x) .or. .not. same_type_as (x,y)) STOP 2
|
|
111
|
36
|
|
|
37 allocate (mytype2 :: x)
|
|
|
38 call h(x)
|
|
131
|
39 if (allocated (x) .or. .not. same_type_as (x,y)) STOP 3
|
|
111
|
40
|
|
|
41 call h()
|
|
|
42 contains
|
|
|
43 subroutine g(y2)
|
|
|
44 class(mytype), intent(out), allocatable :: y2
|
|
|
45 end subroutine g
|
|
|
46 subroutine h(y3)
|
|
|
47 class(mytype), optional, intent(out), allocatable :: y3
|
|
|
48 end subroutine h
|
|
|
49 end subroutine test2
|
|
|
50
|
|
|
51 call test1()
|
|
|
52 call test2()
|
|
|
53 end
|
