URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [used_types_22.f90] - Blame information for rev 384

Details | Compare with Previous | View Log


! { dg-do compile }
! Tests the fix for PR37274 a regression in which the derived type,
! 'vector' of the function results contained in 'class_motion' is
! private and is incorrectly detected to be ambiguous in 'smooth_mesh'.
!
! Contributed by Salvatore Filippone  
!
module class_vector
 
  implicit none
 
  private ! Default
  public :: vector
  public :: vector_
 
  type vector
     private
     real(kind(1.d0)) :: x
     real(kind(1.d0)) :: y
     real(kind(1.d0)) :: z
  end type vector
 
contains
  ! ----- Constructors -----
 
  ! Public default constructor
  elemental function vector_(x,y,z)
    type(vector) :: vector_
    real(kind(1.d0)), intent(in) :: x, y, z
 
    vector_ = vector(x,y,z)
 
  end function vector_
 
end module class_vector
 
module class_dimensions
 
  implicit none
 
  private ! Default
  public :: dimensions
 
  type dimensions
     private
     integer :: l
     integer :: m
     integer :: t
     integer :: theta
  end type dimensions
 
 
end module class_dimensions
 
module tools_math
 
  implicit none
 
 
  interface lin_interp
     function lin_interp_s(f1,f2,fac)
       real(kind(1.d0)) :: lin_interp_s
       real(kind(1.d0)), intent(in) :: f1, f2
       real(kind(1.d0)), intent(in) :: fac
     end function lin_interp_s
 
     function lin_interp_v(f1,f2,fac)
       use class_vector
       type(vector) :: lin_interp_v
       type(vector),     intent(in) :: f1, f2
       real(kind(1.d0)), intent(in) :: fac
     end function lin_interp_v
  end interface
 
 
  interface pwl_deriv
     subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)
       real(kind(1.d0)), intent(out) :: dydx
       real(kind(1.d0)), intent(in) :: x
       real(kind(1.d0)), intent(in) :: y_data(:)
       real(kind(1.d0)), intent(in) :: x_data(:)
     end subroutine pwl_deriv_x_s
 
     subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)
       real(kind(1.d0)), intent(out) :: dydx(:)
       real(kind(1.d0)), intent(in) :: x
       real(kind(1.d0)), intent(in) :: y_data(:,:)
       real(kind(1.d0)), intent(in) :: x_data(:)
     end subroutine pwl_deriv_x_v
 
     subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)
       use class_vector
       type(vector), intent(out) :: dydx
       real(kind(1.d0)), intent(in) :: x
       type(vector), intent(in) :: y_data(:)
       real(kind(1.d0)), intent(in) :: x_data(:)
     end subroutine pwl_deriv_x_vec
  end interface
 
end module tools_math
 
module class_motion
 
  use class_vector
 
  implicit none
 
  private
  public :: motion
  public :: get_displacement, get_velocity
 
  type motion
     private
     integer :: surface_motion
     integer :: vertex_motion
     !
     integer :: iml
     real(kind(1.d0)), allocatable :: law_x(:)
     type(vector), allocatable :: law_y(:)
  end type motion
 
contains
 
 
  function get_displacement(mot,x1,x2)
    use tools_math
 
    type(vector) :: get_displacement
    type(motion), intent(in) :: mot
    real(kind(1.d0)), intent(in) :: x1, x2
    !
    integer :: i1, i2, i3, i4
    type(vector) :: p1, p2, v_A, v_B, v_C, v_D
    type(vector) :: i_trap_1, i_trap_2, i_trap_3
 
    get_displacement = vector_(0.d0,0.d0,0.d0)
 
  end function get_displacement
 
 
  function get_velocity(mot,x)
    use tools_math
 
    type(vector) :: get_velocity
    type(motion), intent(in) :: mot
    real(kind(1.d0)), intent(in) :: x
    !
    type(vector) :: v
 
    get_velocity = vector_(0.d0,0.d0,0.d0)
 
  end function get_velocity
 
 
 
end module class_motion
 
module class_bc_math
 
  implicit none
 
  private
  public :: bc_math
 
  type bc_math
     private
     integer :: id
     integer :: nbf
     real(kind(1.d0)), allocatable :: a(:)
     real(kind(1.d0)), allocatable :: b(:)
     real(kind(1.d0)), allocatable :: c(:)
  end type bc_math
 
 
end module class_bc_math
 
module class_bc
 
  use class_bc_math
  use class_motion
 
  implicit none
 
  private
  public :: bc_poly
  public :: get_abc, &
       &    get_displacement, get_velocity
 
  type bc_poly
     private
     integer :: id
     type(motion) :: mot
     type(bc_math), pointer :: math => null()
  end type bc_poly
 
 
  interface get_displacement
     module procedure get_displacement, get_bc_motion_displacement
  end interface
 
  interface get_velocity
     module procedure get_velocity, get_bc_motion_velocity
  end interface
 
  interface get_abc
     module procedure get_abc_s, get_abc_v
  end interface
 
contains
 
 
  subroutine get_abc_s(bc,dim,id,a,b,c)
    use class_dimensions
 
    type(bc_poly), intent(in) :: bc
    type(dimensions), intent(in) :: dim
    integer, intent(out) :: id
    real(kind(1.d0)), intent(inout) :: a(:)
    real(kind(1.d0)), intent(inout) :: b(:)
    real(kind(1.d0)), intent(inout) :: c(:)
 
 
  end subroutine get_abc_s
 
 
  subroutine get_abc_v(bc,dim,id,a,b,c)
    use class_dimensions
    use class_vector
 
    type(bc_poly), intent(in) :: bc
    type(dimensions), intent(in) :: dim
    integer, intent(out) :: id
    real(kind(1.d0)), intent(inout) :: a(:)
    real(kind(1.d0)), intent(inout) :: b(:)
    type(vector),     intent(inout) :: c(:)
 
 
  end subroutine get_abc_v
 
 
 
  function get_bc_motion_displacement(bc,x1,x2)result(res)
    use class_vector
    type(vector) :: res
    type(bc_poly), intent(in) :: bc
    real(kind(1.d0)), intent(in) :: x1, x2
 
    res = get_displacement(bc%mot,x1,x2)
 
  end function get_bc_motion_displacement
 
 
  function get_bc_motion_velocity(bc,x)result(res)
    use class_vector
    type(vector) :: res
    type(bc_poly), intent(in) :: bc
    real(kind(1.d0)), intent(in) :: x
 
    res = get_velocity(bc%mot,x)
 
  end function get_bc_motion_velocity
 
 
end module class_bc
 
module tools_mesh_basics
 
  implicit none
 
  interface
     function geom_tet_center(v1,v2,v3,v4)
       use class_vector
       type(vector) :: geom_tet_center
       type(vector), intent(in) :: v1, v2, v3, v4
     end function geom_tet_center
  end interface
 
 
end module tools_mesh_basics
 
 
subroutine smooth_mesh
 
  use class_bc
  use class_vector
  use tools_mesh_basics
 
  implicit none
 
  type(vector) :: new_pos  ! the new vertex position, after smoothing
 
end subroutine smooth_mesh
! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }
! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [used_types_22.f90] - Blame information for rev 384

Line No.	Rev	Author	Line
1	302	jeremybenn	`! { dg-do compile }`
2			`! Tests the fix for PR37274 a regression in which the derived type,`
3			`! 'vector' of the function results contained in 'class_motion' is`
4			`! private and is incorrectly detected to be ambiguous in 'smooth_mesh'.`
5			`!`
6			`! Contributed by Salvatore Filippone`
7			`!`
8			`module class_vector`
9
10			`implicit none`
11
12			`private ! Default`
13			`public :: vector`
14			`public :: vector_`
15
16			`type vector`
17			`private`
18			`real(kind(1.d0)) :: x`
19			`real(kind(1.d0)) :: y`
20			`real(kind(1.d0)) :: z`
21			`end type vector`
22
23			`contains`
24			`! ----- Constructors -----`
25
26			`! Public default constructor`
27			`elemental function vector_(x,y,z)`
28			`type(vector) :: vector_`
29			`real(kind(1.d0)), intent(in) :: x, y, z`
30
31			`vector_ = vector(x,y,z)`
32
33			`end function vector_`
34
35			`end module class_vector`
36
37			`module class_dimensions`
38
39			`implicit none`
40
41			`private ! Default`
42			`public :: dimensions`
43
44			`type dimensions`
45			`private`
46			`integer :: l`
47			`integer :: m`
48			`integer :: t`
49			`integer :: theta`
50			`end type dimensions`
51
52
53			`end module class_dimensions`
54
55			`module tools_math`
56
57			`implicit none`
58
59
60			`interface lin_interp`
61			`function lin_interp_s(f1,f2,fac)`
62			`real(kind(1.d0)) :: lin_interp_s`
63			`real(kind(1.d0)), intent(in) :: f1, f2`
64			`real(kind(1.d0)), intent(in) :: fac`
65			`end function lin_interp_s`
66
67			`function lin_interp_v(f1,f2,fac)`
68			`use class_vector`
69			`type(vector) :: lin_interp_v`
70			`type(vector), intent(in) :: f1, f2`
71			`real(kind(1.d0)), intent(in) :: fac`
72			`end function lin_interp_v`
73			`end interface`
74
75
76			`interface pwl_deriv`
77			`subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)`
78			`real(kind(1.d0)), intent(out) :: dydx`
79			`real(kind(1.d0)), intent(in) :: x`
80			`real(kind(1.d0)), intent(in) :: y_data(:)`
81			`real(kind(1.d0)), intent(in) :: x_data(:)`
82			`end subroutine pwl_deriv_x_s`
83
84			`subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)`
85			`real(kind(1.d0)), intent(out) :: dydx(:)`
86			`real(kind(1.d0)), intent(in) :: x`
87			`real(kind(1.d0)), intent(in) :: y_data(:,:)`
88			`real(kind(1.d0)), intent(in) :: x_data(:)`
89			`end subroutine pwl_deriv_x_v`
90
91			`subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)`
92			`use class_vector`
93			`type(vector), intent(out) :: dydx`
94			`real(kind(1.d0)), intent(in) :: x`
95			`type(vector), intent(in) :: y_data(:)`
96			`real(kind(1.d0)), intent(in) :: x_data(:)`
97			`end subroutine pwl_deriv_x_vec`
98			`end interface`
99
100			`end module tools_math`
101
102			`module class_motion`
103
104			`use class_vector`
105
106			`implicit none`
107
108			`private`
109			`public :: motion`
110			`public :: get_displacement, get_velocity`
111
112			`type motion`
113			`private`
114			`integer :: surface_motion`
115			`integer :: vertex_motion`
116			`!`
117			`integer :: iml`
118			`real(kind(1.d0)), allocatable :: law_x(:)`
119			`type(vector), allocatable :: law_y(:)`
120			`end type motion`
121
122			`contains`
123
124
125			`function get_displacement(mot,x1,x2)`
126			`use tools_math`
127
128			`type(vector) :: get_displacement`
129			`type(motion), intent(in) :: mot`
130			`real(kind(1.d0)), intent(in) :: x1, x2`
131			`!`
132			`integer :: i1, i2, i3, i4`
133			`type(vector) :: p1, p2, v_A, v_B, v_C, v_D`
134			`type(vector) :: i_trap_1, i_trap_2, i_trap_3`
135
136			`get_displacement = vector_(0.d0,0.d0,0.d0)`
137
138			`end function get_displacement`
139
140
141			`function get_velocity(mot,x)`
142			`use tools_math`
143
144			`type(vector) :: get_velocity`
145			`type(motion), intent(in) :: mot`
146			`real(kind(1.d0)), intent(in) :: x`
147			`!`
148			`type(vector) :: v`
149
150			`get_velocity = vector_(0.d0,0.d0,0.d0)`
151
152			`end function get_velocity`
153
154
155
156			`end module class_motion`
157
158			`module class_bc_math`
159
160			`implicit none`
161
162			`private`
163			`public :: bc_math`
164
165			`type bc_math`
166			`private`
167			`integer :: id`
168			`integer :: nbf`
169			`real(kind(1.d0)), allocatable :: a(:)`
170			`real(kind(1.d0)), allocatable :: b(:)`
171			`real(kind(1.d0)), allocatable :: c(:)`
172			`end type bc_math`
173
174
175			`end module class_bc_math`
176
177			`module class_bc`
178
179			`use class_bc_math`
180			`use class_motion`
181
182			`implicit none`
183
184			`private`
185			`public :: bc_poly`
186			`public :: get_abc, &`
187			`& get_displacement, get_velocity`
188
189			`type bc_poly`
190			`private`
191			`integer :: id`
192			`type(motion) :: mot`
193			`type(bc_math), pointer :: math => null()`
194			`end type bc_poly`
195
196
197			`interface get_displacement`
198			`module procedure get_displacement, get_bc_motion_displacement`
199			`end interface`
200
201			`interface get_velocity`
202			`module procedure get_velocity, get_bc_motion_velocity`
203			`end interface`
204
205			`interface get_abc`
206			`module procedure get_abc_s, get_abc_v`
207			`end interface`
208
209			`contains`
210
211
212			`subroutine get_abc_s(bc,dim,id,a,b,c)`
213			`use class_dimensions`
214
215			`type(bc_poly), intent(in) :: bc`
216			`type(dimensions), intent(in) :: dim`
217			`integer, intent(out) :: id`
218			`real(kind(1.d0)), intent(inout) :: a(:)`
219			`real(kind(1.d0)), intent(inout) :: b(:)`
220			`real(kind(1.d0)), intent(inout) :: c(:)`
221
222
223			`end subroutine get_abc_s`
224
225
226			`subroutine get_abc_v(bc,dim,id,a,b,c)`
227			`use class_dimensions`
228			`use class_vector`
229
230			`type(bc_poly), intent(in) :: bc`
231			`type(dimensions), intent(in) :: dim`
232			`integer, intent(out) :: id`
233			`real(kind(1.d0)), intent(inout) :: a(:)`
234			`real(kind(1.d0)), intent(inout) :: b(:)`
235			`type(vector), intent(inout) :: c(:)`
236
237
238			`end subroutine get_abc_v`
239
240
241
242			`function get_bc_motion_displacement(bc,x1,x2)result(res)`
243			`use class_vector`
244			`type(vector) :: res`
245			`type(bc_poly), intent(in) :: bc`
246			`real(kind(1.d0)), intent(in) :: x1, x2`
247
248			`res = get_displacement(bc%mot,x1,x2)`
249
250			`end function get_bc_motion_displacement`
251
252
253			`function get_bc_motion_velocity(bc,x)result(res)`
254			`use class_vector`
255			`type(vector) :: res`
256			`type(bc_poly), intent(in) :: bc`
257			`real(kind(1.d0)), intent(in) :: x`
258
259			`res = get_velocity(bc%mot,x)`
260
261			`end function get_bc_motion_velocity`
262
263
264			`end module class_bc`
265
266			`module tools_mesh_basics`
267
268			`implicit none`
269
270			`interface`
271			`function geom_tet_center(v1,v2,v3,v4)`
272			`use class_vector`
273			`type(vector) :: geom_tet_center`
274			`type(vector), intent(in) :: v1, v2, v3, v4`
275			`end function geom_tet_center`
276			`end interface`
277
278
279			`end module tools_mesh_basics`
280
281
282			`subroutine smooth_mesh`
283
284			`use class_bc`
285			`use class_vector`
286			`use tools_mesh_basics`
287
288			`implicit none`
289
290			`type(vector) :: new_pos ! the new vertex position, after smoothing`
291
292			`end subroutine smooth_mesh`
293			`! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }`
294			`! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }`