| 1 | use std::path::PathBuf; |
| 2 | use std::process::Command; |
| 3 | use std::sync::atomic::{AtomicUsize, Ordering}; |
| 4 | |
| 5 | static NEXT_TEMP_ID: AtomicUsize = AtomicUsize::new(0); |
| 6 | |
| 7 | fn compiler(name: &str) -> PathBuf { |
| 8 | if let Some(path) = std::env::var_os(format!("CARGO_BIN_EXE_{}", name)) { |
| 9 | return PathBuf::from(path); |
| 10 | } |
| 11 | let candidate = PathBuf::from("target/debug").join(name); |
| 12 | if candidate.exists() { |
| 13 | return std::fs::canonicalize(candidate).expect("cannot canonicalize debug compiler path"); |
| 14 | } |
| 15 | let candidate = PathBuf::from("target/release").join(name); |
| 16 | if candidate.exists() { |
| 17 | return std::fs::canonicalize(candidate) |
| 18 | .expect("cannot canonicalize release compiler path"); |
| 19 | } |
| 20 | panic!( |
| 21 | "compiler binary '{}' not built — run `cargo build --bins` first", |
| 22 | name |
| 23 | ); |
| 24 | } |
| 25 | |
| 26 | fn unique_path(stem: &str, ext: &str) -> PathBuf { |
| 27 | let pid = std::process::id(); |
| 28 | let id = NEXT_TEMP_ID.fetch_add(1, Ordering::Relaxed); |
| 29 | std::env::temp_dir().join(format!("afs_memory_{}_{}_{}.{}", stem, pid, id, ext)) |
| 30 | } |
| 31 | |
| 32 | fn unique_dir(stem: &str) -> PathBuf { |
| 33 | let dir = unique_path(stem, "dir"); |
| 34 | std::fs::create_dir_all(&dir).expect("cannot create memory-runtime test directory"); |
| 35 | dir |
| 36 | } |
| 37 | |
| 38 | fn write_program_in(dir: &std::path::Path, name: &str, text: &str) -> PathBuf { |
| 39 | let path = dir.join(name); |
| 40 | std::fs::write(&path, text).expect("cannot write memory-runtime test source"); |
| 41 | path |
| 42 | } |
| 43 | |
| 44 | fn compile_program(source: &std::path::Path, output: &std::path::Path) -> std::process::Output { |
| 45 | Command::new(compiler("armfortas")) |
| 46 | .args([source.to_str().unwrap(), "-o", output.to_str().unwrap()]) |
| 47 | .output() |
| 48 | .expect("failed to spawn armfortas compile") |
| 49 | } |
| 50 | |
| 51 | #[test] |
| 52 | fn allocate_stat_errmsg_populates_fixed_character_target() { |
| 53 | let dir = unique_dir("alloc_fixed_errmsg"); |
| 54 | let src = write_program_in( |
| 55 | &dir, |
| 56 | "main.f90", |
| 57 | "program p\n implicit none\n integer :: ios\n integer, allocatable :: a(:)\n character(len=64) :: msg\n msg = 'unchanged'\n allocate(a(2), stat=ios, errmsg=msg)\n if (ios /= 0) error stop 1\n allocate(a(2), stat=ios, errmsg=msg)\n if (ios == 0) error stop 2\n if (index(trim(msg), 'ALLOCATE failed') == 0) error stop 3\n print *, ios\n print *, trim(msg)\nend program\n", |
| 58 | ); |
| 59 | let exe = dir.join("alloc_fixed_errmsg.bin"); |
| 60 | let compile = compile_program(&src, &exe); |
| 61 | assert!( |
| 62 | compile.status.success(), |
| 63 | "compile failed: {}", |
| 64 | String::from_utf8_lossy(&compile.stderr) |
| 65 | ); |
| 66 | |
| 67 | let run = Command::new(&exe) |
| 68 | .output() |
| 69 | .expect("fixed errmsg runtime failed"); |
| 70 | assert!( |
| 71 | run.status.success(), |
| 72 | "fixed errmsg runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 73 | run.status, |
| 74 | String::from_utf8_lossy(&run.stdout), |
| 75 | String::from_utf8_lossy(&run.stderr) |
| 76 | ); |
| 77 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 78 | assert!( |
| 79 | stdout.contains("2"), |
| 80 | "expected nonzero STAT in fixed errmsg output: {}", |
| 81 | stdout |
| 82 | ); |
| 83 | assert!( |
| 84 | stdout.contains("ALLOCATE failed"), |
| 85 | "expected fixed errmsg text in output: {}", |
| 86 | stdout |
| 87 | ); |
| 88 | |
| 89 | let _ = std::fs::remove_dir_all(&dir); |
| 90 | } |
| 91 | |
| 92 | #[test] |
| 93 | fn allocate_stat_errmsg_populates_deferred_character_target() { |
| 94 | let dir = unique_dir("alloc_deferred_errmsg"); |
| 95 | let src = write_program_in( |
| 96 | &dir, |
| 97 | "main.f90", |
| 98 | "program p\n implicit none\n integer :: ios\n integer, allocatable :: a(:)\n character(len=:), allocatable :: msg\n msg = 'seed'\n allocate(a(2), stat=ios, errmsg=msg)\n if (ios /= 0) error stop 1\n allocate(a(2), stat=ios, errmsg=msg)\n if (ios == 0) error stop 2\n if (.not. allocated(msg)) error stop 3\n if (index(trim(msg), 'ALLOCATE failed') == 0) error stop 4\n print *, ios\n print *, trim(msg)\nend program\n", |
| 99 | ); |
| 100 | let exe = dir.join("alloc_deferred_errmsg.bin"); |
| 101 | let compile = compile_program(&src, &exe); |
| 102 | assert!( |
| 103 | compile.status.success(), |
| 104 | "compile failed: {}", |
| 105 | String::from_utf8_lossy(&compile.stderr) |
| 106 | ); |
| 107 | |
| 108 | let run = Command::new(&exe) |
| 109 | .output() |
| 110 | .expect("deferred errmsg runtime failed"); |
| 111 | assert!( |
| 112 | run.status.success(), |
| 113 | "deferred errmsg runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 114 | run.status, |
| 115 | String::from_utf8_lossy(&run.stdout), |
| 116 | String::from_utf8_lossy(&run.stderr) |
| 117 | ); |
| 118 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 119 | assert!( |
| 120 | stdout.contains("2"), |
| 121 | "expected nonzero STAT in deferred errmsg output: {}", |
| 122 | stdout |
| 123 | ); |
| 124 | assert!( |
| 125 | stdout.contains("ALLOCATE failed"), |
| 126 | "expected deferred errmsg text in output: {}", |
| 127 | stdout |
| 128 | ); |
| 129 | |
| 130 | let _ = std::fs::remove_dir_all(&dir); |
| 131 | } |
| 132 | |
| 133 | #[test] |
| 134 | fn allocate_errmsg_requires_scalar_character_target() { |
| 135 | let dir = unique_dir("alloc_bad_errmsg"); |
| 136 | let src = write_program_in( |
| 137 | &dir, |
| 138 | "main.f90", |
| 139 | "program p\n implicit none\n integer :: ios, msg\n integer, allocatable :: a(:)\n allocate(a(2), stat=ios, errmsg=msg)\nend program\n", |
| 140 | ); |
| 141 | let exe = dir.join("alloc_bad_errmsg.bin"); |
| 142 | let compile = compile_program(&src, &exe); |
| 143 | assert!( |
| 144 | !compile.status.success(), |
| 145 | "compile unexpectedly succeeded:\nstdout:\n{}\nstderr:\n{}", |
| 146 | String::from_utf8_lossy(&compile.stdout), |
| 147 | String::from_utf8_lossy(&compile.stderr) |
| 148 | ); |
| 149 | let stderr = String::from_utf8_lossy(&compile.stderr); |
| 150 | assert!( |
| 151 | stderr.contains("ERRMSG=") && stderr.contains("scalar CHARACTER variable"), |
| 152 | "unexpected compile failure for bad ERRMSG target: {}", |
| 153 | stderr |
| 154 | ); |
| 155 | |
| 156 | let _ = std::fs::remove_dir_all(&dir); |
| 157 | } |
| 158 | |
| 159 | #[test] |
| 160 | fn deallocate_stat_errmsg_leaves_message_unchanged_on_success() { |
| 161 | let dir = unique_dir("dealloc_fixed_errmsg"); |
| 162 | let src = write_program_in( |
| 163 | &dir, |
| 164 | "main.f90", |
| 165 | "program p\n implicit none\n integer :: ios\n integer, allocatable :: a(:)\n character(len=64) :: msg\n allocate(a(2))\n msg = 'unchanged'\n deallocate(a, stat=ios, errmsg=msg)\n if (ios /= 0) error stop 1\n if (trim(msg) /= 'unchanged') error stop 2\n deallocate(a, stat=ios, errmsg=msg)\n if (ios /= 0) error stop 3\n if (trim(msg) /= 'unchanged') error stop 4\n print *, ios\n print *, trim(msg)\nend program\n", |
| 166 | ); |
| 167 | let exe = dir.join("dealloc_fixed_errmsg.bin"); |
| 168 | let compile = compile_program(&src, &exe); |
| 169 | assert!( |
| 170 | compile.status.success(), |
| 171 | "compile failed: {}", |
| 172 | String::from_utf8_lossy(&compile.stderr) |
| 173 | ); |
| 174 | |
| 175 | let run = Command::new(&exe) |
| 176 | .output() |
| 177 | .expect("fixed deallocate errmsg runtime failed"); |
| 178 | assert!( |
| 179 | run.status.success(), |
| 180 | "fixed deallocate errmsg runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 181 | run.status, |
| 182 | String::from_utf8_lossy(&run.stdout), |
| 183 | String::from_utf8_lossy(&run.stderr) |
| 184 | ); |
| 185 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 186 | assert!( |
| 187 | stdout.contains("0"), |
| 188 | "expected zero STAT in fixed deallocate errmsg output: {}", |
| 189 | stdout |
| 190 | ); |
| 191 | assert!( |
| 192 | stdout.contains("unchanged"), |
| 193 | "expected unchanged errmsg text in output: {}", |
| 194 | stdout |
| 195 | ); |
| 196 | |
| 197 | let _ = std::fs::remove_dir_all(&dir); |
| 198 | } |
| 199 | |
| 200 | #[test] |
| 201 | fn allocate_source_array_infers_shape_and_copies_values() { |
| 202 | let dir = unique_dir("alloc_source_array"); |
| 203 | let src = write_program_in( |
| 204 | &dir, |
| 205 | "main.f90", |
| 206 | "program p\n implicit none\n integer, allocatable :: a(:), b(:)\n allocate(b(3))\n b = [10, 20, 30]\n allocate(a, source=b)\n if (.not. allocated(a)) error stop 1\n if (size(a) /= 3) error stop 2\n if (a(1) /= b(1) .or. a(2) /= b(2) .or. a(3) /= b(3)) error stop 3\n b(1) = 99\n if (a(1) /= 10) error stop 4\n print *, size(a)\n print *, a(1), a(2), a(3)\nend program\n", |
| 207 | ); |
| 208 | let exe = dir.join("alloc_source_array.bin"); |
| 209 | let compile = compile_program(&src, &exe); |
| 210 | assert!( |
| 211 | compile.status.success(), |
| 212 | "compile failed: {}", |
| 213 | String::from_utf8_lossy(&compile.stderr) |
| 214 | ); |
| 215 | |
| 216 | let run = Command::new(&exe) |
| 217 | .output() |
| 218 | .expect("source array runtime failed"); |
| 219 | assert!( |
| 220 | run.status.success(), |
| 221 | "source array runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 222 | run.status, |
| 223 | String::from_utf8_lossy(&run.stdout), |
| 224 | String::from_utf8_lossy(&run.stderr) |
| 225 | ); |
| 226 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 227 | assert!( |
| 228 | stdout.contains("3"), |
| 229 | "expected inferred size in output: {}", |
| 230 | stdout |
| 231 | ); |
| 232 | assert!( |
| 233 | stdout.contains("10") && stdout.contains("20") && stdout.contains("30"), |
| 234 | "expected copied values in output: {}", |
| 235 | stdout |
| 236 | ); |
| 237 | |
| 238 | let _ = std::fs::remove_dir_all(&dir); |
| 239 | } |
| 240 | |
| 241 | #[test] |
| 242 | fn allocate_mold_array_infers_shape_without_source_copy() { |
| 243 | let dir = unique_dir("alloc_mold_array"); |
| 244 | let src = write_program_in( |
| 245 | &dir, |
| 246 | "main.f90", |
| 247 | "program p\n implicit none\n integer, allocatable :: a(:), b(:)\n allocate(b(4))\n b = [1, 2, 3, 4]\n allocate(a, mold=b)\n if (.not. allocated(a)) error stop 1\n if (size(a) /= 4) error stop 2\n print *, size(a)\nend program\n", |
| 248 | ); |
| 249 | let exe = dir.join("alloc_mold_array.bin"); |
| 250 | let compile = compile_program(&src, &exe); |
| 251 | assert!( |
| 252 | compile.status.success(), |
| 253 | "compile failed: {}", |
| 254 | String::from_utf8_lossy(&compile.stderr) |
| 255 | ); |
| 256 | |
| 257 | let run = Command::new(&exe) |
| 258 | .output() |
| 259 | .expect("mold array runtime failed"); |
| 260 | assert!( |
| 261 | run.status.success(), |
| 262 | "mold array runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 263 | run.status, |
| 264 | String::from_utf8_lossy(&run.stdout), |
| 265 | String::from_utf8_lossy(&run.stderr) |
| 266 | ); |
| 267 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 268 | assert!( |
| 269 | stdout.contains("4"), |
| 270 | "expected inferred mold size in output: {}", |
| 271 | stdout |
| 272 | ); |
| 273 | |
| 274 | let _ = std::fs::remove_dir_all(&dir); |
| 275 | } |
| 276 | |
| 277 | #[test] |
| 278 | fn allocate_source_scalar_initializes_allocatable_scalar() { |
| 279 | let dir = unique_dir("alloc_source_scalar"); |
| 280 | let src = write_program_in( |
| 281 | &dir, |
| 282 | "main.f90", |
| 283 | "program p\n implicit none\n integer, allocatable :: x\n allocate(x, source=7)\n print *, allocated(x)\n print *, x\nend program\n", |
| 284 | ); |
| 285 | let exe = dir.join("alloc_source_scalar.bin"); |
| 286 | let compile = compile_program(&src, &exe); |
| 287 | assert!( |
| 288 | compile.status.success(), |
| 289 | "compile failed: {}", |
| 290 | String::from_utf8_lossy(&compile.stderr) |
| 291 | ); |
| 292 | |
| 293 | let run = Command::new(&exe) |
| 294 | .output() |
| 295 | .expect("source scalar runtime failed"); |
| 296 | assert!( |
| 297 | run.status.success(), |
| 298 | "source scalar runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 299 | run.status, |
| 300 | String::from_utf8_lossy(&run.stdout), |
| 301 | String::from_utf8_lossy(&run.stderr) |
| 302 | ); |
| 303 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 304 | assert!( |
| 305 | stdout.contains("7"), |
| 306 | "expected initialized scalar in output: {}", |
| 307 | stdout |
| 308 | ); |
| 309 | |
| 310 | let _ = std::fs::remove_dir_all(&dir); |
| 311 | } |
| 312 | |
| 313 | #[test] |
| 314 | fn allocate_component_source_array_infers_shape_and_copies_values() { |
| 315 | let dir = unique_dir("alloc_component_source_array"); |
| 316 | let src = write_program_in( |
| 317 | &dir, |
| 318 | "main.f90", |
| 319 | "program p\n implicit none\n type :: box_t\n integer, allocatable :: vals(:)\n end type box_t\n type(box_t) :: box\n integer, allocatable :: src(:)\n allocate(src(2))\n src = [4, 5]\n allocate(box%vals, source=src)\n if (.not. allocated(box%vals)) error stop 1\n if (size(box%vals) /= 2) error stop 2\n if (box%vals(1) /= src(1) .or. box%vals(2) /= src(2)) error stop 3\n src(1) = 99\n if (box%vals(1) /= 4) error stop 4\n print *, size(box%vals)\n print *, box%vals(1), box%vals(2)\nend program\n", |
| 320 | ); |
| 321 | let exe = dir.join("alloc_component_source_array.bin"); |
| 322 | let compile = compile_program(&src, &exe); |
| 323 | assert!( |
| 324 | compile.status.success(), |
| 325 | "compile failed: {}", |
| 326 | String::from_utf8_lossy(&compile.stderr) |
| 327 | ); |
| 328 | |
| 329 | let run = Command::new(&exe) |
| 330 | .output() |
| 331 | .expect("component source array runtime failed"); |
| 332 | assert!( |
| 333 | run.status.success(), |
| 334 | "component source array runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 335 | run.status, |
| 336 | String::from_utf8_lossy(&run.stdout), |
| 337 | String::from_utf8_lossy(&run.stderr) |
| 338 | ); |
| 339 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 340 | assert!( |
| 341 | stdout.contains("2"), |
| 342 | "expected inferred component size in output: {}", |
| 343 | stdout |
| 344 | ); |
| 345 | assert!( |
| 346 | stdout.contains("4") && stdout.contains("5"), |
| 347 | "expected copied component values in output: {}", |
| 348 | stdout |
| 349 | ); |
| 350 | |
| 351 | let _ = std::fs::remove_dir_all(&dir); |
| 352 | } |
| 353 | |
| 354 | #[test] |
| 355 | fn allocate_source_with_explicit_bounds_preserves_destination_shape() { |
| 356 | let dir = unique_dir("alloc_source_explicit_shape"); |
| 357 | let src = write_program_in( |
| 358 | &dir, |
| 359 | "main.f90", |
| 360 | "program p\n implicit none\n integer, allocatable :: a(:), b(:)\n allocate(b(2))\n b = [4, 5]\n allocate(a(2), source=b)\n if (.not. allocated(a)) error stop 1\n if (size(a) /= 2) error stop 2\n if (a(1) /= 4 .or. a(2) /= 5) error stop 3\n print *, size(a)\n print *, a(1), a(2)\nend program\n", |
| 361 | ); |
| 362 | let exe = dir.join("alloc_source_explicit_shape.bin"); |
| 363 | let compile = compile_program(&src, &exe); |
| 364 | assert!( |
| 365 | compile.status.success(), |
| 366 | "compile failed: {}", |
| 367 | String::from_utf8_lossy(&compile.stderr) |
| 368 | ); |
| 369 | |
| 370 | let run = Command::new(&exe) |
| 371 | .output() |
| 372 | .expect("explicit-shape source runtime failed"); |
| 373 | assert!( |
| 374 | run.status.success(), |
| 375 | "explicit-shape source runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 376 | run.status, |
| 377 | String::from_utf8_lossy(&run.stdout), |
| 378 | String::from_utf8_lossy(&run.stderr) |
| 379 | ); |
| 380 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 381 | assert!( |
| 382 | stdout.contains("2") && stdout.contains("4") && stdout.contains("5"), |
| 383 | "expected explicit-shape copied values in output: {}", |
| 384 | stdout |
| 385 | ); |
| 386 | |
| 387 | let _ = std::fs::remove_dir_all(&dir); |
| 388 | } |
| 389 | |
| 390 | #[test] |
| 391 | fn allocate_source_and_mold_are_rejected_together() { |
| 392 | let dir = unique_dir("alloc_source_mold_conflict"); |
| 393 | let src = write_program_in( |
| 394 | &dir, |
| 395 | "main.f90", |
| 396 | "program p\n implicit none\n integer, allocatable :: a(:), b(:), c(:)\n allocate(b(2), c(2))\n allocate(a, source=b, mold=c)\nend program\n", |
| 397 | ); |
| 398 | let exe = dir.join("alloc_source_mold_conflict.bin"); |
| 399 | let compile = compile_program(&src, &exe); |
| 400 | assert!( |
| 401 | !compile.status.success(), |
| 402 | "compile unexpectedly succeeded:\nstdout:\n{}\nstderr:\n{}", |
| 403 | String::from_utf8_lossy(&compile.stdout), |
| 404 | String::from_utf8_lossy(&compile.stderr) |
| 405 | ); |
| 406 | let stderr = String::from_utf8_lossy(&compile.stderr); |
| 407 | assert!( |
| 408 | stderr.contains("SOURCE=") && stderr.contains("MOLD="), |
| 409 | "unexpected compile failure for SOURCE=/MOLD= conflict: {}", |
| 410 | stderr |
| 411 | ); |
| 412 | |
| 413 | let _ = std::fs::remove_dir_all(&dir); |
| 414 | } |
| 415 |