| 1 | use std::fs; |
| 2 | use std::path::{Path, PathBuf}; |
| 3 | use std::process::Command; |
| 4 | use std::sync::atomic::{AtomicUsize, Ordering}; |
| 5 | use std::sync::Mutex; |
| 6 | use std::time::SystemTime; |
| 7 | |
| 8 | use armfortas::driver::{compile, OptLevel, Options}; |
| 9 | |
| 10 | static NEXT_TEMP_ID: AtomicUsize = AtomicUsize::new(0); |
| 11 | static CROSS_OBJECT_LOCK: Mutex<()> = Mutex::new(()); |
| 12 | |
| 13 | fn fixture(name: &str) -> PathBuf { |
| 14 | let path = PathBuf::from("tests/fixtures").join(name); |
| 15 | assert!(path.exists(), "missing test fixture {}", path.display()); |
| 16 | path |
| 17 | } |
| 18 | |
| 19 | fn unique_temp_path(prefix: &str, stem: &str, ext: &str) -> PathBuf { |
| 20 | let id = NEXT_TEMP_ID.fetch_add(1, Ordering::Relaxed); |
| 21 | std::env::temp_dir().join(format!( |
| 22 | "afs_{}_{}_{}_{}{}", |
| 23 | prefix, |
| 24 | std::process::id(), |
| 25 | id, |
| 26 | stem, |
| 27 | ext |
| 28 | )) |
| 29 | } |
| 30 | |
| 31 | fn compile_fortran_object(source: &Path, output: &Path, opt_level: OptLevel) { |
| 32 | let opts = Options { |
| 33 | input: source.to_path_buf(), |
| 34 | output: Some(output.to_path_buf()), |
| 35 | emit_obj: true, |
| 36 | opt_level, |
| 37 | ..Options::default() |
| 38 | }; |
| 39 | compile(&opts).unwrap_or_else(|e| { |
| 40 | panic!( |
| 41 | "armfortas object compile failed for {}:\n{}", |
| 42 | source.display(), |
| 43 | e |
| 44 | ) |
| 45 | }); |
| 46 | } |
| 47 | |
| 48 | fn opt_label(opt_level: OptLevel) -> &'static str { |
| 49 | match opt_level { |
| 50 | OptLevel::O0 => "o0", |
| 51 | OptLevel::O1 => "o1", |
| 52 | OptLevel::O2 => "o2", |
| 53 | OptLevel::O3 => "o3", |
| 54 | OptLevel::Os => "os", |
| 55 | OptLevel::Ofast => "ofast", |
| 56 | } |
| 57 | } |
| 58 | |
| 59 | fn compile_c_object(source: &Path, output: &Path) { |
| 60 | let output_status = Command::new("clang") |
| 61 | .args([ |
| 62 | "-arch", |
| 63 | "arm64", |
| 64 | "-c", |
| 65 | source.to_str().unwrap(), |
| 66 | "-o", |
| 67 | output.to_str().unwrap(), |
| 68 | ]) |
| 69 | .output() |
| 70 | .expect("cannot launch clang"); |
| 71 | assert!( |
| 72 | output_status.status.success(), |
| 73 | "clang failed for {}:\n{}", |
| 74 | source.display(), |
| 75 | String::from_utf8_lossy(&output_status.stderr) |
| 76 | ); |
| 77 | } |
| 78 | |
| 79 | fn find_runtime_lib() -> PathBuf { |
| 80 | let workspace_root = PathBuf::from("."); |
| 81 | maybe_refresh_runtime_lib(&workspace_root); |
| 82 | for candidate in [ |
| 83 | workspace_root.join("target/debug/libarmfortas_rt.a"), |
| 84 | workspace_root.join("target/release/libarmfortas_rt.a"), |
| 85 | ] { |
| 86 | if candidate.exists() { |
| 87 | return candidate; |
| 88 | } |
| 89 | } |
| 90 | panic!("cannot find libarmfortas_rt.a — build with `cargo build -p armfortas-rt` first"); |
| 91 | } |
| 92 | |
| 93 | fn maybe_refresh_runtime_lib(workspace_root: &Path) { |
| 94 | let runtime_dir = workspace_root.join("runtime"); |
| 95 | if !runtime_dir.join("Cargo.toml").exists() { |
| 96 | return; |
| 97 | } |
| 98 | |
| 99 | let Some(source_mtime) = newest_mtime(&runtime_dir) else { |
| 100 | return; |
| 101 | }; |
| 102 | let debug_archive = workspace_root.join("target/debug/libarmfortas_rt.a"); |
| 103 | let archive_mtime = fs::metadata(&debug_archive) |
| 104 | .ok() |
| 105 | .and_then(|meta| meta.modified().ok()); |
| 106 | |
| 107 | if archive_mtime.is_some_and(|mtime| mtime >= source_mtime) { |
| 108 | return; |
| 109 | } |
| 110 | |
| 111 | let cargo = std::env::var("CARGO").unwrap_or_else(|_| "cargo".into()); |
| 112 | let output = Command::new(cargo) |
| 113 | .current_dir(workspace_root) |
| 114 | .args(["build", "-p", "armfortas-rt"]) |
| 115 | .output() |
| 116 | .expect("cannot rebuild libarmfortas_rt.a"); |
| 117 | assert!( |
| 118 | output.status.success(), |
| 119 | "cannot rebuild libarmfortas_rt.a:\n{}", |
| 120 | String::from_utf8_lossy(&output.stderr) |
| 121 | ); |
| 122 | } |
| 123 | |
| 124 | fn newest_mtime(path: &Path) -> Option<SystemTime> { |
| 125 | let meta = fs::metadata(path).ok()?; |
| 126 | let mut newest = meta.modified().ok()?; |
| 127 | if meta.is_dir() { |
| 128 | for entry in fs::read_dir(path).ok()? { |
| 129 | let entry = entry.ok()?; |
| 130 | let child = newest_mtime(&entry.path())?; |
| 131 | if child > newest { |
| 132 | newest = child; |
| 133 | } |
| 134 | } |
| 135 | } |
| 136 | Some(newest) |
| 137 | } |
| 138 | |
| 139 | fn sdk_root() -> String { |
| 140 | let output = Command::new("xcrun") |
| 141 | .args(["--show-sdk-path"]) |
| 142 | .output() |
| 143 | .expect("cannot run xcrun"); |
| 144 | assert!( |
| 145 | output.status.success(), |
| 146 | "xcrun failed:\n{}", |
| 147 | String::from_utf8_lossy(&output.stderr) |
| 148 | ); |
| 149 | String::from_utf8_lossy(&output.stdout).trim().to_string() |
| 150 | } |
| 151 | |
| 152 | fn link_objects(objects: &[&Path], output: &Path) { |
| 153 | let rt_path = find_runtime_lib(); |
| 154 | let sysroot = sdk_root(); |
| 155 | let mut args: Vec<String> = objects |
| 156 | .iter() |
| 157 | .map(|path| path.to_string_lossy().into_owned()) |
| 158 | .collect(); |
| 159 | args.push(rt_path.to_string_lossy().into_owned()); |
| 160 | args.extend([ |
| 161 | "-lSystem".into(), |
| 162 | "-no_uuid".into(), |
| 163 | "-syslibroot".into(), |
| 164 | sysroot, |
| 165 | "-e".into(), |
| 166 | "_main".into(), |
| 167 | "-o".into(), |
| 168 | output.to_string_lossy().into_owned(), |
| 169 | ]); |
| 170 | |
| 171 | let output_status = Command::new("ld") |
| 172 | .args(&args) |
| 173 | .output() |
| 174 | .expect("cannot launch ld"); |
| 175 | assert!( |
| 176 | output_status.status.success(), |
| 177 | "ld failed:\n{}", |
| 178 | String::from_utf8_lossy(&output_status.stderr) |
| 179 | ); |
| 180 | } |
| 181 | |
| 182 | fn run_binary(binary: &Path) -> std::process::Output { |
| 183 | let sandbox = unique_temp_path("i128_cross_object_run", "sandbox", ""); |
| 184 | fs::create_dir_all(&sandbox).expect("cannot create run sandbox"); |
| 185 | let output = Command::new(binary) |
| 186 | .current_dir(&sandbox) |
| 187 | .output() |
| 188 | .unwrap_or_else(|e| panic!("cannot run {}: {}", binary.display(), e)); |
| 189 | let _ = fs::remove_dir_all(&sandbox); |
| 190 | output |
| 191 | } |
| 192 | |
| 193 | fn tool_output(tool: &str, args: &[&str]) -> String { |
| 194 | let output = Command::new(tool) |
| 195 | .args(args) |
| 196 | .output() |
| 197 | .unwrap_or_else(|e| panic!("cannot run {}: {}", tool, e)); |
| 198 | assert!( |
| 199 | output.status.success(), |
| 200 | "{} failed:\n{}", |
| 201 | tool, |
| 202 | String::from_utf8_lossy(&output.stderr) |
| 203 | ); |
| 204 | String::from_utf8_lossy(&output.stdout).into_owned() |
| 205 | } |
| 206 | |
| 207 | fn run_cross_object_case_named( |
| 208 | program_name: &str, |
| 209 | helper_name: &str, |
| 210 | opt_level: OptLevel, |
| 211 | expected_score: char, |
| 212 | ) { |
| 213 | let _guard = CROSS_OBJECT_LOCK |
| 214 | .lock() |
| 215 | .unwrap_or_else(|poison| poison.into_inner()); |
| 216 | let program = fixture(program_name); |
| 217 | let helper = fixture(helper_name); |
| 218 | let stem = program.file_stem().unwrap().to_str().unwrap(); |
| 219 | let fortran_obj = unique_temp_path( |
| 220 | "i128_cross_object", |
| 221 | &format!("{}_{}", stem, opt_label(opt_level)), |
| 222 | ".o", |
| 223 | ); |
| 224 | let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o"); |
| 225 | let binary = unique_temp_path( |
| 226 | "i128_cross_object_bin", |
| 227 | &format!("{}_{}", stem, opt_label(opt_level)), |
| 228 | "", |
| 229 | ); |
| 230 | |
| 231 | compile_fortran_object(&program, &fortran_obj, opt_level); |
| 232 | compile_c_object(&helper, &helper_obj); |
| 233 | link_objects(&[&fortran_obj, &helper_obj], &binary); |
| 234 | |
| 235 | let run = run_binary(&binary); |
| 236 | assert_eq!( |
| 237 | run.status.code().unwrap_or(-1), |
| 238 | 0, |
| 239 | "cross-object integer(16) binary should exit successfully:\nstdout:\n{}\nstderr:\n{}", |
| 240 | String::from_utf8_lossy(&run.stdout), |
| 241 | String::from_utf8_lossy(&run.stderr) |
| 242 | ); |
| 243 | assert!( |
| 244 | String::from_utf8_lossy(&run.stdout).contains(expected_score), |
| 245 | "cross-object integer(16) binary should print score {}:\n{}", |
| 246 | expected_score, |
| 247 | String::from_utf8_lossy(&run.stdout) |
| 248 | ); |
| 249 | |
| 250 | let _ = fs::remove_file(&fortran_obj); |
| 251 | let _ = fs::remove_file(&helper_obj); |
| 252 | let _ = fs::remove_file(&binary); |
| 253 | } |
| 254 | |
| 255 | fn run_cross_object_case(opt_level: OptLevel) { |
| 256 | run_cross_object_case_named( |
| 257 | "integer16_external_call.f90", |
| 258 | "integer16_external_call_helper.c", |
| 259 | opt_level, |
| 260 | '1', |
| 261 | ); |
| 262 | } |
| 263 | |
| 264 | fn deterministic_cross_object_case_named( |
| 265 | program_name: &str, |
| 266 | helper_name: &str, |
| 267 | opt_level: OptLevel, |
| 268 | ) { |
| 269 | let _guard = CROSS_OBJECT_LOCK |
| 270 | .lock() |
| 271 | .unwrap_or_else(|poison| poison.into_inner()); |
| 272 | let program = fixture(program_name); |
| 273 | let helper = fixture(helper_name); |
| 274 | let stem = program.file_stem().unwrap().to_str().unwrap(); |
| 275 | let fortran_obj = unique_temp_path( |
| 276 | "i128_cross_object", |
| 277 | &format!("{}_{}", stem, opt_label(opt_level)), |
| 278 | ".o", |
| 279 | ); |
| 280 | let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o"); |
| 281 | let binary = unique_temp_path( |
| 282 | "i128_cross_object_bin", |
| 283 | &format!("{}_{}", stem, opt_label(opt_level)), |
| 284 | "", |
| 285 | ); |
| 286 | |
| 287 | compile_fortran_object(&program, &fortran_obj, opt_level); |
| 288 | compile_c_object(&helper, &helper_obj); |
| 289 | |
| 290 | link_objects(&[&fortran_obj, &helper_obj], &binary); |
| 291 | let load_commands = tool_output("otool", &["-l", binary.to_str().unwrap()]); |
| 292 | assert!( |
| 293 | !load_commands.contains("LC_UUID"), |
| 294 | "linked cross-object integer(16) binary should omit LC_UUID:\n{}", |
| 295 | load_commands |
| 296 | ); |
| 297 | let first = fs::read(&binary).expect("cannot read first linked binary"); |
| 298 | |
| 299 | link_objects(&[&fortran_obj, &helper_obj], &binary); |
| 300 | let second = fs::read(&binary).expect("cannot read second linked binary"); |
| 301 | |
| 302 | assert_eq!( |
| 303 | first, second, |
| 304 | "linked cross-object integer(16) binary should be byte-identical across rebuilds" |
| 305 | ); |
| 306 | |
| 307 | let _ = fs::remove_file(&fortran_obj); |
| 308 | let _ = fs::remove_file(&helper_obj); |
| 309 | let _ = fs::remove_file(&binary); |
| 310 | } |
| 311 | |
| 312 | fn deterministic_cross_object_case(opt_level: OptLevel) { |
| 313 | deterministic_cross_object_case_named( |
| 314 | "integer16_external_call.f90", |
| 315 | "integer16_external_call_helper.c", |
| 316 | opt_level, |
| 317 | ); |
| 318 | } |
| 319 | |
| 320 | #[test] |
| 321 | fn external_i128_call_runs_across_objects_at_o0() { |
| 322 | run_cross_object_case(OptLevel::O0); |
| 323 | } |
| 324 | |
| 325 | #[test] |
| 326 | fn external_i128_call_runs_across_objects_at_o1() { |
| 327 | run_cross_object_case(OptLevel::O1); |
| 328 | } |
| 329 | |
| 330 | #[test] |
| 331 | fn external_i128_call_runs_across_objects_at_o2() { |
| 332 | run_cross_object_case(OptLevel::O2); |
| 333 | } |
| 334 | |
| 335 | #[test] |
| 336 | fn external_i128_call_runs_across_objects_at_o3() { |
| 337 | run_cross_object_case(OptLevel::O3); |
| 338 | } |
| 339 | |
| 340 | #[test] |
| 341 | fn external_i128_call_runs_across_objects_at_os() { |
| 342 | run_cross_object_case(OptLevel::Os); |
| 343 | } |
| 344 | |
| 345 | #[test] |
| 346 | fn external_i128_call_runs_across_objects_at_ofast() { |
| 347 | run_cross_object_case(OptLevel::Ofast); |
| 348 | } |
| 349 | |
| 350 | #[test] |
| 351 | fn linked_external_i128_binary_is_deterministic_at_o0() { |
| 352 | deterministic_cross_object_case(OptLevel::O0); |
| 353 | } |
| 354 | |
| 355 | #[test] |
| 356 | fn linked_external_i128_binary_is_deterministic_at_o1() { |
| 357 | deterministic_cross_object_case(OptLevel::O1); |
| 358 | } |
| 359 | |
| 360 | #[test] |
| 361 | fn linked_external_i128_binary_is_deterministic_at_o2() { |
| 362 | deterministic_cross_object_case(OptLevel::O2); |
| 363 | } |
| 364 | |
| 365 | #[test] |
| 366 | fn linked_external_i128_binary_is_deterministic_at_o3() { |
| 367 | deterministic_cross_object_case(OptLevel::O3); |
| 368 | } |
| 369 | |
| 370 | #[test] |
| 371 | fn linked_external_i128_binary_is_deterministic_at_os() { |
| 372 | deterministic_cross_object_case(OptLevel::Os); |
| 373 | } |
| 374 | |
| 375 | #[test] |
| 376 | fn linked_external_i128_binary_is_deterministic_at_ofast() { |
| 377 | deterministic_cross_object_case(OptLevel::Ofast); |
| 378 | } |
| 379 | |
| 380 | #[test] |
| 381 | fn external_stack_i128_call_runs_across_objects_at_o0() { |
| 382 | run_cross_object_case_named( |
| 383 | "integer16_external_stack_call.f90", |
| 384 | "integer16_external_stack_call_helper.c", |
| 385 | OptLevel::O0, |
| 386 | '1', |
| 387 | ); |
| 388 | } |
| 389 | |
| 390 | #[test] |
| 391 | fn external_stack_i128_call_runs_across_objects_at_o1() { |
| 392 | run_cross_object_case_named( |
| 393 | "integer16_external_stack_call.f90", |
| 394 | "integer16_external_stack_call_helper.c", |
| 395 | OptLevel::O1, |
| 396 | '1', |
| 397 | ); |
| 398 | } |
| 399 | |
| 400 | #[test] |
| 401 | fn external_stack_i128_call_runs_across_objects_at_o2() { |
| 402 | run_cross_object_case_named( |
| 403 | "integer16_external_stack_call.f90", |
| 404 | "integer16_external_stack_call_helper.c", |
| 405 | OptLevel::O2, |
| 406 | '1', |
| 407 | ); |
| 408 | } |
| 409 | |
| 410 | #[test] |
| 411 | fn external_stack_i128_call_runs_across_objects_at_o3() { |
| 412 | run_cross_object_case_named( |
| 413 | "integer16_external_stack_call.f90", |
| 414 | "integer16_external_stack_call_helper.c", |
| 415 | OptLevel::O3, |
| 416 | '1', |
| 417 | ); |
| 418 | } |
| 419 | |
| 420 | #[test] |
| 421 | fn external_stack_i128_call_runs_across_objects_at_os() { |
| 422 | run_cross_object_case_named( |
| 423 | "integer16_external_stack_call.f90", |
| 424 | "integer16_external_stack_call_helper.c", |
| 425 | OptLevel::Os, |
| 426 | '1', |
| 427 | ); |
| 428 | } |
| 429 | |
| 430 | #[test] |
| 431 | fn external_stack_i128_call_runs_across_objects_at_ofast() { |
| 432 | run_cross_object_case_named( |
| 433 | "integer16_external_stack_call.f90", |
| 434 | "integer16_external_stack_call_helper.c", |
| 435 | OptLevel::Ofast, |
| 436 | '1', |
| 437 | ); |
| 438 | } |
| 439 | |
| 440 | #[test] |
| 441 | fn linked_external_stack_i128_binary_is_deterministic_at_o0() { |
| 442 | deterministic_cross_object_case_named( |
| 443 | "integer16_external_stack_call.f90", |
| 444 | "integer16_external_stack_call_helper.c", |
| 445 | OptLevel::O0, |
| 446 | ); |
| 447 | } |
| 448 | |
| 449 | #[test] |
| 450 | fn linked_external_stack_i128_binary_is_deterministic_at_o1() { |
| 451 | deterministic_cross_object_case_named( |
| 452 | "integer16_external_stack_call.f90", |
| 453 | "integer16_external_stack_call_helper.c", |
| 454 | OptLevel::O1, |
| 455 | ); |
| 456 | } |
| 457 | |
| 458 | #[test] |
| 459 | fn linked_external_stack_i128_binary_is_deterministic_at_o2() { |
| 460 | deterministic_cross_object_case_named( |
| 461 | "integer16_external_stack_call.f90", |
| 462 | "integer16_external_stack_call_helper.c", |
| 463 | OptLevel::O2, |
| 464 | ); |
| 465 | } |
| 466 | |
| 467 | #[test] |
| 468 | fn linked_external_stack_i128_binary_is_deterministic_at_o3() { |
| 469 | deterministic_cross_object_case_named( |
| 470 | "integer16_external_stack_call.f90", |
| 471 | "integer16_external_stack_call_helper.c", |
| 472 | OptLevel::O3, |
| 473 | ); |
| 474 | } |
| 475 | |
| 476 | #[test] |
| 477 | fn linked_external_stack_i128_binary_is_deterministic_at_os() { |
| 478 | deterministic_cross_object_case_named( |
| 479 | "integer16_external_stack_call.f90", |
| 480 | "integer16_external_stack_call_helper.c", |
| 481 | OptLevel::Os, |
| 482 | ); |
| 483 | } |
| 484 | |
| 485 | #[test] |
| 486 | fn linked_external_stack_i128_binary_is_deterministic_at_ofast() { |
| 487 | deterministic_cross_object_case_named( |
| 488 | "integer16_external_stack_call.f90", |
| 489 | "integer16_external_stack_call_helper.c", |
| 490 | OptLevel::Ofast, |
| 491 | ); |
| 492 | } |
| 493 |