1! { dg-do run } 2! { dg-additional-sources assumed_rank_8_c.c } 3! 4! PR fortran/48820 5! 6! Scalars to assumed-rank tests 7! 8program main 9 implicit none 10 11 type t 12 integer :: i 13 end type t 14 15 interface 16 subroutine check (x) 17 integer :: x(..) 18 end subroutine check 19 subroutine check2 (x) 20 import t 21 class(t) :: x(..) 22 end subroutine check2 23 end interface 24 25 integer :: j 26 27 type(t), target :: y 28 class(t), allocatable, target :: yac 29 30 y%i = 489 31 allocate (yac) 32 yac%i = 489 33 j = 0 34 call fc() 35 call fc(null()) 36 call fc(y) 37 call fc(yac) 38 if (j /= 2) call abort () 39 40 j = 0 41 call gc(null()) 42 call gc(y) 43 call gc(yac) 44 deallocate (yac) 45 call gc(yac) 46 if (j /= 2) call abort () 47 48 j = 0 49 call hc(yac) 50 allocate (yac) 51 yac%i = 489 52 call hc(yac) 53 if (j /= 1) call abort () 54 55 j = 0 56 call ft() 57 call ft(null()) 58 call ft(y) 59 call ft(yac) 60 if (j /= 2) call abort () 61 62 j = 0 63 call gt(null()) 64 call gt(y) 65 call gt(yac) 66 deallocate (yac) 67 call gt(yac) 68 if (j /= 2) call abort () 69 70 j = 0 71 call ht(yac) 72 allocate (yac) 73 yac%i = 489 74 call ht(yac) 75 if (j /= 1) call abort () 76 77contains 78 79 subroutine fc (x) 80 class(t), optional :: x(..) 81 82 if (.not. present (x)) return 83 if (.not. SAME_TYPE_AS (x, yac)) call abort () 84 if (rank (x) /= 0) call abort 85 call check2 (x) 86 j = j + 1 87 end subroutine 88 89 subroutine gc (x) 90 class(t), pointer, intent(in) :: x(..) 91 92 if (.not. associated (x)) return 93 if (.not. SAME_TYPE_AS (x, yac)) call abort () 94 if (rank (x) /= 0) call abort () 95 call check2 (x) 96 j = j + 1 97 end subroutine 98 99 subroutine hc (x) 100 class(t), allocatable :: x(..) 101 102 if (.not. allocated (x)) return 103 if (.not. SAME_TYPE_AS (x, yac)) call abort () 104 if (rank (x) /= 0) call abort 105 call check2 (x) 106 j = j + 1 107 end subroutine 108 109 subroutine ft (x) 110 type(t), optional :: x(..) 111 112 if (.not. present (x)) return 113 if (.not. SAME_TYPE_AS (x, yac)) call abort () 114 if (rank (x) /= 0) call abort 115 call check2 (x) 116 j = j + 1 117 end subroutine 118 119 subroutine gt (x) 120 type(t), pointer, intent(in) :: x(..) 121 122 if (.not. associated (x)) return 123 if (.not. SAME_TYPE_AS (x, yac)) call abort () 124 if (rank (x) /= 0) call abort () 125 call check2 (x) 126 j = j + 1 127 end subroutine 128 129 subroutine ht (x) 130 type(t), allocatable :: x(..) 131 132 if (.not. allocated (x)) return 133 if (.not. SAME_TYPE_AS (x, yac)) call abort () 134 if (rank (x) /= 0) call abort 135 call check2 (x) 136 j = j + 1 137 end subroutine 138 139end program main 140