| 1 | !=============================================================================== |
| 2 | ! test_c_strings.f90 - Test program for C string buffer library |
| 3 | ! |
| 4 | ! This demonstrates that the C interop approach allows strings >128 bytes |
| 5 | ! on macOS ARM64 without heap corruption. |
| 6 | !=============================================================================== |
| 7 | program test_c_strings |
| 8 | use, intrinsic :: iso_c_binding |
| 9 | use fortsh_c_strings |
| 10 | implicit none |
| 11 | |
| 12 | type(c_string_buffer) :: buf1, buf2, buf3 |
| 13 | character(len=2048) :: fortran_str |
| 14 | integer :: len, pos |
| 15 | logical :: success |
| 16 | character(len=1) :: ch |
| 17 | |
| 18 | print *, '=========================================' |
| 19 | print *, 'Testing C String Buffer Library' |
| 20 | print *, '=========================================' |
| 21 | print * |
| 22 | |
| 23 | ! Test 1: Create and basic operations |
| 24 | print *, 'Test 1: Create buffer and set string' |
| 25 | buf1 = c_string_create(2048) |
| 26 | if (.not. c_associated(buf1%handle)) then |
| 27 | print *, 'FAIL: Could not create buffer' |
| 28 | stop 1 |
| 29 | end if |
| 30 | print *, 'PASS: Buffer created' |
| 31 | |
| 32 | success = c_string_set(buf1, 'Hello, World!') |
| 33 | if (.not. success) then |
| 34 | print *, 'FAIL: Could not set string' |
| 35 | stop 1 |
| 36 | end if |
| 37 | print *, 'PASS: String set successfully' |
| 38 | |
| 39 | len = c_string_length(buf1) |
| 40 | print *, 'Length:', len |
| 41 | if (len /= 13) then |
| 42 | print *, 'FAIL: Expected length 13, got', len |
| 43 | stop 1 |
| 44 | end if |
| 45 | print *, 'PASS: Length correct' |
| 46 | print * |
| 47 | |
| 48 | ! Test 2: Long strings (>128 bytes) - THE CRITICAL TEST! |
| 49 | print *, 'Test 2: Long strings (>128 bytes)' |
| 50 | print *, 'This is the test that would crash flang-new!' |
| 51 | |
| 52 | ! Create a 500-byte string |
| 53 | call create_long_string(fortran_str, 500) |
| 54 | print *, 'Created test string of length:', len_trim(fortran_str) |
| 55 | |
| 56 | success = c_string_set(buf1, fortran_str(1:500)) |
| 57 | if (.not. success) then |
| 58 | print *, 'FAIL: Could not set long string' |
| 59 | stop 1 |
| 60 | end if |
| 61 | print *, 'PASS: Set 500-byte string' |
| 62 | |
| 63 | len = c_string_length(buf1) |
| 64 | print *, 'Buffer length:', len |
| 65 | if (len /= 500) then |
| 66 | print *, 'FAIL: Expected length 500, got', len |
| 67 | stop 1 |
| 68 | end if |
| 69 | print *, 'PASS: Long string length correct' |
| 70 | print * |
| 71 | |
| 72 | ! Test 3: Substring operations (another crash trigger!) |
| 73 | print *, 'Test 3: Substring operations on long string' |
| 74 | buf2 = c_string_create(2048) |
| 75 | |
| 76 | ! Extract characters 50-100 (Fortran 1-based) |
| 77 | success = c_string_substring(buf2, buf1, 50, 100) |
| 78 | if (.not. success) then |
| 79 | print *, 'FAIL: Could not extract substring' |
| 80 | stop 1 |
| 81 | end if |
| 82 | print *, 'PASS: Extracted substring(50:100)' |
| 83 | |
| 84 | len = c_string_length(buf2) |
| 85 | if (len /= 51) then ! 100 - 50 + 1 = 51 characters |
| 86 | print *, 'FAIL: Expected substring length 51, got', len |
| 87 | stop 1 |
| 88 | end if |
| 89 | print *, 'PASS: Substring length correct' |
| 90 | print * |
| 91 | |
| 92 | ! Test 4: Buffer manipulation |
| 93 | print *, 'Test 4: Insert, delete, append operations' |
| 94 | |
| 95 | buf3 = c_string_create(2048) |
| 96 | success = c_string_set(buf3, 'Hello World') |
| 97 | |
| 98 | ! Insert "Beautiful " at position 7 (after "Hello ", before "World") |
| 99 | success = c_string_insert(buf3, 7, 'Beautiful ') |
| 100 | if (.not. success) then |
| 101 | print *, 'FAIL: Could not insert text' |
| 102 | stop 1 |
| 103 | end if |
| 104 | |
| 105 | call c_string_to_fortran(buf3, fortran_str) |
| 106 | print *, 'After insert:', trim(fortran_str) |
| 107 | if (trim(fortran_str) /= 'Hello Beautiful World') then |
| 108 | print *, 'FAIL: Insert produced wrong result' |
| 109 | stop 1 |
| 110 | end if |
| 111 | print *, 'PASS: Insert operation' |
| 112 | |
| 113 | ! Append text |
| 114 | success = c_string_append(buf3, '!') |
| 115 | call c_string_to_fortran(buf3, fortran_str) |
| 116 | print *, 'After append:', trim(fortran_str) |
| 117 | if (trim(fortran_str) /= 'Hello Beautiful World!') then |
| 118 | print *, 'FAIL: Append produced wrong result' |
| 119 | stop 1 |
| 120 | end if |
| 121 | print *, 'PASS: Append operation' |
| 122 | |
| 123 | ! Delete "Beautiful " (10 characters at position 7) |
| 124 | success = c_string_delete(buf3, 7, 10) |
| 125 | call c_string_to_fortran(buf3, fortran_str) |
| 126 | print *, 'After delete:', trim(fortran_str) |
| 127 | if (trim(fortran_str) /= 'Hello World!') then |
| 128 | print *, 'FAIL: Delete produced wrong result' |
| 129 | stop 1 |
| 130 | end if |
| 131 | print *, 'PASS: Delete operation' |
| 132 | print * |
| 133 | |
| 134 | ! Test 5: Character access |
| 135 | print *, 'Test 5: Individual character access' |
| 136 | success = c_string_set(buf1, 'ABCDEFGH') |
| 137 | |
| 138 | ch = c_string_get_char(buf1, 5) ! Should be 'E' |
| 139 | if (ch /= 'E') then |
| 140 | print *, 'FAIL: Get char at 5 returned', ch, 'expected E' |
| 141 | stop 1 |
| 142 | end if |
| 143 | print *, 'PASS: Get character' |
| 144 | |
| 145 | success = c_string_set_char(buf1, 5, 'X') ! Change 'E' to 'X' |
| 146 | call c_string_to_fortran(buf1, fortran_str) |
| 147 | if (trim(fortran_str) /= 'ABCDXFGH') then |
| 148 | print *, 'FAIL: Set char produced:', trim(fortran_str) |
| 149 | stop 1 |
| 150 | end if |
| 151 | print *, 'PASS: Set character' |
| 152 | print * |
| 153 | |
| 154 | ! Test 6: Find operation |
| 155 | print *, 'Test 6: Find substring' |
| 156 | success = c_string_set(buf1, 'The quick brown fox jumps over the lazy dog') |
| 157 | |
| 158 | pos = c_string_find(buf1, 'fox') |
| 159 | if (pos /= 17) then ! 1-based position |
| 160 | print *, 'FAIL: Find returned', pos, 'expected 17' |
| 161 | stop 1 |
| 162 | end if |
| 163 | print *, 'PASS: Find operation (pos=', pos, ')' |
| 164 | |
| 165 | pos = c_string_find(buf1, 'cat') ! Not present |
| 166 | if (pos /= 0) then |
| 167 | print *, 'FAIL: Find should return 0 for not found' |
| 168 | stop 1 |
| 169 | end if |
| 170 | print *, 'PASS: Find not-present string' |
| 171 | print * |
| 172 | |
| 173 | ! Test 7: Fortran interop |
| 174 | print *, 'Test 7: Fortran string conversion' |
| 175 | |
| 176 | fortran_str = 'Fortran string with spaces ' |
| 177 | success = c_string_from_fortran(buf1, fortran_str) |
| 178 | |
| 179 | len = c_string_length(buf1) |
| 180 | call c_string_to_fortran(buf1, fortran_str) |
| 181 | print *, 'Converted:', trim(fortran_str) |
| 182 | print *, 'Length:', len |
| 183 | |
| 184 | if (trim(fortran_str) /= 'Fortran string with spaces') then |
| 185 | print *, 'FAIL: Fortran conversion' |
| 186 | stop 1 |
| 187 | end if |
| 188 | print *, 'PASS: Fortran string conversion' |
| 189 | print * |
| 190 | |
| 191 | ! Test 8: Stress test with very long command lines |
| 192 | print *, 'Test 8: STRESS TEST - 1024 byte command line' |
| 193 | call create_long_string(fortran_str, 1024) |
| 194 | success = c_string_set(buf1, fortran_str(1:1024)) |
| 195 | if (.not. success) then |
| 196 | print *, 'FAIL: Could not set 1024-byte string' |
| 197 | stop 1 |
| 198 | end if |
| 199 | |
| 200 | len = c_string_length(buf1) |
| 201 | if (len /= 1024) then |
| 202 | print *, 'FAIL: 1024-byte string has wrong length:', len |
| 203 | stop 1 |
| 204 | end if |
| 205 | |
| 206 | ! Try substring operations on the huge string |
| 207 | success = c_string_substring(buf2, buf1, 1, 1024) |
| 208 | if (.not. success) then |
| 209 | print *, 'FAIL: Could not substring 1024-byte string' |
| 210 | stop 1 |
| 211 | end if |
| 212 | |
| 213 | ! Try insertion (this would definitely crash flang-new!) |
| 214 | success = c_string_insert(buf1, 512, ' INSERTED ') |
| 215 | if (.not. success) then |
| 216 | print *, 'FAIL: Could not insert into 1024-byte string' |
| 217 | stop 1 |
| 218 | end if |
| 219 | |
| 220 | len = c_string_length(buf1) |
| 221 | if (len /= 1034) then ! 1024 + 10 |
| 222 | print *, 'FAIL: After insert, expected 1034, got', len |
| 223 | stop 1 |
| 224 | end if |
| 225 | |
| 226 | print *, 'PASS: 1024-byte stress test' |
| 227 | print *, '***** THIS WOULD HAVE CRASHED FLANG-NEW! *****' |
| 228 | print * |
| 229 | |
| 230 | ! Cleanup |
| 231 | call c_string_destroy(buf1) |
| 232 | call c_string_destroy(buf2) |
| 233 | call c_string_destroy(buf3) |
| 234 | |
| 235 | print *, '=========================================' |
| 236 | print *, 'ALL TESTS PASSED!' |
| 237 | print *, '=========================================' |
| 238 | print *, 'The C interop approach successfully' |
| 239 | print *, 'handles strings >128 bytes without' |
| 240 | print *, 'triggering flang-new heap corruption!' |
| 241 | print *, '=========================================' |
| 242 | |
| 243 | contains |
| 244 | |
| 245 | subroutine create_long_string(str, length) |
| 246 | character(len=*), intent(out) :: str |
| 247 | integer, intent(in) :: length |
| 248 | integer :: i |
| 249 | character(len=26), parameter :: alphabet = 'abcdefghijklmnopqrstuvwxyz' |
| 250 | |
| 251 | str = '' |
| 252 | do i = 1, length |
| 253 | str(i:i) = alphabet(mod(i-1, 26) + 1:mod(i-1, 26) + 1) |
| 254 | end do |
| 255 | end subroutine create_long_string |
| 256 | |
| 257 | end program test_c_strings |
| 258 |