| 1 | ! ============================================================================== |
| 2 | ! Simplified test program for Phase 6 - Variables module with memory pooling |
| 3 | ! ============================================================================== |
| 4 | program test_variables_simple |
| 5 | use string_pool |
| 6 | use memory_dashboard |
| 7 | use variables_pooled |
| 8 | use iso_fortran_env, only: output_unit |
| 9 | implicit none |
| 10 | |
| 11 | type(shell_pooled_t) :: shell_pooled |
| 12 | type(string_ref) :: value_ref, expanded_ref |
| 13 | type(string_ref), allocatable :: body_refs(:) |
| 14 | character(len=2048) :: test_string |
| 15 | character(len=1024), dimension(3) :: function_body |
| 16 | integer :: i, j |
| 17 | logical :: test_passed |
| 18 | integer :: total_allocs, total_deallocs, current_strings, peak_strings |
| 19 | real :: hit_rate |
| 20 | character(:), pointer :: str_ptr |
| 21 | |
| 22 | test_passed = .true. |
| 23 | |
| 24 | print *, "=== Phase 6 Variables Memory Pooling Test (Simplified) ===" |
| 25 | print *, "Testing pooled memory for variable management" |
| 26 | print * |
| 27 | |
| 28 | ! Initialize the pool and dashboard |
| 29 | call pool_init() |
| 30 | call dashboard_init(verbose=.false.) |
| 31 | call init_shell_pooled(shell_pooled) |
| 32 | |
| 33 | ! Test 1: Basic variable setting and getting |
| 34 | print *, "Test 1: Testing basic variable operations..." |
| 35 | |
| 36 | ! Set simple variables |
| 37 | call set_shell_variable_pooled(shell_pooled, "PATH", "/usr/local/bin:/usr/bin:/bin") |
| 38 | call set_shell_variable_pooled(shell_pooled, "HOME", "/home/testuser") |
| 39 | call set_shell_variable_pooled(shell_pooled, "USER", "testuser") |
| 40 | call set_shell_variable_pooled(shell_pooled, "SHELL", "/bin/fortsh") |
| 41 | call set_shell_variable_pooled(shell_pooled, "TERM", "xterm-256color") |
| 42 | |
| 43 | ! Get and verify variables |
| 44 | value_ref = get_shell_variable_pooled(shell_pooled, "PATH") |
| 45 | if (associated(value_ref%data)) then |
| 46 | print *, " PATH:", trim(value_ref%data(1:min(50, value_ref%str_len))), "..." |
| 47 | if (value_ref%pool_index > 0) then |
| 48 | print *, " PASSED: PATH allocated from pool" |
| 49 | else |
| 50 | print *, " FAILED: PATH not from pool" |
| 51 | test_passed = .false. |
| 52 | end if |
| 53 | end if |
| 54 | |
| 55 | value_ref = get_shell_variable_pooled(shell_pooled, "HOME") |
| 56 | if (associated(value_ref%data)) then |
| 57 | print *, " HOME:", trim(value_ref%data) |
| 58 | end if |
| 59 | |
| 60 | value_ref = get_shell_variable_pooled(shell_pooled, "USER") |
| 61 | if (associated(value_ref%data)) then |
| 62 | print *, " USER:", trim(value_ref%data) |
| 63 | end if |
| 64 | |
| 65 | ! Test 2: Variable expansion |
| 66 | print *, "" |
| 67 | print *, "Test 2: Testing variable expansion..." |
| 68 | |
| 69 | ! Test simple expansion |
| 70 | test_string = "Current user is $USER in $HOME" |
| 71 | expanded_ref = expand_variables_pooled(shell_pooled, test_string) |
| 72 | if (associated(expanded_ref%data)) then |
| 73 | print *, " Input: ", trim(test_string) |
| 74 | print *, " Expanded:", trim(expanded_ref%data) |
| 75 | i = expanded_ref%str_len ! Save size before release |
| 76 | j = get_bucket_for_size(expanded_ref%str_len) |
| 77 | call pool_release_string(expanded_ref) |
| 78 | call dashboard_track_deallocation(MOD_VARIABLES, i, j) |
| 79 | end if |
| 80 | |
| 81 | ! Test brace expansion |
| 82 | test_string = "Shell path is ${SHELL} and terminal is ${TERM}" |
| 83 | expanded_ref = expand_variables_pooled(shell_pooled, test_string) |
| 84 | if (associated(expanded_ref%data)) then |
| 85 | print *, " Input:", trim(test_string) |
| 86 | print *, " Expanded:", trim(expanded_ref%data) |
| 87 | i = expanded_ref%str_len ! Save size before release |
| 88 | j = get_bucket_for_size(expanded_ref%str_len) |
| 89 | call pool_release_string(expanded_ref) |
| 90 | call dashboard_track_deallocation(MOD_VARIABLES, i, j) |
| 91 | end if |
| 92 | |
| 93 | ! Test 3: Array variables |
| 94 | print *, "" |
| 95 | print *, "Test 3: Testing array variables..." |
| 96 | |
| 97 | ! Set array elements |
| 98 | call set_array_element_pooled(shell_pooled, "myarray", 1, "first") |
| 99 | call set_array_element_pooled(shell_pooled, "myarray", 2, "second") |
| 100 | call set_array_element_pooled(shell_pooled, "myarray", 3, "third") |
| 101 | call set_array_element_pooled(shell_pooled, "myarray", 5, "fifth") ! Sparse array |
| 102 | |
| 103 | ! Get array elements |
| 104 | do i = 1, 5 |
| 105 | value_ref = get_array_element_pooled(shell_pooled, "myarray", i) |
| 106 | if (associated(value_ref%data)) then |
| 107 | print '(A,I0,A,A)', " myarray[", i, "]=", trim(value_ref%data) |
| 108 | else |
| 109 | print '(A,I0,A)', " myarray[", i, "]=(unset)" |
| 110 | end if |
| 111 | end do |
| 112 | |
| 113 | ! Test 4: Function storage |
| 114 | print *, "" |
| 115 | print *, "Test 4: Testing function storage..." |
| 116 | |
| 117 | ! Define a function |
| 118 | function_body(1) = "echo 'Hello from function'" |
| 119 | function_body(2) = "local var=$1" |
| 120 | function_body(3) = "echo ""Argument: $var""" |
| 121 | |
| 122 | call set_function_pooled(shell_pooled, "myfunction", function_body) |
| 123 | |
| 124 | ! Retrieve function |
| 125 | body_refs = get_function_pooled(shell_pooled, "myfunction") |
| 126 | if (allocated(body_refs)) then |
| 127 | print *, " Function 'myfunction' body:" |
| 128 | do i = 1, size(body_refs) |
| 129 | if (associated(body_refs(i)%data)) then |
| 130 | print '(A,I0,A,A)', " Line ", i, ": ", trim(body_refs(i)%data) |
| 131 | end if |
| 132 | end do |
| 133 | deallocate(body_refs) |
| 134 | end if |
| 135 | |
| 136 | ! Test 5: Large variable values |
| 137 | print *, "" |
| 138 | print *, "Test 5: Testing large variable values..." |
| 139 | |
| 140 | ! Create a large value (2KB) |
| 141 | test_string = repeat("A", 2048) |
| 142 | call set_shell_variable_pooled(shell_pooled, "LARGE_VAR", test_string) |
| 143 | |
| 144 | value_ref = get_shell_variable_pooled(shell_pooled, "LARGE_VAR") |
| 145 | if (associated(value_ref%data)) then |
| 146 | print *, " LARGE_VAR length:", value_ref%str_len |
| 147 | print *, " Pool bucket:", value_ref%pool_index |
| 148 | if (value_ref%str_len == 2048 .and. value_ref%pool_index > 0) then |
| 149 | print *, " PASSED: Large variable allocated from pool" |
| 150 | else |
| 151 | print *, " FAILED: Large variable allocation issue" |
| 152 | test_passed = .false. |
| 153 | end if |
| 154 | end if |
| 155 | |
| 156 | ! Test 6: Variable overwrite (test proper deallocation) |
| 157 | print *, "" |
| 158 | print *, "Test 6: Testing variable overwrite..." |
| 159 | |
| 160 | call set_shell_variable_pooled(shell_pooled, "TEMP", "initial value") |
| 161 | call set_shell_variable_pooled(shell_pooled, "TEMP", "second value") |
| 162 | call set_shell_variable_pooled(shell_pooled, "TEMP", "third and final value") |
| 163 | |
| 164 | value_ref = get_shell_variable_pooled(shell_pooled, "TEMP") |
| 165 | if (associated(value_ref%data)) then |
| 166 | print *, " TEMP after overwrites:", trim(value_ref%data) |
| 167 | if (trim(value_ref%data) == "third and final value") then |
| 168 | print *, " PASSED: Overwrite working correctly" |
| 169 | else |
| 170 | print *, " FAILED: Overwrite not working" |
| 171 | test_passed = .false. |
| 172 | end if |
| 173 | end if |
| 174 | |
| 175 | ! Test 7: Stress test - many variables |
| 176 | print *, "" |
| 177 | print *, "Test 7: Stress testing with 1000 variable operations..." |
| 178 | |
| 179 | do i = 1, 1000 |
| 180 | write(test_string, '(A,I0)') "stress_var_", i |
| 181 | call set_shell_variable_pooled(shell_pooled, trim(test_string), "test_value") |
| 182 | |
| 183 | ! Every 100, overwrite to test deallocation |
| 184 | if (mod(i, 100) == 0) then |
| 185 | call set_shell_variable_pooled(shell_pooled, trim(test_string), "updated_value") |
| 186 | end if |
| 187 | end do |
| 188 | print *, " Created/updated 1000 variables" |
| 189 | |
| 190 | ! Test 8: Complex expansion stress test |
| 191 | print *, "" |
| 192 | print *, "Test 8: Complex expansion stress test..." |
| 193 | |
| 194 | call set_shell_variable_pooled(shell_pooled, "VAR1", "Hello") |
| 195 | call set_shell_variable_pooled(shell_pooled, "VAR2", "World") |
| 196 | call set_shell_variable_pooled(shell_pooled, "VAR3", "from") |
| 197 | call set_shell_variable_pooled(shell_pooled, "VAR4", "Fortran") |
| 198 | |
| 199 | test_string = "$VAR1 $VAR2 $VAR3 $VAR4! Also ${VAR1} ${VAR2} ${VAR3} ${VAR4}!" |
| 200 | do i = 1, 100 |
| 201 | expanded_ref = expand_variables_pooled(shell_pooled, test_string) |
| 202 | if (associated(expanded_ref%data)) then |
| 203 | if (i == 1) then |
| 204 | print *, " First expansion:", trim(expanded_ref%data) |
| 205 | end if |
| 206 | j = expanded_ref%str_len ! Save size before release |
| 207 | call pool_release_string(expanded_ref) |
| 208 | call dashboard_track_deallocation(MOD_VARIABLES, j, & |
| 209 | get_bucket_for_size(j)) |
| 210 | end if |
| 211 | end do |
| 212 | print *, " Completed 100 expansion cycles" |
| 213 | |
| 214 | ! Clean up all variables |
| 215 | call cleanup_variables_pooled(shell_pooled) |
| 216 | |
| 217 | ! Test 9: Check for memory leaks |
| 218 | print *, "" |
| 219 | print *, "Test 9: Checking for memory leaks..." |
| 220 | call pool_statistics(total_allocs, total_deallocs, current_strings, peak_strings, hit_rate) |
| 221 | |
| 222 | print *, " Total allocations:", total_allocs |
| 223 | print *, " Total deallocations:", total_deallocs |
| 224 | print *, " Current strings:", current_strings |
| 225 | print *, " Peak strings:", peak_strings |
| 226 | print *, " Cache hit rate:", int(hit_rate * 100), "%" |
| 227 | |
| 228 | if (current_strings == 0) then |
| 229 | print *, " PASSED: No memory leaks" |
| 230 | else |
| 231 | print *, " FAILED: Memory leak -", current_strings, "strings still allocated" |
| 232 | test_passed = .false. |
| 233 | end if |
| 234 | |
| 235 | ! Display dashboard |
| 236 | print *, "" |
| 237 | print *, "=== Variables Module Statistics ===" |
| 238 | call dashboard_display(detailed=.false.) |
| 239 | |
| 240 | ! Export statistics |
| 241 | call dashboard_export_csv("variables_pooling_test.csv") |
| 242 | print *, "" |
| 243 | print *, "Statistics exported to variables_pooling_test.csv" |
| 244 | |
| 245 | ! Clean up |
| 246 | call dashboard_cleanup() |
| 247 | call pool_cleanup() |
| 248 | |
| 249 | ! Summary |
| 250 | print *, "" |
| 251 | print *, "=== Test Summary ===" |
| 252 | if (test_passed .and. current_strings == 0) then |
| 253 | print *, "ALL TESTS PASSED" |
| 254 | print *, "" |
| 255 | print *, "Variables pooling integration verified:" |
| 256 | print *, " - Basic variable operations working" |
| 257 | print *, " - Variable expansion working" |
| 258 | print *, " - Array variables working" |
| 259 | print *, " - Function storage working" |
| 260 | print *, " - Large values (2KB) working" |
| 261 | print *, " - No memory leaks detected" |
| 262 | print *, " - Dashboard tracking successful" |
| 263 | print *, " - Cache hit rate:", int(hit_rate * 100), "%" |
| 264 | print *, "" |
| 265 | print *, "Ready to integrate into production variables module!" |
| 266 | else |
| 267 | print *, "SOME TESTS FAILED" |
| 268 | if (current_strings > 0) then |
| 269 | print *, " Memory leak:", current_strings, "strings not released" |
| 270 | end if |
| 271 | end if |
| 272 | |
| 273 | contains |
| 274 | |
| 275 | ! Helper: Get bucket index for size |
| 276 | function get_bucket_for_size(size_bytes) result(bucket_idx) |
| 277 | integer, intent(in) :: size_bytes |
| 278 | integer :: bucket_idx |
| 279 | |
| 280 | if (size_bytes <= 64) then |
| 281 | bucket_idx = 1 |
| 282 | else if (size_bytes <= 256) then |
| 283 | bucket_idx = 2 |
| 284 | else if (size_bytes <= 1024) then |
| 285 | bucket_idx = 3 |
| 286 | else if (size_bytes <= 4096) then |
| 287 | bucket_idx = 4 |
| 288 | else if (size_bytes <= 16384) then |
| 289 | bucket_idx = 5 |
| 290 | else |
| 291 | bucket_idx = 0 ! Direct allocation |
| 292 | end if |
| 293 | end function get_bucket_for_size |
| 294 | |
| 295 | end program test_variables_simple |