1! { dg-do run } 2! 3! Automatic reallocate on assignment, deferred length parameter for char 4! 5! PR fortran/45170 6! PR fortran/35810 7! PR fortran/47350 8! 9! Contributed by Tobias Burnus <burnus@gcc.gnu.org> 10! 11program test 12 implicit none 13 call mold_check() 14 call mold_check4() 15 call source_check() 16 call source_check4() 17 call ftn_test() 18 call ftn_test4() 19 call source3() 20contains 21 subroutine source_check() 22 character(len=:), allocatable :: str, str2 23 target :: str 24 character(len=8) :: str3 25 character(len=:), pointer :: str4, str5 26 nullify(str4) 27 str3 = 'AbCdEfGhIj' 28 if(allocated(str)) call abort() 29 allocate(str, source=str3) 30 if(.not.allocated(str)) call abort() 31 if(len(str) /= 8) call abort() 32 if(str /= 'AbCdEfGh') call abort() 33 if(associated(str4)) call abort() 34 str4 => str 35 if(str4 /= str .or. len(str4)/=8) call abort() 36 if(.not.associated(str4, str)) call abort() 37 str4 => null() 38 str = '12a56b78' 39 if(str4 == '12a56b78') call abort() 40 str4 = 'ABCDEFGH' 41 if(str == 'ABCDEFGH') call abort() 42 allocate(str5, source=str) 43 if(associated(str5, str)) call abort() 44 if(str5 /= '12a56b78' .or. len(str5)/=8) call abort() 45 str = 'abcdef' 46 if(str5 == 'abcdef') call abort() 47 str5 = 'ABCDEF' 48 if(str == 'ABCDEF') call abort() 49 end subroutine source_check 50 subroutine source_check4() 51 character(kind=4,len=:), allocatable :: str, str2 52 target :: str 53 character(kind=4,len=8) :: str3 54 character(kind=4,len=:), pointer :: str4, str5 55 nullify(str4) 56 str3 = 4_'AbCdEfGhIj' 57 if(allocated(str)) call abort() 58 allocate(str, source=str3) 59 if(.not.allocated(str)) call abort() 60 if(len(str) /= 8) call abort() 61 if(str /= 4_'AbCdEfGh') call abort() 62 if(associated(str4)) call abort() 63 str4 => str 64 if(str4 /= str .or. len(str4)/=8) call abort() 65 if(.not.associated(str4, str)) call abort() 66 str4 => null() 67 str = 4_'12a56b78' 68 if(str4 == 4_'12a56b78') call abort() 69 str4 = 4_'ABCDEFGH' 70 if(str == 4_'ABCDEFGH') call abort() 71 allocate(str5, source=str) 72 if(associated(str5, str)) call abort() 73 if(str5 /= 4_'12a56b78' .or. len(str5)/=8) call abort() 74 str = 4_'abcdef' 75 if(str5 == 4_'abcdef') call abort() 76 str5 = 4_'ABCDEF' 77 if(str == 4_'ABCDEF') call abort() 78 end subroutine source_check4 79 subroutine mold_check() 80 character(len=:), allocatable :: str, str2 81 character(len=8) :: str3 82 character(len=:), pointer :: str4, str5 83 nullify(str4) 84 str2 = "ABCE" 85 ALLOCATE( str, MOLD=str3) 86 if (len(str) /= 8) call abort() 87 DEALLOCATE(str) 88 ALLOCATE( str, MOLD=str2) 89 if (len(str) /= 4) call abort() 90 91 IF (associated(str4)) call abort() 92 ALLOCATE( str4, MOLD=str3) 93 IF (.not.associated(str4)) call abort() 94 str4 = '12345678' 95 if (len(str4) /= 8) call abort() 96 if(str4 /= '12345678') call abort() 97 DEALLOCATE(str4) 98 ALLOCATE( str4, MOLD=str2) 99 str4 = 'ABCD' 100 if (len(str4) /= 4) call abort() 101 if (str4 /= 'ABCD') call abort() 102 str5 => str4 103 if(.not.associated(str4,str5)) call abort() 104 if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort() 105 if(str5 /= str4) call abort() 106 deallocate(str4) 107 end subroutine mold_check 108 subroutine mold_check4() 109 character(len=:,kind=4), allocatable :: str, str2 110 character(len=8,kind=4) :: str3 111 character(len=:,kind=4), pointer :: str4, str5 112 nullify(str4) 113 str2 = 4_"ABCE" 114 ALLOCATE( str, MOLD=str3) 115 if (len(str) /= 8) call abort() 116 DEALLOCATE(str) 117 ALLOCATE( str, MOLD=str2) 118 if (len(str) /= 4) call abort() 119 120 IF (associated(str4)) call abort() 121 ALLOCATE( str4, MOLD=str3) 122 IF (.not.associated(str4)) call abort() 123 str4 = 4_'12345678' 124 if (len(str4) /= 8) call abort() 125 if(str4 /= 4_'12345678') call abort() 126 DEALLOCATE(str4) 127 ALLOCATE( str4, MOLD=str2) 128 str4 = 4_'ABCD' 129 if (len(str4) /= 4) call abort() 130 if (str4 /= 4_'ABCD') call abort() 131 str5 => str4 132 if(.not.associated(str4,str5)) call abort() 133 if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort() 134 if(str5 /= str4) call abort() 135 deallocate(str4) 136 end subroutine mold_check4 137 subroutine ftn_test() 138 character(len=:), allocatable :: str_a 139 character(len=:), pointer :: str_p 140 nullify(str_p) 141 call proc_test(str_a, str_p, .false.) 142 if (str_p /= '123457890abcdef') call abort() 143 if (len(str_p) /= 50) call abort() 144 if (str_a(1:5) /= 'ABCDE ') call abort() 145 if (len(str_a) /= 50) call abort() 146 deallocate(str_p) 147 str_a = '1245' 148 if(len(str_a) /= 4) call abort() 149 if(str_a /= '1245') call abort() 150 allocate(character(len=6) :: str_p) 151 if(len(str_p) /= 6) call abort() 152 str_p = 'AbCdEf' 153 call proc_test(str_a, str_p, .true.) 154 if (str_p /= '123457890abcdef') call abort() 155 if (len(str_p) /= 50) call abort() 156 if (str_a(1:5) /= 'ABCDE ') call abort() 157 if (len(str_a) /= 50) call abort() 158 deallocate(str_p) 159 end subroutine ftn_test 160 subroutine proc_test(a, p, alloc) 161 character(len=:), allocatable :: a 162 character(len=:), pointer :: p 163 character(len=5), target :: loc 164 logical :: alloc 165 if (.not. alloc) then 166 if(associated(p)) call abort() 167 if(allocated(a)) call abort() 168 else 169 if(len(a) /= 4) call abort() 170 if(a /= '1245') call abort() 171 if(len(p) /= 6) call abort() 172 if(p /= 'AbCdEf') call abort() 173 deallocate(a) 174 nullify(p) 175 end if 176 allocate(character(len=50) :: a) 177 a(1:5) = 'ABCDE' 178 if(len(a) /= 50) call abort() 179 if(a(1:5) /= "ABCDE") call abort() 180 loc = '12345' 181 p => loc 182 if (len(p) /= 5) call abort() 183 if (p /= '12345') call abort() 184 p = '12345679' 185 if (len(p) /= 5) call abort() 186 if (p /= '12345') call abort() 187 p = 'ABC' 188 if (loc /= 'ABC ') call abort() 189 allocate(p, mold=a) 190 if (.not.associated(p)) call abort() 191 p = '123457890abcdef' 192 if (p /= '123457890abcdef') call abort() 193 if (len(p) /= 50) call abort() 194 end subroutine proc_test 195 subroutine ftn_test4() 196 character(len=:,kind=4), allocatable :: str_a 197 character(len=:,kind=4), pointer :: str_p 198 nullify(str_p) 199 call proc_test4(str_a, str_p, .false.) 200 if (str_p /= 4_'123457890abcdef') call abort() 201 if (len(str_p) /= 50) call abort() 202 if (str_a(1:5) /= 4_'ABCDE ') call abort() 203 if (len(str_a) /= 50) call abort() 204 deallocate(str_p) 205 str_a = 4_'1245' 206 if(len(str_a) /= 4) call abort() 207 if(str_a /= 4_'1245') call abort() 208 allocate(character(len=6, kind = 4) :: str_p) 209 if(len(str_p) /= 6) call abort() 210 str_p = 4_'AbCdEf' 211 call proc_test4(str_a, str_p, .true.) 212 if (str_p /= 4_'123457890abcdef') call abort() 213 if (len(str_p) /= 50) call abort() 214 if (str_a(1:5) /= 4_'ABCDE ') call abort() 215 if (len(str_a) /= 50) call abort() 216 deallocate(str_p) 217 end subroutine ftn_test4 218 subroutine proc_test4(a, p, alloc) 219 character(len=:,kind=4), allocatable :: a 220 character(len=:,kind=4), pointer :: p 221 character(len=5,kind=4), target :: loc 222 logical :: alloc 223 if (.not. alloc) then 224 if(associated(p)) call abort() 225 if(allocated(a)) call abort() 226 else 227 if(len(a) /= 4) call abort() 228 if(a /= 4_'1245') call abort() 229 if(len(p) /= 6) call abort() 230 if(p /= 4_'AbCdEf') call abort() 231 deallocate(a) 232 nullify(p) 233 end if 234 allocate(character(len=50,kind=4) :: a) 235 a(1:5) = 4_'ABCDE' 236 if(len(a) /= 50) call abort() 237 if(a(1:5) /= 4_"ABCDE") call abort() 238 loc = '12345' 239 p => loc 240 if (len(p) /= 5) call abort() 241 if (p /= 4_'12345') call abort() 242 p = 4_'12345679' 243 if (len(p) /= 5) call abort() 244 if (p /= 4_'12345') call abort() 245 p = 4_'ABC' 246 if (loc /= 4_'ABC ') call abort() 247 allocate(p, mold=a) 248 if (.not.associated(p)) call abort() 249 p = 4_'123457890abcdef' 250 if (p /= 4_'123457890abcdef') call abort() 251 if (len(p) /= 50) call abort() 252 end subroutine proc_test4 253 subroutine source3() 254 character(len=:, kind=1), allocatable :: a1 255 character(len=:, kind=4), allocatable :: a4 256 character(len=:, kind=1), pointer :: p1 257 character(len=:, kind=4), pointer :: p4 258 allocate(a1, source='ABC') ! << ICE 259 if(len(a1) /= 3 .or. a1 /= 'ABC') call abort() 260 allocate(a4, source=4_'12345') ! << ICE 261 if(len(a4) /= 5 .or. a4 /= 4_'12345') call abort() 262 allocate(p1, mold='AB') ! << ICE 263 if(len(p1) /= 2) call abort() 264 allocate(p4, mold=4_'145') ! << ICE 265 if(len(p4) /= 3) call abort() 266 end subroutine source3 267end program test 268