1! { dg-do run } 2! Overwrite -pedantic setting: 3! { dg-options "-Wall" } 4! 5! Tests the fix for PR31668, in which %VAL was rejected for 6! module and internal procedures. 7! 8 9subroutine bmp_write(nx) 10 implicit none 11 integer, value :: nx 12 if(nx /= 10) call abort() 13 nx = 11 14 if(nx /= 11) call abort() 15end subroutine bmp_write 16 17module x 18 implicit none 19 ! The following interface does in principle 20 ! not match the procedure (missing VALUE attribute) 21 ! However, this occures in real-world code calling 22 ! C routines where an interface is better than 23 ! "external" only. 24 interface 25 subroutine bmp_write(nx) 26 integer, value :: nx 27 end subroutine bmp_write 28 end interface 29contains 30 SUBROUTINE Grid2BMP(NX) 31 INTEGER, INTENT(IN) :: NX 32 if(nx /= 10) call abort() 33 call bmp_write(%val(nx)) 34 if(nx /= 10) call abort() 35 END SUBROUTINE Grid2BMP 36END module x 37 38! The following test is possible and 39! accepted by other compilers, but 40! does not make much sense. 41! Either one uses VALUE then %VAL is 42! not needed or the function will give 43! wrong results. 44! 45!subroutine test() 46! implicit none 47! integer :: n 48! n = 5 49! if(n /= 5) call abort() 50! call test2(%VAL(n)) 51! if(n /= 5) call abort() 52! contains 53! subroutine test2(a) 54! integer, value :: a 55! if(a /= 5) call abort() 56! a = 2 57! if(a /= 2) call abort() 58! end subroutine test2 59!end subroutine test 60 61program main 62 use x 63 implicit none 64! external test 65 call Grid2BMP(10) 66! call test() 67end program main 68