1! { dg-do run } 2! { dg-options "-fdump-tree-original" } 3! 4! PR fortran/48820 5! 6! Test TYPE(*) 7! 8 9module mod 10 use iso_c_binding, only: c_loc, c_ptr, c_bool 11 implicit none 12 interface my_c_loc 13 function my_c_loc1(x) bind(C) 14 import c_ptr 15 type(*) :: x 16 type(c_ptr) :: my_c_loc1 17 end function 18 function my_c_loc2(x) bind(C) 19 import c_ptr 20 type(*) :: x(*) 21 type(c_ptr) :: my_c_loc2 22 end function 23 end interface my_c_loc 24contains 25 subroutine sub_scalar (arg1, presnt) 26 type(*), target, optional :: arg1 27 logical :: presnt 28 type(c_ptr) :: cpt 29 if (presnt .neqv. present (arg1)) STOP 1 30 cpt = c_loc (arg1) 31 end subroutine sub_scalar 32 33 subroutine sub_array_shape (arg2, lbounds, ubounds) 34 type(*), target :: arg2(:,:) 35 type(c_ptr) :: cpt 36 integer :: lbounds(2), ubounds(2) 37 if (any (lbound(arg2) /= lbounds)) STOP 2 38 if (any (ubound(arg2) /= ubounds)) STOP 3 39 if (any (shape(arg2) /= ubounds-lbounds+1)) STOP 4 40 if (size(arg2) /= product (ubounds-lbounds+1)) STOP 5 41 if (rank (arg2) /= 2) STOP 6 42! if (.not. is_continuous (arg2)) STOP 7 !<< Not yet implemented 43! cpt = c_loc (arg2) ! << FIXME: Valid since TS29113 44 call sub_array_assumed (arg2) 45 end subroutine sub_array_shape 46 47 subroutine sub_array_assumed (arg3) 48 type(*), target :: arg3(*) 49 type(c_ptr) :: cpt 50 cpt = c_loc (arg3) 51 end subroutine sub_array_assumed 52end module 53 54use mod 55use iso_c_binding, only: c_int, c_null_ptr 56implicit none 57type t1 58 integer :: a 59end type t1 60type :: t2 61 sequence 62 integer :: b 63end type t2 64type, bind(C) :: t3 65 integer(c_int) :: c 66end type t3 67 68integer :: scalar_int 69real, allocatable :: scalar_real_alloc 70character, pointer :: scalar_char_ptr 71 72integer :: array_int(3) 73real, allocatable :: array_real_alloc(:,:) 74character, pointer :: array_char_ptr(:,:) 75 76type(t1) :: scalar_t1 77type(t2), allocatable :: scalar_t2_alloc 78type(t3), pointer :: scalar_t3_ptr 79 80type(t1) :: array_t1(4) 81type(t2), allocatable :: array_t2_alloc(:,:) 82type(t3), pointer :: array_t3_ptr(:,:) 83 84class(t1), allocatable :: scalar_class_t1_alloc 85class(t1), pointer :: scalar_class_t1_ptr 86 87class(t1), allocatable :: array_class_t1_alloc(:,:) 88class(t1), pointer :: array_class_t1_ptr(:,:) 89 90scalar_char_ptr => null() 91scalar_t3_ptr => null() 92 93call sub_scalar (presnt=.false.) 94call sub_scalar (scalar_real_alloc, .false.) 95call sub_scalar (scalar_char_ptr, .false.) 96call sub_scalar (null (), .false.) 97call sub_scalar (scalar_t2_alloc, .false.) 98call sub_scalar (scalar_t3_ptr, .false.) 99 100allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr) 101allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc) 102allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2)) 103allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2)) 104allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4)) 105 106call sub_scalar (scalar_int, .true.) 107call sub_scalar (scalar_real_alloc, .true.) 108call sub_scalar (scalar_char_ptr, .true.) 109call sub_scalar (array_int(2), .true.) 110call sub_scalar (array_real_alloc(3,2), .true.) 111call sub_scalar (array_char_ptr(0,1), .true.) 112call sub_scalar (scalar_t1, .true.) 113call sub_scalar (scalar_t2_alloc, .true.) 114call sub_scalar (scalar_t3_ptr, .true.) 115call sub_scalar (array_t1(2), .true.) 116call sub_scalar (array_t2_alloc(3,2), .true.) 117call sub_scalar (array_t3_ptr(0,1), .true.) 118call sub_scalar (array_class_t1_alloc(2,1), .true.) 119call sub_scalar (array_class_t1_ptr(3,3), .true.) 120 121call sub_array_assumed (array_int) 122call sub_array_assumed (array_real_alloc) 123call sub_array_assumed (array_char_ptr) 124call sub_array_assumed (array_t1) 125call sub_array_assumed (array_t2_alloc) 126call sub_array_assumed (array_t3_ptr) 127call sub_array_assumed (array_class_t1_alloc) 128call sub_array_assumed (array_class_t1_ptr) 129 130call sub_array_shape (array_real_alloc, [1,1], shape(array_real_alloc)) 131call sub_array_shape (array_char_ptr, [1,1], shape(array_char_ptr)) 132call sub_array_shape (array_t2_alloc, [1,1], shape(array_t2_alloc)) 133call sub_array_shape (array_t3_ptr, [1,1], shape(array_t3_ptr)) 134call sub_array_shape (array_class_t1_alloc, [1,1], shape(array_class_t1_alloc)) 135call sub_array_shape (array_class_t1_ptr, [1,1], shape(array_class_t1_ptr)) 136 137deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr) 138deallocate (array_class_t1_ptr, array_t3_ptr) 139 140end 141 142! { dg-final { scan-tree-dump-times "sub_scalar .0B," 2 "original" } } 143! { dg-final { scan-tree-dump-times "sub_scalar .scalar_real_alloc," 2 "original" } } 144! { dg-final { scan-tree-dump-times "sub_scalar .scalar_char_ptr," 2 "original" } } 145! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t2_alloc," 2 "original" } } 146! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t3_ptr" 2 "original" } } 147 148! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_int," 1 "original" } } 149! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } } 150! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } } 151! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } } 152 153! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } } 154! { dg-final { scan-tree-dump-times "sub_scalar .\\(character.kind=1..1:1. .\\) .array_char_ptr.data" 1 "original" } } 155! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } } 156! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t3 .\\) .array_t3_ptr.data" 1 "original" } } 157! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } } 158! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.dat" 1 "original" } } 159 160! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 4 "original" } } 161! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } } 162! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } } 163! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } } 164! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } } 165! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } } 166! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } } 167! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } } 168! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } } 169! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 0 "original" } } 170 171! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_real_alloc," 1 "original" } } 172! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_char_ptr," 1 "original" } } 173! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t2_alloc," 1 "original" } } 174! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t3_ptr," 1 "original" } } 175! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_alloc._data," 1 "original" } } 176! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_ptr._data," 1 "original" } } 177 178