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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [import4.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Test for import in modules
3
! PR fortran/29601
4
 
5
subroutine bar(r)
6
  implicit none
7
  integer(8) :: r
8
  if(r /= 42) call abort()
9
  r = 13
10
end subroutine bar
11
 
12
subroutine foo(a)
13
  implicit none
14
  type myT
15
     sequence
16
     character(len=3) :: c
17
  end type myT
18
  type(myT) :: a
19
  if(a%c /= "xyz") call abort()
20
  a%c = "abc"
21
end subroutine
22
 
23
subroutine new(a,b)
24
  implicit none
25
  type gType
26
     sequence
27
     integer(8) :: c
28
  end type gType
29
  real(8) :: a
30
  type(gType) :: b
31
  if(a /= 99.0 .or. b%c /= 11) call abort()
32
  a = -123.0
33
  b%c = -44
34
end subroutine new
35
 
36
module general
37
  implicit none
38
  integer,parameter :: ikind = 8
39
  type gType
40
     sequence
41
     integer(ikind) :: c
42
  end type gType
43
end module general
44
 
45
module modtest
46
  use general
47
  implicit none
48
  type myT
49
     sequence
50
     character(len=3) :: c
51
  end type myT
52
  integer, parameter :: dp = 8
53
  interface
54
     subroutine bar(x)
55
       import :: dp
56
       integer(dp) :: x
57
     end subroutine bar
58
     subroutine foo(c)
59
      import :: myT
60
       type(myT) :: c
61
     end subroutine foo
62
     subroutine new(x,y)
63
      import :: ikind,gType
64
      real(ikind) :: x
65
      type(gType) :: y
66
     end subroutine new
67
  end interface
68
  contains
69
  subroutine test
70
    integer(dp) :: y
71
    y = 42
72
    call bar(y)
73
    if(y /= 13) call abort()
74
  end subroutine test
75
  subroutine test2()
76
    type(myT) :: z
77
    z%c = "xyz"
78
    call foo(z)
79
    if(z%c /= "abc") call abort()
80
  end subroutine test2
81
end module modtest
82
 
83
program all
84
  use modtest
85
  implicit none
86
  call test()
87
  call test2()
88
  call test3()
89
contains
90
  subroutine test3()
91
    real(ikind) :: r
92
    type(gType) :: t
93
    r   = 99.0
94
    t%c = 11
95
    call new(r,t)
96
    if(r /= -123.0 .or. t%c /= -44) call abort()
97
  end subroutine test3
98
end program all
99
! { dg-final { cleanup-modules "modtest general" } }

powered by: WebSVN 2.1.0

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