1! { dg-do run }
2!
3! PR fortran/41872
4!
5!
6program test
7  implicit none
8  integer, allocatable :: a
9  integer, allocatable :: b
10  allocate(a)
11  call foo(a)
12  if(.not. allocated(a)) STOP 1
13  if (a /= 5) STOP 2
14
15  call bar(a)
16  if (a /= 7) STOP 3
17
18  deallocate(a)
19  if(allocated(a)) STOP 4
20  call check3(a)
21  if(.not. allocated(a)) STOP 5
22  if(a /= 6874) STOP 6
23  call check4(a)
24  if(.not. allocated(a)) STOP 7
25  if(a /= -478) STOP 8
26
27  allocate(b)
28  b = 7482
29  call checkOptional(.false.,.true., 7482)
30  if (b /= 7482) STOP 9
31  call checkOptional(.true., .true., 7482, b)
32  if (b /= 46) STOP 10
33contains
34  subroutine foo(a)
35    integer, allocatable, intent(out)  :: a
36    if(allocated(a)) STOP 11
37    allocate(a)
38    a = 5
39  end subroutine foo
40
41  subroutine bar(a)
42    integer, allocatable, intent(inout)  :: a
43    if(.not. allocated(a)) STOP 12
44    if (a /= 5) STOP 13
45    a = 7
46  end subroutine bar
47
48  subroutine check3(a)
49    integer, allocatable, intent(inout)  :: a
50    if(allocated(a)) STOP 14
51    allocate(a)
52    a = 6874
53  end subroutine check3
54
55  subroutine check4(a)
56    integer, allocatable, intent(inout)  :: a
57    if(.not.allocated(a)) STOP 15
58    if (a /= 6874) STOP 1
59    deallocate(a)
60    if(allocated(a)) STOP 16
61    allocate(a)
62    if(.not.allocated(a)) STOP 17
63    a = -478
64  end subroutine check4
65
66  subroutine checkOptional(prsnt, alloc, val, x)
67    logical, intent(in) :: prsnt, alloc
68    integer, allocatable, optional :: x
69    integer, intent(in) :: val
70    if (present(x) .neqv. prsnt) STOP 18
71    if (present(x)) then
72      if (allocated(x) .neqv. alloc) STOP 19
73    end if
74    if (present(x)) then
75      if (allocated(x)) then
76        if (x /= val) STOP 20
77      end if
78    end if
79    call checkOptional2(x)
80    if (present(x)) then
81      if (.not. allocated(x)) STOP 21
82      if (x /= -6784) STOP 22
83      x = 46
84    end if
85    call checkOptional2()
86  end subroutine checkOptional
87  subroutine checkOptional2(x)
88    integer, allocatable, optional, intent(out) :: x
89    if (present(x)) then
90      if (allocated(x)) STOP 23
91      allocate(x)
92      x = -6784
93    end if
94  end subroutine checkOptional2
95end program test
96