From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/used_types_22.f90 | 294 ++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/used_types_22.f90 (limited to 'gcc/testsuite/gfortran.dg/used_types_22.f90') diff --git a/gcc/testsuite/gfortran.dg/used_types_22.f90 b/gcc/testsuite/gfortran.dg/used_types_22.f90 new file mode 100644 index 000000000..2a5ae451a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/used_types_22.f90 @@ -0,0 +1,294 @@ +! { 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" } } -- cgit v1.2.3