! { dg-do run } ! ! PR fortran/48820 ! ! Test TYPE(*) ! module mod use iso_c_binding, only: c_loc, c_ptr, c_bool implicit none interface my_c_loc function my_c_loc1(x) bind(C) import c_ptr type(*) :: x type(c_ptr) :: my_c_loc1 end function function my_c_loc2(x) bind(C) import c_ptr type(*) :: x(*) type(c_ptr) :: my_c_loc2 end function end interface my_c_loc contains subroutine sub_scalar (arg1, presnt) type(*), target, optional :: arg1 logical :: presnt type(c_ptr) :: cpt if (presnt .neqv. present (arg1)) STOP 1 cpt = c_loc (arg1) end subroutine sub_scalar subroutine sub_array_shape (arg2, lbounds, ubounds) type(*), target :: arg2(:,:) type(c_ptr) :: cpt integer :: lbounds(2), ubounds(2) if (any (lbound(arg2) /= lbounds)) STOP 2 if (any (ubound(arg2) /= ubounds)) STOP 3 if (any (shape(arg2) /= ubounds-lbounds+1)) STOP 4 if (size(arg2) /= product (ubounds-lbounds+1)) STOP 5 if (rank (arg2) /= 2) STOP 6 ! if (.not. is_continuous (arg2)) STOP 7 !<< Not yet implemented ! cpt = c_loc (arg2) ! << FIXME: Valid since TS29113 call sub_array_assumed (arg2) end subroutine sub_array_shape subroutine sub_array_assumed (arg3) type(*), target :: arg3(*) type(c_ptr) :: cpt cpt = c_loc (arg3) end subroutine sub_array_assumed end module use mod use iso_c_binding, only: c_int, c_null_ptr implicit none type t1 integer :: a end type t1 type :: t2 sequence integer :: b end type t2 type, bind(C) :: t3 integer(c_int) :: c end type t3 integer :: scalar_int real, allocatable :: scalar_real_alloc character, pointer :: scalar_char_ptr integer :: array_int(3) real, allocatable :: array_real_alloc(:,:) character, pointer :: array_char_ptr(:,:) type(t1) :: scalar_t1 type(t2), allocatable :: scalar_t2_alloc type(t3), pointer :: scalar_t3_ptr type(t1) :: array_t1(4) type(t2), allocatable :: array_t2_alloc(:,:) type(t3), pointer :: array_t3_ptr(:,:) class(t1), allocatable :: scalar_class_t1_alloc class(t1), pointer :: scalar_class_t1_ptr class(t1), allocatable :: array_class_t1_alloc(:,:) class(t1), pointer :: array_class_t1_ptr(:,:) scalar_char_ptr => null() scalar_t3_ptr => null() call sub_scalar (presnt=.false.) call sub_scalar (scalar_real_alloc, .false.) call sub_scalar (scalar_char_ptr, .false.) call sub_scalar (null (), .false.) call sub_scalar (scalar_t2_alloc, .false.) call sub_scalar (scalar_t3_ptr, .false.) allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr) allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc) allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2)) allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2)) allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4)) call sub_scalar (scalar_int, .true.) call sub_scalar (scalar_real_alloc, .true.) call sub_scalar (scalar_char_ptr, .true.) call sub_scalar (array_int(2), .true.) call sub_scalar (array_real_alloc(3,2), .true.) call sub_scalar (array_char_ptr(0,1), .true.) call sub_scalar (scalar_t1, .true.) call sub_scalar (scalar_t2_alloc, .true.) call sub_scalar (scalar_t3_ptr, .true.) call sub_scalar (array_t1(2), .true.) call sub_scalar (array_t2_alloc(3,2), .true.) call sub_scalar (array_t3_ptr(0,1), .true.) call sub_scalar (array_class_t1_alloc(2,1), .true.) call sub_scalar (array_class_t1_ptr(3,3), .true.) call sub_array_assumed (array_int) call sub_array_assumed (array_real_alloc) call sub_array_assumed (array_char_ptr) call sub_array_assumed (array_t1) call sub_array_assumed (array_t2_alloc) call sub_array_assumed (array_t3_ptr) call sub_array_assumed (array_class_t1_alloc) call sub_array_assumed (array_class_t1_ptr) call sub_array_shape (array_real_alloc, [1,1], shape(array_real_alloc)) call sub_array_shape (array_char_ptr, [1,1], shape(array_char_ptr)) call sub_array_shape (array_t2_alloc, [1,1], shape(array_t2_alloc)) call sub_array_shape (array_t3_ptr, [1,1], shape(array_t3_ptr)) call sub_array_shape (array_class_t1_alloc, [1,1], shape(array_class_t1_alloc)) call sub_array_shape (array_class_t1_ptr, [1,1], shape(array_class_t1_ptr)) deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr) deallocate (array_class_t1_ptr, array_t3_ptr) end