armfortas Public

Watch 0 Fork 0 Star 0
Rust · 14773 bytes Raw Blame History
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 "-syslibroot".into(),
163 sysroot,
164 "-e".into(),
165 "_main".into(),
166 "-o".into(),
167 output.to_string_lossy().into_owned(),
168 ]);
169
170 let output_status = Command::new("ld")
171 .args(&args)
172 .output()
173 .expect("cannot launch ld");
174 assert!(
175 output_status.status.success(),
176 "ld failed:\n{}",
177 String::from_utf8_lossy(&output_status.stderr)
178 );
179 }
180
181 fn run_binary(binary: &Path) -> std::process::Output {
182 let sandbox = unique_temp_path("i128_cross_object_run", "sandbox", "");
183 fs::create_dir_all(&sandbox).expect("cannot create run sandbox");
184 let output = Command::new(binary)
185 .current_dir(&sandbox)
186 .output()
187 .unwrap_or_else(|e| panic!("cannot run {}: {}", binary.display(), e));
188 let _ = fs::remove_dir_all(&sandbox);
189 output
190 }
191
192 fn tool_output(tool: &str, args: &[&str]) -> String {
193 let output = Command::new(tool)
194 .args(args)
195 .output()
196 .unwrap_or_else(|e| panic!("cannot run {}: {}", tool, e));
197 assert!(
198 output.status.success(),
199 "{} failed:\n{}",
200 tool,
201 String::from_utf8_lossy(&output.stderr)
202 );
203 String::from_utf8_lossy(&output.stdout).into_owned()
204 }
205
206 fn normalize_lc_uuid(mut bytes: Vec<u8>) -> Vec<u8> {
207 const MH_MAGIC_64: u32 = 0xfeedfacf;
208 const LC_UUID: u32 = 0x1b;
209 const MACH_HEADER_64_SIZE: usize = 32;
210
211 if bytes.len() < MACH_HEADER_64_SIZE {
212 return bytes;
213 }
214 let magic = u32::from_le_bytes(bytes[0..4].try_into().unwrap());
215 if magic != MH_MAGIC_64 {
216 return bytes;
217 }
218 let ncmds = u32::from_le_bytes(bytes[16..20].try_into().unwrap()) as usize;
219 let mut offset = MACH_HEADER_64_SIZE;
220 for _ in 0..ncmds {
221 if offset + 8 > bytes.len() {
222 break;
223 }
224 let cmd = u32::from_le_bytes(bytes[offset..offset + 4].try_into().unwrap());
225 let cmdsize = u32::from_le_bytes(bytes[offset + 4..offset + 8].try_into().unwrap());
226 let cmdsize = cmdsize as usize;
227 if cmdsize < 8 || offset + cmdsize > bytes.len() {
228 break;
229 }
230 if cmd == LC_UUID && cmdsize >= 24 {
231 bytes[offset + 8..offset + 24].fill(0);
232 }
233 offset += cmdsize;
234 }
235 bytes
236 }
237
238 fn run_cross_object_case_named(
239 program_name: &str,
240 helper_name: &str,
241 opt_level: OptLevel,
242 expected_score: char,
243 ) {
244 let _guard = CROSS_OBJECT_LOCK
245 .lock()
246 .unwrap_or_else(|poison| poison.into_inner());
247 let program = fixture(program_name);
248 let helper = fixture(helper_name);
249 let stem = program.file_stem().unwrap().to_str().unwrap();
250 let fortran_obj = unique_temp_path(
251 "i128_cross_object",
252 &format!("{}_{}", stem, opt_label(opt_level)),
253 ".o",
254 );
255 let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o");
256 let binary = unique_temp_path(
257 "i128_cross_object_bin",
258 &format!("{}_{}", stem, opt_label(opt_level)),
259 "",
260 );
261
262 compile_fortran_object(&program, &fortran_obj, opt_level);
263 compile_c_object(&helper, &helper_obj);
264 link_objects(&[&fortran_obj, &helper_obj], &binary);
265
266 let run = run_binary(&binary);
267 assert_eq!(
268 run.status.code().unwrap_or(-1),
269 0,
270 "cross-object integer(16) binary should exit successfully:\nstdout:\n{}\nstderr:\n{}",
271 String::from_utf8_lossy(&run.stdout),
272 String::from_utf8_lossy(&run.stderr)
273 );
274 assert!(
275 String::from_utf8_lossy(&run.stdout).contains(expected_score),
276 "cross-object integer(16) binary should print score {}:\n{}",
277 expected_score,
278 String::from_utf8_lossy(&run.stdout)
279 );
280
281 let _ = fs::remove_file(&fortran_obj);
282 let _ = fs::remove_file(&helper_obj);
283 let _ = fs::remove_file(&binary);
284 }
285
286 fn run_cross_object_case(opt_level: OptLevel) {
287 run_cross_object_case_named(
288 "integer16_external_call.f90",
289 "integer16_external_call_helper.c",
290 opt_level,
291 '1',
292 );
293 }
294
295 fn deterministic_cross_object_case_named(
296 program_name: &str,
297 helper_name: &str,
298 opt_level: OptLevel,
299 ) {
300 let _guard = CROSS_OBJECT_LOCK
301 .lock()
302 .unwrap_or_else(|poison| poison.into_inner());
303 let program = fixture(program_name);
304 let helper = fixture(helper_name);
305 let stem = program.file_stem().unwrap().to_str().unwrap();
306 let fortran_obj = unique_temp_path(
307 "i128_cross_object",
308 &format!("{}_{}", stem, opt_label(opt_level)),
309 ".o",
310 );
311 let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o");
312 let binary = unique_temp_path(
313 "i128_cross_object_bin",
314 &format!("{}_{}", stem, opt_label(opt_level)),
315 "",
316 );
317
318 compile_fortran_object(&program, &fortran_obj, opt_level);
319 compile_c_object(&helper, &helper_obj);
320
321 link_objects(&[&fortran_obj, &helper_obj], &binary);
322 let load_commands = tool_output("otool", &["-l", binary.to_str().unwrap()]);
323 assert!(
324 load_commands.contains("LC_UUID"),
325 "linked cross-object integer(16) binary should carry LC_UUID:\n{}",
326 load_commands
327 );
328 let first = normalize_lc_uuid(fs::read(&binary).expect("cannot read first linked binary"));
329
330 link_objects(&[&fortran_obj, &helper_obj], &binary);
331 let second = normalize_lc_uuid(fs::read(&binary).expect("cannot read second linked binary"));
332
333 assert_eq!(
334 first, second,
335 "linked cross-object integer(16) binary should stay deterministic modulo LC_UUID"
336 );
337
338 let _ = fs::remove_file(&fortran_obj);
339 let _ = fs::remove_file(&helper_obj);
340 let _ = fs::remove_file(&binary);
341 }
342
343 fn deterministic_cross_object_case(opt_level: OptLevel) {
344 deterministic_cross_object_case_named(
345 "integer16_external_call.f90",
346 "integer16_external_call_helper.c",
347 opt_level,
348 );
349 }
350
351 #[test]
352 fn external_i128_call_runs_across_objects_at_o0() {
353 run_cross_object_case(OptLevel::O0);
354 }
355
356 #[test]
357 fn external_i128_call_runs_across_objects_at_o1() {
358 run_cross_object_case(OptLevel::O1);
359 }
360
361 #[test]
362 fn external_i128_call_runs_across_objects_at_o2() {
363 run_cross_object_case(OptLevel::O2);
364 }
365
366 #[test]
367 fn external_i128_call_runs_across_objects_at_o3() {
368 run_cross_object_case(OptLevel::O3);
369 }
370
371 #[test]
372 fn external_i128_call_runs_across_objects_at_os() {
373 run_cross_object_case(OptLevel::Os);
374 }
375
376 #[test]
377 fn external_i128_call_runs_across_objects_at_ofast() {
378 run_cross_object_case(OptLevel::Ofast);
379 }
380
381 #[test]
382 fn linked_external_i128_binary_is_deterministic_at_o0() {
383 deterministic_cross_object_case(OptLevel::O0);
384 }
385
386 #[test]
387 fn linked_external_i128_binary_is_deterministic_at_o1() {
388 deterministic_cross_object_case(OptLevel::O1);
389 }
390
391 #[test]
392 fn linked_external_i128_binary_is_deterministic_at_o2() {
393 deterministic_cross_object_case(OptLevel::O2);
394 }
395
396 #[test]
397 fn linked_external_i128_binary_is_deterministic_at_o3() {
398 deterministic_cross_object_case(OptLevel::O3);
399 }
400
401 #[test]
402 fn linked_external_i128_binary_is_deterministic_at_os() {
403 deterministic_cross_object_case(OptLevel::Os);
404 }
405
406 #[test]
407 fn linked_external_i128_binary_is_deterministic_at_ofast() {
408 deterministic_cross_object_case(OptLevel::Ofast);
409 }
410
411 #[test]
412 fn external_stack_i128_call_runs_across_objects_at_o0() {
413 run_cross_object_case_named(
414 "integer16_external_stack_call.f90",
415 "integer16_external_stack_call_helper.c",
416 OptLevel::O0,
417 '1',
418 );
419 }
420
421 #[test]
422 fn external_stack_i128_call_runs_across_objects_at_o1() {
423 run_cross_object_case_named(
424 "integer16_external_stack_call.f90",
425 "integer16_external_stack_call_helper.c",
426 OptLevel::O1,
427 '1',
428 );
429 }
430
431 #[test]
432 fn external_stack_i128_call_runs_across_objects_at_o2() {
433 run_cross_object_case_named(
434 "integer16_external_stack_call.f90",
435 "integer16_external_stack_call_helper.c",
436 OptLevel::O2,
437 '1',
438 );
439 }
440
441 #[test]
442 fn external_stack_i128_call_runs_across_objects_at_o3() {
443 run_cross_object_case_named(
444 "integer16_external_stack_call.f90",
445 "integer16_external_stack_call_helper.c",
446 OptLevel::O3,
447 '1',
448 );
449 }
450
451 #[test]
452 fn external_stack_i128_call_runs_across_objects_at_os() {
453 run_cross_object_case_named(
454 "integer16_external_stack_call.f90",
455 "integer16_external_stack_call_helper.c",
456 OptLevel::Os,
457 '1',
458 );
459 }
460
461 #[test]
462 fn external_stack_i128_call_runs_across_objects_at_ofast() {
463 run_cross_object_case_named(
464 "integer16_external_stack_call.f90",
465 "integer16_external_stack_call_helper.c",
466 OptLevel::Ofast,
467 '1',
468 );
469 }
470
471 #[test]
472 fn linked_external_stack_i128_binary_is_deterministic_at_o0() {
473 deterministic_cross_object_case_named(
474 "integer16_external_stack_call.f90",
475 "integer16_external_stack_call_helper.c",
476 OptLevel::O0,
477 );
478 }
479
480 #[test]
481 fn linked_external_stack_i128_binary_is_deterministic_at_o1() {
482 deterministic_cross_object_case_named(
483 "integer16_external_stack_call.f90",
484 "integer16_external_stack_call_helper.c",
485 OptLevel::O1,
486 );
487 }
488
489 #[test]
490 fn linked_external_stack_i128_binary_is_deterministic_at_o2() {
491 deterministic_cross_object_case_named(
492 "integer16_external_stack_call.f90",
493 "integer16_external_stack_call_helper.c",
494 OptLevel::O2,
495 );
496 }
497
498 #[test]
499 fn linked_external_stack_i128_binary_is_deterministic_at_o3() {
500 deterministic_cross_object_case_named(
501 "integer16_external_stack_call.f90",
502 "integer16_external_stack_call_helper.c",
503 OptLevel::O3,
504 );
505 }
506
507 #[test]
508 fn linked_external_stack_i128_binary_is_deterministic_at_os() {
509 deterministic_cross_object_case_named(
510 "integer16_external_stack_call.f90",
511 "integer16_external_stack_call_helper.c",
512 OptLevel::Os,
513 );
514 }
515
516 #[test]
517 fn linked_external_stack_i128_binary_is_deterministic_at_ofast() {
518 deterministic_cross_object_case_named(
519 "integer16_external_stack_call.f90",
520 "integer16_external_stack_call_helper.c",
521 OptLevel::Ofast,
522 );
523 }
524