armfortas Public

Watch 0 Fork 0 Star 0
Rust · 13529 bytes Raw Blame History
1 use std::fs;
2 use std::path::{Path, PathBuf};
3 use std::process::Command;
4 use std::sync::Mutex;
5 use std::sync::atomic::{AtomicUsize, Ordering};
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).ok().and_then(|meta| meta.modified().ok());
104
105 if archive_mtime.is_some_and(|mtime| mtime >= source_mtime) {
106 return;
107 }
108
109 let cargo = std::env::var("CARGO").unwrap_or_else(|_| "cargo".into());
110 let output = Command::new(cargo)
111 .current_dir(workspace_root)
112 .args(["build", "-p", "armfortas-rt"])
113 .output()
114 .expect("cannot rebuild libarmfortas_rt.a");
115 assert!(
116 output.status.success(),
117 "cannot rebuild libarmfortas_rt.a:\n{}",
118 String::from_utf8_lossy(&output.stderr)
119 );
120 }
121
122 fn newest_mtime(path: &Path) -> Option<SystemTime> {
123 let meta = fs::metadata(path).ok()?;
124 let mut newest = meta.modified().ok()?;
125 if meta.is_dir() {
126 for entry in fs::read_dir(path).ok()? {
127 let entry = entry.ok()?;
128 let child = newest_mtime(&entry.path())?;
129 if child > newest {
130 newest = child;
131 }
132 }
133 }
134 Some(newest)
135 }
136
137 fn sdk_root() -> String {
138 let output = Command::new("xcrun")
139 .args(["--show-sdk-path"])
140 .output()
141 .expect("cannot run xcrun");
142 assert!(
143 output.status.success(),
144 "xcrun failed:\n{}",
145 String::from_utf8_lossy(&output.stderr)
146 );
147 String::from_utf8_lossy(&output.stdout).trim().to_string()
148 }
149
150 fn link_objects(objects: &[&Path], output: &Path) {
151 let rt_path = find_runtime_lib();
152 let sysroot = sdk_root();
153 let mut args: Vec<String> = objects
154 .iter()
155 .map(|path| path.to_string_lossy().into_owned())
156 .collect();
157 args.push(rt_path.to_string_lossy().into_owned());
158 args.extend([
159 "-lSystem".into(),
160 "-no_uuid".into(),
161 "-syslibroot".into(),
162 sysroot,
163 "-e".into(),
164 "_main".into(),
165 "-o".into(),
166 output.to_string_lossy().into_owned(),
167 ]);
168
169 let output_status = Command::new("ld")
170 .args(&args)
171 .output()
172 .expect("cannot launch ld");
173 assert!(
174 output_status.status.success(),
175 "ld failed:\n{}",
176 String::from_utf8_lossy(&output_status.stderr)
177 );
178 }
179
180 fn run_binary(binary: &Path) -> std::process::Output {
181 let sandbox = unique_temp_path("i128_cross_object_run", "sandbox", "");
182 fs::create_dir_all(&sandbox).expect("cannot create run sandbox");
183 let output = Command::new(binary)
184 .current_dir(&sandbox)
185 .output()
186 .unwrap_or_else(|e| panic!("cannot run {}: {}", binary.display(), e));
187 let _ = fs::remove_dir_all(&sandbox);
188 output
189 }
190
191 fn tool_output(tool: &str, args: &[&str]) -> String {
192 let output = Command::new(tool)
193 .args(args)
194 .output()
195 .unwrap_or_else(|e| panic!("cannot run {}: {}", tool, e));
196 assert!(
197 output.status.success(),
198 "{} failed:\n{}",
199 tool,
200 String::from_utf8_lossy(&output.stderr)
201 );
202 String::from_utf8_lossy(&output.stdout).into_owned()
203 }
204
205 fn run_cross_object_case_named(
206 program_name: &str,
207 helper_name: &str,
208 opt_level: OptLevel,
209 expected_score: char,
210 ) {
211 let _guard = CROSS_OBJECT_LOCK.lock().unwrap_or_else(|poison| poison.into_inner());
212 let program = fixture(program_name);
213 let helper = fixture(helper_name);
214 let stem = program.file_stem().unwrap().to_str().unwrap();
215 let fortran_obj = unique_temp_path("i128_cross_object", &format!("{}_{}", stem, opt_label(opt_level)), ".o");
216 let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o");
217 let binary = unique_temp_path("i128_cross_object_bin", &format!("{}_{}", stem, opt_label(opt_level)), "");
218
219 compile_fortran_object(&program, &fortran_obj, opt_level);
220 compile_c_object(&helper, &helper_obj);
221 link_objects(&[&fortran_obj, &helper_obj], &binary);
222
223 let run = run_binary(&binary);
224 assert_eq!(
225 run.status.code().unwrap_or(-1),
226 0,
227 "cross-object integer(16) binary should exit successfully:\nstdout:\n{}\nstderr:\n{}",
228 String::from_utf8_lossy(&run.stdout),
229 String::from_utf8_lossy(&run.stderr)
230 );
231 assert!(
232 String::from_utf8_lossy(&run.stdout).contains(expected_score),
233 "cross-object integer(16) binary should print score {}:\n{}",
234 expected_score,
235 String::from_utf8_lossy(&run.stdout)
236 );
237
238 let _ = fs::remove_file(&fortran_obj);
239 let _ = fs::remove_file(&helper_obj);
240 let _ = fs::remove_file(&binary);
241 }
242
243 fn run_cross_object_case(opt_level: OptLevel) {
244 run_cross_object_case_named(
245 "integer16_external_call.f90",
246 "integer16_external_call_helper.c",
247 opt_level,
248 '1',
249 );
250 }
251
252 fn deterministic_cross_object_case_named(program_name: &str, helper_name: &str, opt_level: OptLevel) {
253 let _guard = CROSS_OBJECT_LOCK.lock().unwrap_or_else(|poison| poison.into_inner());
254 let program = fixture(program_name);
255 let helper = fixture(helper_name);
256 let stem = program.file_stem().unwrap().to_str().unwrap();
257 let fortran_obj = unique_temp_path("i128_cross_object", &format!("{}_{}", stem, opt_label(opt_level)), ".o");
258 let helper_obj = unique_temp_path("i128_cross_object_helper", stem, ".o");
259 let binary = unique_temp_path("i128_cross_object_bin", &format!("{}_{}", stem, opt_label(opt_level)), "");
260
261 compile_fortran_object(&program, &fortran_obj, opt_level);
262 compile_c_object(&helper, &helper_obj);
263
264 link_objects(&[&fortran_obj, &helper_obj], &binary);
265 let load_commands = tool_output("otool", &["-l", binary.to_str().unwrap()]);
266 assert!(
267 !load_commands.contains("LC_UUID"),
268 "linked cross-object integer(16) binary should omit LC_UUID:\n{}",
269 load_commands
270 );
271 let first = fs::read(&binary).expect("cannot read first linked binary");
272
273 link_objects(&[&fortran_obj, &helper_obj], &binary);
274 let second = fs::read(&binary).expect("cannot read second linked binary");
275
276 assert_eq!(
277 first, second,
278 "linked cross-object integer(16) binary should be byte-identical across rebuilds"
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 deterministic_cross_object_case(opt_level: OptLevel) {
287 deterministic_cross_object_case_named(
288 "integer16_external_call.f90",
289 "integer16_external_call_helper.c",
290 opt_level,
291 );
292 }
293
294 #[test]
295 fn external_i128_call_runs_across_objects_at_o0() {
296 run_cross_object_case(OptLevel::O0);
297 }
298
299 #[test]
300 fn external_i128_call_runs_across_objects_at_o1() {
301 run_cross_object_case(OptLevel::O1);
302 }
303
304 #[test]
305 fn external_i128_call_runs_across_objects_at_o2() {
306 run_cross_object_case(OptLevel::O2);
307 }
308
309 #[test]
310 fn external_i128_call_runs_across_objects_at_o3() {
311 run_cross_object_case(OptLevel::O3);
312 }
313
314 #[test]
315 fn external_i128_call_runs_across_objects_at_os() {
316 run_cross_object_case(OptLevel::Os);
317 }
318
319 #[test]
320 fn external_i128_call_runs_across_objects_at_ofast() {
321 run_cross_object_case(OptLevel::Ofast);
322 }
323
324 #[test]
325 fn linked_external_i128_binary_is_deterministic_at_o0() {
326 deterministic_cross_object_case(OptLevel::O0);
327 }
328
329 #[test]
330 fn linked_external_i128_binary_is_deterministic_at_o1() {
331 deterministic_cross_object_case(OptLevel::O1);
332 }
333
334 #[test]
335 fn linked_external_i128_binary_is_deterministic_at_o2() {
336 deterministic_cross_object_case(OptLevel::O2);
337 }
338
339 #[test]
340 fn linked_external_i128_binary_is_deterministic_at_o3() {
341 deterministic_cross_object_case(OptLevel::O3);
342 }
343
344 #[test]
345 fn linked_external_i128_binary_is_deterministic_at_os() {
346 deterministic_cross_object_case(OptLevel::Os);
347 }
348
349 #[test]
350 fn linked_external_i128_binary_is_deterministic_at_ofast() {
351 deterministic_cross_object_case(OptLevel::Ofast);
352 }
353
354 #[test]
355 fn external_stack_i128_call_runs_across_objects_at_o0() {
356 run_cross_object_case_named(
357 "integer16_external_stack_call.f90",
358 "integer16_external_stack_call_helper.c",
359 OptLevel::O0,
360 '1',
361 );
362 }
363
364 #[test]
365 fn external_stack_i128_call_runs_across_objects_at_o1() {
366 run_cross_object_case_named(
367 "integer16_external_stack_call.f90",
368 "integer16_external_stack_call_helper.c",
369 OptLevel::O1,
370 '1',
371 );
372 }
373
374 #[test]
375 fn external_stack_i128_call_runs_across_objects_at_o2() {
376 run_cross_object_case_named(
377 "integer16_external_stack_call.f90",
378 "integer16_external_stack_call_helper.c",
379 OptLevel::O2,
380 '1',
381 );
382 }
383
384 #[test]
385 fn external_stack_i128_call_runs_across_objects_at_o3() {
386 run_cross_object_case_named(
387 "integer16_external_stack_call.f90",
388 "integer16_external_stack_call_helper.c",
389 OptLevel::O3,
390 '1',
391 );
392 }
393
394 #[test]
395 fn external_stack_i128_call_runs_across_objects_at_os() {
396 run_cross_object_case_named(
397 "integer16_external_stack_call.f90",
398 "integer16_external_stack_call_helper.c",
399 OptLevel::Os,
400 '1',
401 );
402 }
403
404 #[test]
405 fn external_stack_i128_call_runs_across_objects_at_ofast() {
406 run_cross_object_case_named(
407 "integer16_external_stack_call.f90",
408 "integer16_external_stack_call_helper.c",
409 OptLevel::Ofast,
410 '1',
411 );
412 }
413
414 #[test]
415 fn linked_external_stack_i128_binary_is_deterministic_at_o0() {
416 deterministic_cross_object_case_named(
417 "integer16_external_stack_call.f90",
418 "integer16_external_stack_call_helper.c",
419 OptLevel::O0,
420 );
421 }
422
423 #[test]
424 fn linked_external_stack_i128_binary_is_deterministic_at_o1() {
425 deterministic_cross_object_case_named(
426 "integer16_external_stack_call.f90",
427 "integer16_external_stack_call_helper.c",
428 OptLevel::O1,
429 );
430 }
431
432 #[test]
433 fn linked_external_stack_i128_binary_is_deterministic_at_o2() {
434 deterministic_cross_object_case_named(
435 "integer16_external_stack_call.f90",
436 "integer16_external_stack_call_helper.c",
437 OptLevel::O2,
438 );
439 }
440
441 #[test]
442 fn linked_external_stack_i128_binary_is_deterministic_at_o3() {
443 deterministic_cross_object_case_named(
444 "integer16_external_stack_call.f90",
445 "integer16_external_stack_call_helper.c",
446 OptLevel::O3,
447 );
448 }
449
450 #[test]
451 fn linked_external_stack_i128_binary_is_deterministic_at_os() {
452 deterministic_cross_object_case_named(
453 "integer16_external_stack_call.f90",
454 "integer16_external_stack_call_helper.c",
455 OptLevel::Os,
456 );
457 }
458
459 #[test]
460 fn linked_external_stack_i128_binary_is_deterministic_at_ofast() {
461 deterministic_cross_object_case_named(
462 "integer16_external_stack_call.f90",
463 "integer16_external_stack_call_helper.c",
464 OptLevel::Ofast,
465 );
466 }
467