gcc/testsuite/gfortran.dg/c_by_val_5.f90

   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
   9 subroutine 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()
  15 end subroutine bmp_write
  16
  17 module 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
  29 contains
  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
  36 END 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
  61 program main
  62   use x
  63   implicit none
  64 !  external test
  65   call Grid2BMP(10)
  66 !  call test()
  67 end program main