70 lines
1.5 KiB
Fortran
70 lines
1.5 KiB
Fortran
! { 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" } }
|