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)) STOP 1 29 allocate(str, source=str3) 30 if(.not.allocated(str)) STOP 2 31 if(len(str) /= 8) STOP 3 32 if(str /= 'AbCdEfGh') STOP 4 33 if(associated(str4)) STOP 5 34 str4 => str 35 if(str4 /= str .or. len(str4)/=8) STOP 6 36 if(.not.associated(str4, str)) STOP 7 37 str4 => null() 38 str = '12a56b78' 39 if(str4 == '12a56b78') STOP 8 40 str4 = 'ABCDEFGH' 41 if(str == 'ABCDEFGH') STOP 9 42 allocate(str5, source=str) 43 if(associated(str5, str)) STOP 10 44 if(str5 /= '12a56b78' .or. len(str5)/=8) STOP 11 45 str = 'abcdef' 46 if(str5 == 'abcdef') STOP 12 47 str5 = 'ABCDEF' 48 if(str == 'ABCDEF') STOP 13 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)) STOP 14 58 allocate(str, source=str3) 59 if(.not.allocated(str)) STOP 15 60 if(len(str) /= 8) STOP 16 61 if(str /= 4_'AbCdEfGh') STOP 17 62 if(associated(str4)) STOP 18 63 str4 => str 64 if(str4 /= str .or. len(str4)/=8) STOP 19 65 if(.not.associated(str4, str)) STOP 20 66 str4 => null() 67 str = 4_'12a56b78' 68 if(str4 == 4_'12a56b78') STOP 21 69 str4 = 4_'ABCDEFGH' 70 if(str == 4_'ABCDEFGH') STOP 22 71 allocate(str5, source=str) 72 if(associated(str5, str)) STOP 23 73 if(str5 /= 4_'12a56b78' .or. len(str5)/=8) STOP 24 74 str = 4_'abcdef' 75 if(str5 == 4_'abcdef') STOP 25 76 str5 = 4_'ABCDEF' 77 if(str == 4_'ABCDEF') STOP 26 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) STOP 27 87 DEALLOCATE(str) 88 ALLOCATE( str, MOLD=str2) 89 if (len(str) /= 4) STOP 28 90 91 IF (associated(str4)) STOP 29 92 ALLOCATE( str4, MOLD=str3) 93 IF (.not.associated(str4)) STOP 30 94 str4 = '12345678' 95 if (len(str4) /= 8) STOP 31 96 if(str4 /= '12345678') STOP 32 97 DEALLOCATE(str4) 98 ALLOCATE( str4, MOLD=str2) 99 str4 = 'ABCD' 100 if (len(str4) /= 4) STOP 33 101 if (str4 /= 'ABCD') STOP 34 102 str5 => str4 103 if(.not.associated(str4,str5)) STOP 35 104 if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 36 105 if(str5 /= str4) STOP 37 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) STOP 38 116 DEALLOCATE(str) 117 ALLOCATE( str, MOLD=str2) 118 if (len(str) /= 4) STOP 39 119 120 IF (associated(str4)) STOP 40 121 ALLOCATE( str4, MOLD=str3) 122 IF (.not.associated(str4)) STOP 41 123 str4 = 4_'12345678' 124 if (len(str4) /= 8) STOP 42 125 if(str4 /= 4_'12345678') STOP 43 126 DEALLOCATE(str4) 127 ALLOCATE( str4, MOLD=str2) 128 str4 = 4_'ABCD' 129 if (len(str4) /= 4) STOP 44 130 if (str4 /= 4_'ABCD') STOP 45 131 str5 => str4 132 if(.not.associated(str4,str5)) STOP 46 133 if(len(str5) /= 4 .or. len(str4) /= len(str5)) STOP 47 134 if(str5 /= str4) STOP 48 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') STOP 49 143 if (len(str_p) /= 50) STOP 50 144 if (str_a(1:5) /= 'ABCDE ') STOP 51 145 if (len(str_a) /= 50) STOP 52 146 deallocate(str_p) 147 str_a = '1245' 148 if(len(str_a) /= 4) STOP 53 149 if(str_a /= '1245') STOP 54 150 allocate(character(len=6) :: str_p) 151 if(len(str_p) /= 6) STOP 55 152 str_p = 'AbCdEf' 153 call proc_test(str_a, str_p, .true.) 154 if (str_p /= '123457890abcdef') STOP 56 155 if (len(str_p) /= 50) STOP 57 156 if (str_a(1:5) /= 'ABCDE ') STOP 58 157 if (len(str_a) /= 50) STOP 59 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)) STOP 60 167 if(allocated(a)) STOP 61 168 else 169 if(len(a) /= 4) STOP 62 170 if(a /= '1245') STOP 63 171 if(len(p) /= 6) STOP 64 172 if(p /= 'AbCdEf') STOP 65 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) STOP 66 179 if(a(1:5) /= "ABCDE") STOP 67 180 loc = '12345' 181 p => loc 182 if (len(p) /= 5) STOP 68 183 if (p /= '12345') STOP 69 184 p = '12345679' 185 if (len(p) /= 5) STOP 70 186 if (p /= '12345') STOP 71 187 p = 'ABC' 188 if (loc /= 'ABC ') STOP 72 189 allocate(p, mold=a) 190 if (.not.associated(p)) STOP 73 191 p = '123457890abcdef' 192 if (p /= '123457890abcdef') STOP 74 193 if (len(p) /= 50) STOP 75 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') STOP 76 201 if (len(str_p) /= 50) STOP 77 202 if (str_a(1:5) /= 4_'ABCDE ') STOP 78 203 if (len(str_a) /= 50) STOP 79 204 deallocate(str_p) 205 str_a = 4_'1245' 206 if(len(str_a) /= 4) STOP 80 207 if(str_a /= 4_'1245') STOP 81 208 allocate(character(len=6, kind = 4) :: str_p) 209 if(len(str_p) /= 6) STOP 82 210 str_p = 4_'AbCdEf' 211 call proc_test4(str_a, str_p, .true.) 212 if (str_p /= 4_'123457890abcdef') STOP 83 213 if (len(str_p) /= 50) STOP 84 214 if (str_a(1:5) /= 4_'ABCDE ') STOP 85 215 if (len(str_a) /= 50) STOP 86 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)) STOP 87 225 if(allocated(a)) STOP 88 226 else 227 if(len(a) /= 4) STOP 89 228 if(a /= 4_'1245') STOP 90 229 if(len(p) /= 6) STOP 91 230 if(p /= 4_'AbCdEf') STOP 92 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) STOP 93 237 if(a(1:5) /= 4_"ABCDE") STOP 94 238 loc = '12345' 239 p => loc 240 if (len(p) /= 5) STOP 95 241 if (p /= 4_'12345') STOP 96 242 p = 4_'12345679' 243 if (len(p) /= 5) STOP 97 244 if (p /= 4_'12345') STOP 98 245 p = 4_'ABC' 246 if (loc /= 4_'ABC ') STOP 99 247 allocate(p, mold=a) 248 if (.not.associated(p)) STOP 100 249 p = 4_'123457890abcdef' 250 if (p /= 4_'123457890abcdef') STOP 101 251 if (len(p) /= 50) STOP 102 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') STOP 103 260 allocate(a4, source=4_'12345') ! << ICE 261 if(len(a4) /= 5 .or. a4 /= 4_'12345') STOP 104 262 allocate(p1, mold='AB') ! << ICE 263 if(len(p1) /= 2) STOP 105 264 allocate(p4, mold=4_'145') ! << ICE 265 if(len(p4) /= 3) STOP 106 266 end subroutine source3 267end program test 268! Spurious -Wstringop-overflow warning with -O1 269! { dg-prune-output "\\\[-Wstringop-overflow=]" } 270