diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/actual_array_result_1.f90 | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
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" } } |