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