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