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/func_result_6.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/func_result_6.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/func_result_6.f90 | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/func_result_6.f90 b/gcc/testsuite/gfortran.dg/func_result_6.f90 new file mode 100644 index 000000000..e8347be58 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/func_result_6.f90 @@ -0,0 +1,73 @@ +! { dg-do run } +! +! PR fortran/47775 +! +! Contributed by Fran Martinez Fadrique +! +! Before, a temporary was missing for generic procedured (cf. test()) +! as the allocatable attribute was ignored for the check whether a +! temporary is required +! +module m +type t +contains + procedure, NOPASS :: foo => foo + generic :: gen => foo +end type t +contains + function foo(i) + integer, allocatable :: foo(:) + integer :: i + allocate(foo(2)) + foo(1) = i + foo(2) = i + 10 + end function foo +end module m + +use m +type(t) :: x +integer, pointer :: ptr1, ptr2 +integer, target :: bar1(2) +integer, target, allocatable :: bar2(:) + +allocate(bar2(2)) +ptr1 => bar1(2) +ptr2 => bar2(2) + +bar1 = x%gen(1) +if (ptr1 /= 11) call abort() +bar1 = x%foo(2) +if (ptr1 /= 12) call abort() +bar2 = x%gen(3) +if (ptr2 /= 13) call abort() +bar2 = x%foo(4) +if (ptr2 /= 14) call abort() +bar2(:) = x%gen(5) +if (ptr2 /= 15) call abort() +bar2(:) = x%foo(6) +if (ptr2 /= 16) call abort() + +call test() +end + +subroutine test +interface gen + procedure foo +end interface gen + +integer, target :: bar(2) +integer, pointer :: ptr +bar = [1,2] +ptr => bar(2) +if (ptr /= 2) call abort() +bar = gen() +if (ptr /= 77) call abort() +contains + function foo() ! { dg-warning "Extension: Internal procedure .foo. in generic interface" } + integer, allocatable :: foo(:) + allocate(foo(2)) + foo = [33, 77] + end function foo +end subroutine test + +! { dg-final { cleanup-modules "m" } } |