gcc/testsuite/gfortran.dg/used_types_22.f90

   1 ! { 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  <sfilippone@uniroma2.it>
   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