diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/actual_array_result_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/actual_array_result_1.f90 | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/actual_array_result_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_result_1.f90 new file mode 100644 index 000000000..cf79315cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_array_result_1.f90 @@ -0,0 +1,71 @@ +! { dg-do run } +! PR fortan/31692 +! Passing array valued results to procedures +! +! Test case contributed by rakuen_himawari@yahoo.co.jp +module one + integer :: flag = 0 +contains + function foo1 (n) + integer :: n + integer :: foo1(n) + if (flag == 0) then + call bar1 (n, foo1) + else + call bar2 (n, foo1) + end if + end function + + function foo2 (n) + implicit none + integer :: n + integer,ALLOCATABLE :: foo2(:) + allocate (foo2(n)) + if (flag == 0) then + call bar1 (n, foo2) + else + call bar2 (n, foo2) + end if + end function + + function foo3 (n) + implicit none + integer :: n + integer,ALLOCATABLE :: foo3(:) + allocate (foo3(n)) + foo3 = 0 + call bar2(n, foo3(2:(n-1))) ! Check that sections are OK + end function + + subroutine bar1 (n, array) ! Checks assumed size formal arg. + integer :: n + integer :: array(*) + integer :: i + do i = 1, n + array(i) = i + enddo + end subroutine + + subroutine bar2(n, array) ! Checks assumed shape formal arg. + integer :: n + integer :: array(:) + integer :: i + do i = 1, size (array, 1) + array(i) = i + enddo + end subroutine +end module + +program main + use one + integer :: n + n = 3 + if(any (foo1(n) /= [ 1,2,3 ])) call abort() + if(any (foo2(n) /= [ 1,2,3 ])) call abort() + flag = 1 + if(any (foo1(n) /= [ 1,2,3 ])) call abort() + if(any (foo2(n) /= [ 1,2,3 ])) call abort() + n = 5 + if(any (foo3(n) /= [ 0,1,2,3,0 ])) call abort() +end program +! { dg-final { cleanup-modules "one" } } |