OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [c_by_val_5.f90] - Blame information for rev 414

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { 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 :: 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
68
 
69
! { dg-final { cleanup-modules "x" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.