! { 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" } }