1! { dg-do run }
2! PR fortan/31692
3! Passing array valued results to procedures
4!
5! Test case contributed by rakuen_himawari@yahoo.co.jp
6module one
7  integer :: flag = 0
8contains
9  function foo1 (n)
10    integer :: n
11    integer :: foo1(n)
12    if (flag == 0) then
13      call bar1 (n, foo1)
14    else
15      call bar2 (n, foo1)
16    end if
17  end function
18
19  function foo2 (n)
20    implicit none
21    integer :: n
22    integer,ALLOCATABLE :: foo2(:)
23    allocate (foo2(n))
24    if (flag == 0) then
25      call bar1 (n, foo2)
26    else
27      call bar2 (n, foo2)
28    end if
29  end function
30
31  function foo3 (n)
32    implicit none
33    integer :: n
34    integer,ALLOCATABLE :: foo3(:)
35    allocate (foo3(n))
36    foo3 = 0
37    call bar2(n, foo3(2:(n-1)))  ! Check that sections are OK
38  end function
39
40  subroutine bar1 (n, array)     ! Checks assumed size formal arg.
41    integer :: n
42    integer :: array(*)
43    integer :: i
44    do i = 1, n
45      array(i) = i
46    enddo
47  end subroutine
48
49  subroutine bar2(n, array)     ! Checks assumed shape formal arg.
50    integer :: n
51    integer :: array(:)
52    integer :: i
53    do i = 1, size (array, 1)
54      array(i) = i
55    enddo
56   end subroutine
57end module
58
59program main
60  use one
61  integer :: n
62  n = 3
63  if(any (foo1(n) /= [ 1,2,3 ])) STOP 1
64  if(any (foo2(n) /= [ 1,2,3 ])) STOP 2
65  flag = 1
66  if(any (foo1(n) /= [ 1,2,3 ])) STOP 3
67  if(any (foo2(n) /= [ 1,2,3 ])) STOP 4
68  n = 5
69  if(any (foo3(n) /= [ 0,1,2,3,0 ])) STOP 5
70end program
71