From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; 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. --- gcc/testsuite/gfortran.dg/allocate_stat.f90 | 76 +++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/allocate_stat.f90 (limited to 'gcc/testsuite/gfortran.dg/allocate_stat.f90') diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90 new file mode 100644 index 000000000..7f9eaf58d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90 @@ -0,0 +1,76 @@ +! { dg-do compile } +! PR fortran/32936 +! +! +function all_res() + implicit none + real, pointer :: gain + integer :: all_res + allocate (gain,STAT=all_res) + deallocate(gain) + call bar() +contains + subroutine bar() + real, pointer :: gain2 + allocate (gain2,STAT=all_res) + deallocate(gain2) + end subroutine bar +end function all_res + +function func() + implicit none + real, pointer :: gain + integer :: all_res2, func + func = 0 +entry all_res2 + allocate (gain,STAT=all_res2) + deallocate(gain) +contains + subroutine test + implicit none + real, pointer :: gain2 + allocate (gain2,STAT=all_res2) + deallocate(gain2) + end subroutine test +end function func + +function func2() result(res) + implicit none + real, pointer :: gain + integer :: res + allocate (gain,STAT=func2) ! { dg-error "is not a variable" } + deallocate(gain) + res = 0 +end function func2 + +subroutine sub() + implicit none + interface + integer function func2() + end function + end interface + real, pointer :: gain + integer, parameter :: res = 2 + allocate (gain,STAT=func2) ! { dg-error "is not a variable" } + deallocate(gain) +end subroutine sub + +module test +contains + function one() + integer :: one, two + integer, pointer :: ptr + allocate(ptr, stat=one) + if(one == 0) deallocate(ptr) + entry two + allocate(ptr, stat=two) + if(associated(ptr)) deallocate(ptr) + end function one + subroutine sub() + integer, pointer :: p + allocate(p, stat=one) ! { dg-error "is not a variable" } + if(associated(p)) deallocate(p) + allocate(p, stat=two) ! { dg-error "is not a variable" } + if(associated(p)) deallocate(p) + end subroutine sub +end module test -- cgit v1.2.3