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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
! This tests the fix for PR32634, in which the generic interface
3
! in foo_pr_mod was given the original rather than the local name.
4
! This meant that the original name had to be used in the calll
5
! in foo_sub.
6
!
7
! Contributed by Salvatore Filippone 
8
 
9
module foo_base_mod
10
  type foo_dmt
11
    real(kind(1.d0)), allocatable  :: rv(:)
12
    integer, allocatable :: iv1(:), iv2(:)
13
  end type foo_dmt
14
  type foo_zmt
15
    complex(kind(1.d0)), allocatable  :: rv(:)
16
    integer, allocatable  :: iv1(:), iv2(:)
17
  end type foo_zmt
18
  type foo_cdt
19
     integer, allocatable :: md(:)
20
     integer, allocatable :: hi(:), ei(:)
21
  end type foo_cdt
22
end module foo_base_mod
23
 
24
module bar_prt
25
  use foo_base_mod, only : foo_dmt, foo_zmt, foo_cdt
26
  type bar_dbprt
27
    type(foo_dmt), allocatable :: av(:)
28
    real(kind(1.d0)), allocatable      :: d(:)
29
    type(foo_cdt)                :: cd
30
  end type bar_dbprt
31
  type bar_dprt
32
    type(bar_dbprt), allocatable  :: bpv(:)
33
  end type bar_dprt
34
  type bar_zbprt
35
    type(foo_zmt), allocatable :: av(:)
36
    complex(kind(1.d0)), allocatable   :: d(:)
37
    type(foo_cdt)                :: cd
38
  end type bar_zbprt
39
  type bar_zprt
40
    type(bar_zbprt), allocatable  :: bpv(:)
41
  end type bar_zprt
42
end module bar_prt
43
 
44
module bar_pr_mod
45
  use bar_prt
46
  interface bar_pwrk
47
    subroutine bar_dppwrk(pr,x,y,cd,info,trans,work)
48
      use foo_base_mod
49
      use bar_prt
50
      type(foo_cdt),intent(in)    :: cd
51
      type(bar_dprt), intent(in)  :: pr
52
      real(kind(0.d0)),intent(inout)    :: x(:), y(:)
53
      integer, intent(out)              :: info
54
      character(len=1), optional        :: trans
55
      real(kind(0.d0)),intent(inout), optional, target :: work(:)
56
    end subroutine bar_dppwrk
57
    subroutine bar_zppwrk(pr,x,y,cd,info,trans,work)
58
      use foo_base_mod
59
      use bar_prt
60
      type(foo_cdt),intent(in)    :: cd
61
      type(bar_zprt), intent(in)  :: pr
62
      complex(kind(0.d0)),intent(inout) :: x(:), y(:)
63
      integer, intent(out)              :: info
64
      character(len=1), optional        :: trans
65
      complex(kind(0.d0)),intent(inout), optional, target :: work(:)
66
    end subroutine bar_zppwrk
67
  end interface
68
end module bar_pr_mod
69
 
70
module foo_pr_mod
71
  use bar_prt, &
72
       & foo_dbprt  => bar_dbprt,&
73
       & foo_zbprt  => bar_zbprt,&
74
       & foo_dprt   => bar_dprt,&
75
       & foo_zprt   => bar_zprt
76
  use bar_pr_mod, &
77
       & foo_pwrk  => bar_pwrk
78
end module foo_pr_mod
79
 
80
Subroutine foo_sub(a,pr,b,x,eps,cd,info)
81
  use foo_base_mod
82
  use foo_pr_mod
83
  Implicit None
84
!!$  parameters
85
  Type(foo_dmt), Intent(in)  :: a
86
  Type(foo_dprt), Intent(in)   :: pr
87
  Type(foo_cdt), Intent(in)    :: cd
88
  Real(Kind(1.d0)), Intent(in)       :: b(:)
89
  Real(Kind(1.d0)), Intent(inout)    :: x(:)
90
  Real(Kind(1.d0)), Intent(in)       :: eps
91
  integer, intent(out)               :: info
92
!!$   Local data
93
  Real(Kind(1.d0)), allocatable, target   :: aux(:),wwrk(:,:)
94
  Real(Kind(1.d0)), allocatable   :: p(:), f(:)
95
  info = 0
96
  Call foo_pwrk(pr,p,f,cd,info,work=aux)  ! This worked if bar_pwrk was called!
97
  return
98
End Subroutine foo_sub
99
 
100
! { dg-final { cleanup-modules "foo_base_mod foo_pr_mod bar_pr_mod bar_prt" } }
101
 

powered by: WebSVN 2.1.0

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