1! { dg-do compile} 2! 3! TS 29113 4! C407b An assumed-type variable name shall not appear in a designator 5! or expression except as an actual argument corresponding to a dummy 6! argument that is assumed-type, or as the first argument to any of 7! the intrinsic and intrinsic module functions IS_CONTIGUOUS, LBOUND, 8! PRESENT, RANK, SHAPE, SIZE, UBOUND, and C_LOC. 9! 10! This test file contains tests that are expected to all pass. 11 12! Check that passing an assumed-type variable as an actual argument 13! corresponding to an assumed-type dummy works. 14 15module m 16 interface 17 subroutine g (a, b) 18 implicit none 19 type(*) :: a 20 integer :: b 21 end subroutine 22 end interface 23end module 24 25subroutine s0 (x) 26 use m 27 implicit none 28 type(*) :: x 29 30 call g (x, 1) 31end subroutine 32 33! Check that calls to the permitted intrinsic functions work. 34 35function test_is_contiguous (a) 36 implicit none 37 type(*) :: a(*) 38 logical :: test_is_contiguous 39 40 test_is_contiguous = is_contiguous (a) 41end function 42 43function test_lbound (a) 44 implicit none 45 type(*) :: a(:) 46 integer :: test_lbound 47 48 test_lbound = lbound (a, 1) 49end function 50 51function test_present (a) 52 implicit none 53 type(*), optional :: a(*) 54 logical :: test_present 55 56 test_present = present (a) 57end function 58 59function test_rank (a) 60 implicit none 61 type(*) :: a(*) 62 integer :: test_rank 63 64 test_rank = rank (a) 65end function 66 67function test_shape (a) 68 implicit none 69 type(*) :: a(:) ! assumed-shape array so shape intrinsic works 70 integer :: test_shape 71 72 integer :: temp, i 73 integer, dimension (rank (a)) :: ashape 74 75 temp = 1 76 ashape = shape (a) 77 do i = 1, rank (a) 78 temp = temp * ashape (i) 79 end do 80 test_shape = temp 81end function 82 83function test_size (a) 84 implicit none 85 type(*) :: a(:) 86 integer :: test_size 87 88 test_size = size (a) 89end function 90 91function test_ubound (a) 92 implicit none 93 type(*) :: a(:) 94 integer :: test_ubound 95 96 test_ubound = ubound (a, 1) 97end function 98 99function test_c_loc (a) 100 use iso_c_binding 101 implicit none 102 type(*), target :: a(*) 103 type(c_ptr) :: test_c_loc 104 105 test_c_loc = c_loc (a) 106end function 107 108