summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/c_by_val_5.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/c_by_val_5.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.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/c_by_val_5.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/c_by_val_5.f9069
1 files changed, 69 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
new file mode 100644
index 000000000..90ef299aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! Overwrite -pedantic setting:
+! { dg-options "-Wall" }
+!
+! Tests the fix for PR31668, in which %VAL was rejected for
+! module and internal procedures.
+!
+
+subroutine bmp_write(nx)
+ implicit none
+ integer, value :: nx
+ if(nx /= 10) call abort()
+ nx = 11
+ if(nx /= 11) call abort()
+end subroutine bmp_write
+
+module x
+ implicit none
+ ! The following interface does in principle
+ ! not match the procedure (missing VALUE attribute)
+ ! However, this occures in real-world code calling
+ ! C routines where an interface is better than
+ ! "external" only.
+ interface
+ subroutine bmp_write(nx)
+ integer :: nx
+ end subroutine bmp_write
+ end interface
+contains
+ SUBROUTINE Grid2BMP(NX)
+ INTEGER, INTENT(IN) :: NX
+ if(nx /= 10) call abort()
+ call bmp_write(%val(nx))
+ if(nx /= 10) call abort()
+ END SUBROUTINE Grid2BMP
+END module x
+
+! The following test is possible and
+! accepted by other compilers, but
+! does not make much sense.
+! Either one uses VALUE then %VAL is
+! not needed or the function will give
+! wrong results.
+!
+!subroutine test()
+! implicit none
+! integer :: n
+! n = 5
+! if(n /= 5) call abort()
+! call test2(%VAL(n))
+! if(n /= 5) call abort()
+! contains
+! subroutine test2(a)
+! integer, value :: a
+! if(a /= 5) call abort()
+! a = 2
+! if(a /= 2) call abort()
+! end subroutine test2
+!end subroutine test
+
+program main
+ use x
+ implicit none
+! external test
+ call Grid2BMP(10)
+! call test()
+end program main
+
+! { dg-final { cleanup-modules "x" } }