| 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_callconv_{}_{}_{}.{}", 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 calling-convention 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 calling-convention test source"); |
| 41 | path |
| 42 | } |
| 43 | |
| 44 | fn compile_c_object(source: &std::path::Path, output: &std::path::Path) { |
| 45 | let result = Command::new("clang") |
| 46 | .args([ |
| 47 | "-arch", |
| 48 | "arm64", |
| 49 | "-c", |
| 50 | source.to_str().unwrap(), |
| 51 | "-o", |
| 52 | output.to_str().unwrap(), |
| 53 | ]) |
| 54 | .output() |
| 55 | .expect("failed to spawn clang"); |
| 56 | assert!( |
| 57 | result.status.success(), |
| 58 | "clang failed for {}: {}", |
| 59 | source.display(), |
| 60 | String::from_utf8_lossy(&result.stderr) |
| 61 | ); |
| 62 | } |
| 63 | |
| 64 | fn compile_fortran_object(source: &std::path::Path, output: &std::path::Path) { |
| 65 | let result = Command::new(compiler("armfortas")) |
| 66 | .args([ |
| 67 | "-c", |
| 68 | source.to_str().unwrap(), |
| 69 | "-o", |
| 70 | output.to_str().unwrap(), |
| 71 | ]) |
| 72 | .output() |
| 73 | .expect("failed to spawn armfortas object compile"); |
| 74 | assert!( |
| 75 | result.status.success(), |
| 76 | "armfortas failed for {}: {}", |
| 77 | source.display(), |
| 78 | String::from_utf8_lossy(&result.stderr) |
| 79 | ); |
| 80 | } |
| 81 | |
| 82 | fn compile_fortran_program(source: &std::path::Path, output: &std::path::Path) { |
| 83 | let result = Command::new(compiler("armfortas")) |
| 84 | .args([source.to_str().unwrap(), "-o", output.to_str().unwrap()]) |
| 85 | .output() |
| 86 | .expect("failed to spawn armfortas program compile"); |
| 87 | assert!( |
| 88 | result.status.success(), |
| 89 | "armfortas failed for {}: {}", |
| 90 | source.display(), |
| 91 | String::from_utf8_lossy(&result.stderr) |
| 92 | ); |
| 93 | } |
| 94 | |
| 95 | fn link_program(objects: &[&std::path::Path], output: &std::path::Path) { |
| 96 | let mut cmd = Command::new(compiler("armfortas")); |
| 97 | for object in objects { |
| 98 | cmd.arg(object); |
| 99 | } |
| 100 | let result = cmd |
| 101 | .args(["-o", output.to_str().unwrap()]) |
| 102 | .output() |
| 103 | .expect("failed to spawn armfortas link"); |
| 104 | assert!( |
| 105 | result.status.success(), |
| 106 | "link failed: {}", |
| 107 | String::from_utf8_lossy(&result.stderr) |
| 108 | ); |
| 109 | } |
| 110 | |
| 111 | #[test] |
| 112 | fn bind_c_mixed_gp_fp_value_args_match_c_peer() { |
| 113 | let dir = unique_dir("mixed_gp_fp"); |
| 114 | let c_src = write_program_in( |
| 115 | &dir, |
| 116 | "check_mix.c", |
| 117 | "#include <stdint.h>\n\nint check_mix(int32_t a1, double d1, int32_t a2, float s1, int64_t a3, double d2, int32_t a4, float s2) {\n if (a1 != 11) return 1;\n if (d1 != 1.25) return 2;\n if (a2 != 22) return 3;\n if (s1 != 2.5f) return 4;\n if (a3 != 33) return 5;\n if (d2 != 3.75) return 6;\n if (a4 != 44) return 7;\n if (s2 != 4.25f) return 8;\n return 0;\n}\n", |
| 118 | ); |
| 119 | let c_obj = dir.join("check_mix.o"); |
| 120 | compile_c_object(&c_src, &c_obj); |
| 121 | |
| 122 | let f_src = write_program_in( |
| 123 | &dir, |
| 124 | "main.f90", |
| 125 | "program p\n use iso_c_binding, only: c_int, c_long_long, c_float, c_double\n implicit none\n interface\n function check_mix(a1, d1, a2, s1, a3, d2, a4, s2) result(rc) bind(C, name='check_mix')\n import :: c_int, c_long_long, c_float, c_double\n integer(c_int), value :: a1, a2, a4\n integer(c_long_long), value :: a3\n real(c_double), value :: d1, d2\n real(c_float), value :: s1, s2\n integer(c_int) :: rc\n end function check_mix\n end interface\n integer(c_int) :: rc\n\n rc = check_mix(11_c_int, 1.25_c_double, 22_c_int, 2.5_c_float, 33_c_long_long, 3.75_c_double, 44_c_int, 4.25_c_float)\n if (rc /= 0_c_int) error stop rc\n print *, 'ok'\nend program\n", |
| 126 | ); |
| 127 | let f_obj = dir.join("main.o"); |
| 128 | compile_fortran_object(&f_src, &f_obj); |
| 129 | |
| 130 | let exe = dir.join("mixed_gp_fp.bin"); |
| 131 | link_program(&[&f_obj, &c_obj], &exe); |
| 132 | |
| 133 | let run = Command::new(&exe) |
| 134 | .output() |
| 135 | .expect("mixed GP/FP runtime failed"); |
| 136 | assert!( |
| 137 | run.status.success(), |
| 138 | "mixed GP/FP runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 139 | run.status, |
| 140 | String::from_utf8_lossy(&run.stdout), |
| 141 | String::from_utf8_lossy(&run.stderr) |
| 142 | ); |
| 143 | assert!( |
| 144 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 145 | "unexpected mixed GP/FP output: {}", |
| 146 | String::from_utf8_lossy(&run.stdout) |
| 147 | ); |
| 148 | |
| 149 | let _ = std::fs::remove_dir_all(&dir); |
| 150 | } |
| 151 | |
| 152 | #[test] |
| 153 | fn bind_c_ninth_integer_arg_spills_with_fp_args_still_in_registers() { |
| 154 | let dir = unique_dir("gp_spill"); |
| 155 | let c_src = write_program_in( |
| 156 | &dir, |
| 157 | "check_gp_spill.c", |
| 158 | "#include <stdint.h>\n\nint check_gp_spill(int32_t a1, double d1, int32_t a2, double d2, int32_t a3, double d3, int32_t a4, double d4, int32_t a5, int32_t a6, int32_t a7, int32_t a8, int32_t a9) {\n if (a1 != 11) return 1;\n if (d1 != 1.25) return 2;\n if (a2 != 22) return 3;\n if (d2 != 2.5) return 4;\n if (a3 != 33) return 5;\n if (d3 != 3.75) return 6;\n if (a4 != 44) return 7;\n if (d4 != 4.5) return 8;\n if (a5 != 55) return 9;\n if (a6 != 66) return 10;\n if (a7 != 77) return 11;\n if (a8 != 88) return 12;\n if (a9 != 99) return 13;\n return 0;\n}\n", |
| 159 | ); |
| 160 | let c_obj = dir.join("check_gp_spill.o"); |
| 161 | compile_c_object(&c_src, &c_obj); |
| 162 | |
| 163 | let f_src = write_program_in( |
| 164 | &dir, |
| 165 | "main.f90", |
| 166 | "program p\n use iso_c_binding, only: c_int, c_double\n implicit none\n interface\n function check_gp_spill(a1, d1, a2, d2, a3, d3, a4, d4, a5, a6, a7, a8, a9) result(rc) bind(C, name='check_gp_spill')\n import :: c_int, c_double\n integer(c_int), value :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(c_double), value :: d1, d2, d3, d4\n integer(c_int) :: rc\n end function check_gp_spill\n end interface\n integer(c_int) :: rc\n\n rc = check_gp_spill(11_c_int, 1.25_c_double, 22_c_int, 2.5_c_double, 33_c_int, 3.75_c_double, 44_c_int, 4.5_c_double, 55_c_int, 66_c_int, 77_c_int, 88_c_int, 99_c_int)\n if (rc /= 0_c_int) error stop rc\n print *, 'ok'\nend program\n", |
| 167 | ); |
| 168 | let f_obj = dir.join("main.o"); |
| 169 | compile_fortran_object(&f_src, &f_obj); |
| 170 | |
| 171 | let exe = dir.join("gp_spill.bin"); |
| 172 | link_program(&[&f_obj, &c_obj], &exe); |
| 173 | |
| 174 | let run = Command::new(&exe) |
| 175 | .output() |
| 176 | .expect("GP spill runtime failed"); |
| 177 | assert!( |
| 178 | run.status.success(), |
| 179 | "GP spill runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 180 | run.status, |
| 181 | String::from_utf8_lossy(&run.stdout), |
| 182 | String::from_utf8_lossy(&run.stderr) |
| 183 | ); |
| 184 | assert!( |
| 185 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 186 | "unexpected GP spill output: {}", |
| 187 | String::from_utf8_lossy(&run.stdout) |
| 188 | ); |
| 189 | |
| 190 | let _ = std::fs::remove_dir_all(&dir); |
| 191 | } |
| 192 | |
| 193 | #[test] |
| 194 | fn bind_c_ninth_float_arg_spills_with_integer_args_still_in_registers() { |
| 195 | let dir = unique_dir("fp_spill"); |
| 196 | let c_src = write_program_in( |
| 197 | &dir, |
| 198 | "check_fp_spill.c", |
| 199 | "#include <stdint.h>\n\nint check_fp_spill(double d1, int32_t a1, double d2, int32_t a2, double d3, int32_t a3, double d4, int32_t a4, double d5, double d6, double d7, double d8, double d9) {\n if (d1 != 1.25) return 1;\n if (a1 != 11) return 2;\n if (d2 != 2.5) return 3;\n if (a2 != 22) return 4;\n if (d3 != 3.75) return 5;\n if (a3 != 33) return 6;\n if (d4 != 4.5) return 7;\n if (a4 != 44) return 8;\n if (d5 != 5.25) return 9;\n if (d6 != 6.5) return 10;\n if (d7 != 7.75) return 11;\n if (d8 != 8.5) return 12;\n if (d9 != 9.25) return 13;\n return 0;\n}\n", |
| 200 | ); |
| 201 | let c_obj = dir.join("check_fp_spill.o"); |
| 202 | compile_c_object(&c_src, &c_obj); |
| 203 | |
| 204 | let f_src = write_program_in( |
| 205 | &dir, |
| 206 | "main.f90", |
| 207 | "program p\n use iso_c_binding, only: c_int, c_double\n implicit none\n interface\n function check_fp_spill(d1, a1, d2, a2, d3, a3, d4, a4, d5, d6, d7, d8, d9) result(rc) bind(C, name='check_fp_spill')\n import :: c_int, c_double\n real(c_double), value :: d1, d2, d3, d4, d5, d6, d7, d8, d9\n integer(c_int), value :: a1, a2, a3, a4\n integer(c_int) :: rc\n end function check_fp_spill\n end interface\n integer(c_int) :: rc\n\n rc = check_fp_spill(1.25_c_double, 11_c_int, 2.5_c_double, 22_c_int, 3.75_c_double, 33_c_int, 4.5_c_double, 44_c_int, 5.25_c_double, 6.5_c_double, 7.75_c_double, 8.5_c_double, 9.25_c_double)\n if (rc /= 0_c_int) error stop rc\n print *, 'ok'\nend program\n", |
| 208 | ); |
| 209 | let f_obj = dir.join("main.o"); |
| 210 | compile_fortran_object(&f_src, &f_obj); |
| 211 | |
| 212 | let exe = dir.join("fp_spill.bin"); |
| 213 | link_program(&[&f_obj, &c_obj], &exe); |
| 214 | |
| 215 | let run = Command::new(&exe) |
| 216 | .output() |
| 217 | .expect("FP spill runtime failed"); |
| 218 | assert!( |
| 219 | run.status.success(), |
| 220 | "FP spill runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 221 | run.status, |
| 222 | String::from_utf8_lossy(&run.stdout), |
| 223 | String::from_utf8_lossy(&run.stderr) |
| 224 | ); |
| 225 | assert!( |
| 226 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 227 | "unexpected FP spill output: {}", |
| 228 | String::from_utf8_lossy(&run.stdout) |
| 229 | ); |
| 230 | |
| 231 | let _ = std::fs::remove_dir_all(&dir); |
| 232 | } |
| 233 | |
| 234 | #[test] |
| 235 | fn bind_c_signed_char_value_args_keep_narrow_stack_widths() { |
| 236 | let dir = unique_dir("i8_stack"); |
| 237 | let c_src = write_program_in( |
| 238 | &dir, |
| 239 | "check_i8_stack.c", |
| 240 | "#include <stdint.h>\n\nint check_i8_stack(int8_t a1, int8_t a2, int8_t a3, int8_t a4, int8_t a5, int8_t a6, int8_t a7, int8_t a8, int8_t a9, int8_t a10) {\n if (a1 != 1) return 1;\n if (a2 != 2) return 2;\n if (a3 != 3) return 3;\n if (a4 != 4) return 4;\n if (a5 != 5) return 5;\n if (a6 != 6) return 6;\n if (a7 != 7) return 7;\n if (a8 != 8) return 8;\n if (a9 != 9) return 9;\n if (a10 != 10) return 10;\n return 19;\n}\n", |
| 241 | ); |
| 242 | let c_obj = dir.join("check_i8_stack.o"); |
| 243 | compile_c_object(&c_src, &c_obj); |
| 244 | |
| 245 | let f_src = write_program_in( |
| 246 | &dir, |
| 247 | "main.f90", |
| 248 | "program p\n use iso_c_binding, only: c_int, c_signed_char\n implicit none\n interface\n function check_i8_stack(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) result(rc) bind(C, name='check_i8_stack')\n import :: c_int, c_signed_char\n integer(c_signed_char), value :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10\n integer(c_int) :: rc\n end function check_i8_stack\n end interface\n integer(c_int) :: rc\n\n rc = check_i8_stack(1_c_signed_char, 2_c_signed_char, 3_c_signed_char, 4_c_signed_char, 5_c_signed_char, 6_c_signed_char, 7_c_signed_char, 8_c_signed_char, 9_c_signed_char, 10_c_signed_char)\n if (rc /= 19_c_int) error stop rc\n print *, 'ok'\nend program\n", |
| 249 | ); |
| 250 | let f_obj = dir.join("main.o"); |
| 251 | compile_fortran_object(&f_src, &f_obj); |
| 252 | |
| 253 | let exe = dir.join("i8_stack.bin"); |
| 254 | link_program(&[&f_obj, &c_obj], &exe); |
| 255 | |
| 256 | let run = Command::new(&exe) |
| 257 | .output() |
| 258 | .expect("c_signed_char stack runtime failed"); |
| 259 | assert!( |
| 260 | run.status.success(), |
| 261 | "c_signed_char stack runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 262 | run.status, |
| 263 | String::from_utf8_lossy(&run.stdout), |
| 264 | String::from_utf8_lossy(&run.stderr) |
| 265 | ); |
| 266 | assert!( |
| 267 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 268 | "unexpected c_signed_char stack output: {}", |
| 269 | String::from_utf8_lossy(&run.stdout) |
| 270 | ); |
| 271 | |
| 272 | let _ = std::fs::remove_dir_all(&dir); |
| 273 | } |
| 274 | |
| 275 | #[test] |
| 276 | fn bind_c_short_value_args_keep_narrow_stack_widths() { |
| 277 | let dir = unique_dir("i16_stack"); |
| 278 | let c_src = write_program_in( |
| 279 | &dir, |
| 280 | "check_i16_stack.c", |
| 281 | "#include <stdint.h>\n\nint check_i16_stack(int16_t a1, int16_t a2, int16_t a3, int16_t a4, int16_t a5, int16_t a6, int16_t a7, int16_t a8, int16_t a9, int16_t a10) {\n if (a1 != 1) return 1;\n if (a2 != 2) return 2;\n if (a3 != 3) return 3;\n if (a4 != 4) return 4;\n if (a5 != 5) return 5;\n if (a6 != 6) return 6;\n if (a7 != 7) return 7;\n if (a8 != 8) return 8;\n if (a9 != 9) return 9;\n if (a10 != 10) return 10;\n return 19;\n}\n", |
| 282 | ); |
| 283 | let c_obj = dir.join("check_i16_stack.o"); |
| 284 | compile_c_object(&c_src, &c_obj); |
| 285 | |
| 286 | let f_src = write_program_in( |
| 287 | &dir, |
| 288 | "main.f90", |
| 289 | "program p\n use iso_c_binding, only: c_int, c_short\n implicit none\n interface\n function check_i16_stack(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) result(rc) bind(C, name='check_i16_stack')\n import :: c_int, c_short\n integer(c_short), value :: a1, a2, a3, a4, a5, a6, a7, a8, a9, a10\n integer(c_int) :: rc\n end function check_i16_stack\n end interface\n integer(c_int) :: rc\n\n rc = check_i16_stack(1_c_short, 2_c_short, 3_c_short, 4_c_short, 5_c_short, 6_c_short, 7_c_short, 8_c_short, 9_c_short, 10_c_short)\n if (rc /= 19_c_int) error stop rc\n print *, 'ok'\nend program\n", |
| 290 | ); |
| 291 | let f_obj = dir.join("main.o"); |
| 292 | compile_fortran_object(&f_src, &f_obj); |
| 293 | |
| 294 | let exe = dir.join("i16_stack.bin"); |
| 295 | link_program(&[&f_obj, &c_obj], &exe); |
| 296 | |
| 297 | let run = Command::new(&exe) |
| 298 | .output() |
| 299 | .expect("c_short stack runtime failed"); |
| 300 | assert!( |
| 301 | run.status.success(), |
| 302 | "c_short stack runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 303 | run.status, |
| 304 | String::from_utf8_lossy(&run.stdout), |
| 305 | String::from_utf8_lossy(&run.stderr) |
| 306 | ); |
| 307 | assert!( |
| 308 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 309 | "unexpected c_short stack output: {}", |
| 310 | String::from_utf8_lossy(&run.stdout) |
| 311 | ); |
| 312 | |
| 313 | let _ = std::fs::remove_dir_all(&dir); |
| 314 | } |
| 315 | |
| 316 | #[test] |
| 317 | fn contained_hidden_result_optional_gap_preserves_host_and_char_ordering() { |
| 318 | let dir = unique_dir("contained_hidden_result_gap"); |
| 319 | let src = write_program_in( |
| 320 | &dir, |
| 321 | "main.f90", |
| 322 | "program p\n implicit none\n character(len=32) :: out\n out = outer('cmd', 'abc')\n if (trim(out) /= 'cmd=5') error stop 1\n print *, trim(out)\ncontains\n function outer(name, value) result(line)\n character(len=*), intent(in) :: name, value\n character(len=32) :: line\n integer :: bias\n bias = 2\n line = render(name, value)\n contains\n function render(name, value, manual_len) result(out)\n character(len=*), intent(in) :: name, value\n integer, intent(in), optional :: manual_len\n character(len=32) :: out\n integer :: n\n if (present(manual_len)) then\n n = manual_len + bias\n else\n n = len_trim(value) + bias\n end if\n write(out, '(A,I0)') trim(name) // '=', n\n end function render\n end function outer\nend program\n", |
| 323 | ); |
| 324 | let exe = dir.join("contained_hidden_result_gap.bin"); |
| 325 | compile_fortran_program(&src, &exe); |
| 326 | |
| 327 | let run = Command::new(&exe) |
| 328 | .output() |
| 329 | .expect("contained hidden-result runtime failed"); |
| 330 | assert!( |
| 331 | run.status.success(), |
| 332 | "contained hidden-result runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 333 | run.status, |
| 334 | String::from_utf8_lossy(&run.stdout), |
| 335 | String::from_utf8_lossy(&run.stderr) |
| 336 | ); |
| 337 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 338 | assert!( |
| 339 | stdout.contains("cmd=5"), |
| 340 | "unexpected contained hidden-result output: {}", |
| 341 | stdout |
| 342 | ); |
| 343 | |
| 344 | let _ = std::fs::remove_dir_all(&dir); |
| 345 | } |
| 346 | |
| 347 | #[test] |
| 348 | fn recursive_contained_helper_preserves_host_closure_and_hidden_lengths() { |
| 349 | let dir = unique_dir("recursive_hidden_lengths"); |
| 350 | let src = write_program_in( |
| 351 | &dir, |
| 352 | "main.f90", |
| 353 | "program p\n implicit none\n integer :: total\n total = walk(3, 2.0d0, 'abc')\n if (total /= 9) error stop 1\n print *, total\ncontains\n recursive integer function walk(n, scale, label) result(total)\n integer, intent(in) :: n\n real(8), intent(in) :: scale\n character(len=*), intent(in) :: label\n integer :: bias\n bias = int(scale)\n if (n <= 0) then\n total = len_trim(label)\n else\n total = helper(n, label)\n end if\n contains\n integer function helper(n, label) result(step)\n integer, intent(in) :: n\n character(len=*), intent(in) :: label\n step = bias + walk(n - 1, scale, label)\n end function helper\n end function walk\nend program\n", |
| 354 | ); |
| 355 | let exe = dir.join("recursive_hidden_lengths.bin"); |
| 356 | compile_fortran_program(&src, &exe); |
| 357 | |
| 358 | let run = Command::new(&exe) |
| 359 | .output() |
| 360 | .expect("recursive contained helper runtime failed"); |
| 361 | assert!( |
| 362 | run.status.success(), |
| 363 | "recursive contained helper runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 364 | run.status, |
| 365 | String::from_utf8_lossy(&run.stdout), |
| 366 | String::from_utf8_lossy(&run.stderr) |
| 367 | ); |
| 368 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 369 | assert!( |
| 370 | stdout.contains("9"), |
| 371 | "unexpected recursive contained helper output: {}", |
| 372 | stdout |
| 373 | ); |
| 374 | |
| 375 | let _ = std::fs::remove_dir_all(&dir); |
| 376 | } |
| 377 | |
| 378 | #[test] |
| 379 | fn bind_c_keyword_reordering_preserves_mixed_value_and_byref_slots() { |
| 380 | let dir = unique_dir("keyword_mix"); |
| 381 | let c_src = write_program_in( |
| 382 | &dir, |
| 383 | "check_keyword_mix.c", |
| 384 | "#include <stdint.h>\n\nint check_keyword_mix(int32_t *out_sum, int32_t a, double d, int32_t *inout, float s, int64_t big) {\n if (!out_sum || !inout) return 100;\n if (a != 7) return 1;\n if (d != 1.5) return 2;\n if (*inout != 10) return 3;\n if (s != 2.25f) return 4;\n if (big != 99) return 5;\n *out_sum = a + *inout + (int32_t)big + (int32_t)d + (int32_t)s;\n *inout += 5;\n return 0;\n}\n", |
| 385 | ); |
| 386 | let c_obj = dir.join("check_keyword_mix.o"); |
| 387 | compile_c_object(&c_src, &c_obj); |
| 388 | |
| 389 | let f_src = write_program_in( |
| 390 | &dir, |
| 391 | "main.f90", |
| 392 | "program p\n use iso_c_binding, only: c_int, c_long_long, c_float, c_double\n implicit none\n interface\n function check_keyword_mix(out_sum, a, d, inout, s, big) result(rc) bind(C, name='check_keyword_mix')\n import :: c_int, c_long_long, c_float, c_double\n integer(c_int), intent(out) :: out_sum\n integer(c_int), value :: a\n real(c_double), value :: d\n integer(c_int), intent(inout) :: inout\n real(c_float), value :: s\n integer(c_long_long), value :: big\n integer(c_int) :: rc\n end function check_keyword_mix\n end interface\n integer(c_int) :: rc, out_sum, inout\n\n inout = 10_c_int\n rc = check_keyword_mix(big=99_c_long_long, s=2.25_c_float, inout=inout, d=1.5_c_double, out_sum=out_sum, a=7_c_int)\n if (rc /= 0_c_int) error stop rc\n if (out_sum /= 119_c_int) error stop 11\n if (inout /= 15_c_int) error stop 12\n print *, 'ok'\nend program\n", |
| 393 | ); |
| 394 | let f_obj = dir.join("main.o"); |
| 395 | compile_fortran_object(&f_src, &f_obj); |
| 396 | |
| 397 | let exe = dir.join("keyword_mix.bin"); |
| 398 | link_program(&[&f_obj, &c_obj], &exe); |
| 399 | |
| 400 | let run = Command::new(&exe) |
| 401 | .output() |
| 402 | .expect("keyword mixed-slot runtime failed"); |
| 403 | assert!( |
| 404 | run.status.success(), |
| 405 | "keyword mixed-slot runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 406 | run.status, |
| 407 | String::from_utf8_lossy(&run.stdout), |
| 408 | String::from_utf8_lossy(&run.stderr) |
| 409 | ); |
| 410 | assert!( |
| 411 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 412 | "unexpected keyword mixed-slot output: {}", |
| 413 | String::from_utf8_lossy(&run.stdout) |
| 414 | ); |
| 415 | |
| 416 | let _ = std::fs::remove_dir_all(&dir); |
| 417 | } |
| 418 | |
| 419 | #[test] |
| 420 | fn bind_c_keyword_reordering_preserves_gp_spill_with_pointer_args() { |
| 421 | let dir = unique_dir("keyword_gp_spill"); |
| 422 | let c_src = write_program_in( |
| 423 | &dir, |
| 424 | "check_keyword_spill.c", |
| 425 | "#include <stdint.h>\n\nint check_keyword_spill(int32_t *out0, int32_t a1, int32_t *io1, double d1, int32_t a2, int32_t *io2, double d2, int32_t a3, int32_t *io3, double d3, int32_t a4, int32_t *io4, int32_t a5) {\n if (!out0 || !io1 || !io2 || !io3 || !io4) return 100;\n if (a1 != 11) return 1;\n if (*io1 != 101) return 2;\n if (d1 != 1.25) return 3;\n if (a2 != 22) return 4;\n if (*io2 != 202) return 5;\n if (d2 != 2.5) return 6;\n if (a3 != 33) return 7;\n if (*io3 != 303) return 8;\n if (d3 != 3.75) return 9;\n if (a4 != 44) return 10;\n if (*io4 != 404) return 11;\n if (a5 != 55) return 12;\n *out0 = a1 + a2 + a3 + a4 + a5;\n *io4 += 1;\n return 0;\n}\n", |
| 426 | ); |
| 427 | let c_obj = dir.join("check_keyword_spill.o"); |
| 428 | compile_c_object(&c_src, &c_obj); |
| 429 | |
| 430 | let f_src = write_program_in( |
| 431 | &dir, |
| 432 | "main.f90", |
| 433 | "program p\n use iso_c_binding, only: c_int, c_double\n implicit none\n interface\n function check_keyword_spill(out0, a1, io1, d1, a2, io2, d2, a3, io3, d3, a4, io4, a5) result(rc) bind(C, name='check_keyword_spill')\n import :: c_int, c_double\n integer(c_int), intent(out) :: out0\n integer(c_int), value :: a1, a2, a3, a4, a5\n integer(c_int), intent(inout) :: io1, io2, io3, io4\n real(c_double), value :: d1, d2, d3\n integer(c_int) :: rc\n end function check_keyword_spill\n end interface\n integer(c_int) :: rc, out0, io1, io2, io3, io4\n\n io1 = 101_c_int\n io2 = 202_c_int\n io3 = 303_c_int\n io4 = 404_c_int\n rc = check_keyword_spill(a5=55_c_int, io2=io2, d2=2.5_c_double, out0=out0, a1=11_c_int, io1=io1, d1=1.25_c_double, a2=22_c_int, io3=io3, d3=3.75_c_double, a3=33_c_int, io4=io4, a4=44_c_int)\n if (rc /= 0_c_int) error stop rc\n if (out0 /= 165_c_int) error stop 21\n if (io4 /= 405_c_int) error stop 22\n print *, 'ok'\nend program\n", |
| 434 | ); |
| 435 | let f_obj = dir.join("main.o"); |
| 436 | compile_fortran_object(&f_src, &f_obj); |
| 437 | |
| 438 | let exe = dir.join("keyword_gp_spill.bin"); |
| 439 | link_program(&[&f_obj, &c_obj], &exe); |
| 440 | |
| 441 | let run = Command::new(&exe) |
| 442 | .output() |
| 443 | .expect("keyword GP spill runtime failed"); |
| 444 | assert!( |
| 445 | run.status.success(), |
| 446 | "keyword GP spill runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 447 | run.status, |
| 448 | String::from_utf8_lossy(&run.stdout), |
| 449 | String::from_utf8_lossy(&run.stderr) |
| 450 | ); |
| 451 | assert!( |
| 452 | String::from_utf8_lossy(&run.stdout).contains("ok"), |
| 453 | "unexpected keyword GP spill output: {}", |
| 454 | String::from_utf8_lossy(&run.stdout) |
| 455 | ); |
| 456 | |
| 457 | let _ = std::fs::remove_dir_all(&dir); |
| 458 | } |
| 459 | |
| 460 | #[test] |
| 461 | fn recursive_non_bindc_calls_preserve_hidden_lengths_host_closure_and_gp_spills() { |
| 462 | let dir = unique_dir("recursive_non_bindc_gp_spill"); |
| 463 | let src = write_program_in( |
| 464 | &dir, |
| 465 | "main.f90", |
| 466 | "program p\n implicit none\n integer :: total\n total = outer()\n if (total /= 1512) error stop 1\n print *, total\ncontains\n integer function outer() result(total)\n integer :: bias\n bias = 3\n total = walk(2, 'abc', 11, 22, 33, 44, 55, 66, 77, 88, 99, 1.25d0, 2.5d0)\n contains\n recursive integer function walk(n, tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2) result(v)\n integer, intent(in) :: n\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2\n if (n <= 0) then\n v = leaf(a8=a8, d2=d2, a3=a3, a5=a5, a1=a1, tag=tag, a9=a9, d1=d1, a7=a7, a2=a2, a4=a4, a6=a6)\n else\n v = leaf(a8=a8, d2=d2, a3=a3, a5=a5, a1=a1, tag=tag, a9=a9, d1=d1, a7=a7, a2=a2, a4=a4, a6=a6) + &\n walk(n - 1, tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2)\n end if\n contains\n integer function leaf(tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2) result(sumv)\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2\n sumv = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2) + len_trim(tag) + bias\n end function leaf\n end function walk\n end function outer\nend program\n", |
| 467 | ); |
| 468 | let exe = dir.join("recursive_non_bindc_gp_spill.bin"); |
| 469 | compile_fortran_program(&src, &exe); |
| 470 | |
| 471 | let run = Command::new(&exe) |
| 472 | .output() |
| 473 | .expect("recursive non-bind(c) GP spill runtime failed"); |
| 474 | assert!( |
| 475 | run.status.success(), |
| 476 | "recursive non-bind(c) GP spill runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 477 | run.status, |
| 478 | String::from_utf8_lossy(&run.stdout), |
| 479 | String::from_utf8_lossy(&run.stderr) |
| 480 | ); |
| 481 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 482 | assert!( |
| 483 | stdout.contains("1512"), |
| 484 | "unexpected recursive non-bind(c) GP spill output: {}", |
| 485 | stdout |
| 486 | ); |
| 487 | |
| 488 | let _ = std::fs::remove_dir_all(&dir); |
| 489 | } |
| 490 | |
| 491 | #[test] |
| 492 | fn non_bindc_keyword_reordering_preserves_mixed_gp_fp_spills() { |
| 493 | let dir = unique_dir("non_bindc_keyword_spills"); |
| 494 | let src = write_program_in( |
| 495 | &dir, |
| 496 | "main.f90", |
| 497 | "program p\n implicit none\n integer :: total\n total = driver()\n if (total /= 542) error stop 1\n print *, total\ncontains\n integer function driver() result(total)\n total = accumulate(a9=99, d8=8.5d0, a4=44, d2=2.5d0, tag='xy', a1=11, d5=5.25d0, a7=77, d1=1.25d0, &\n a2=22, d9=9.25d0, a5=55, d4=4.5d0, a8=88, a3=33, d6=6.5d0, a6=66, d3=3.75d0, d7=7.75d0)\n contains\n integer function accumulate(tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2, d3, d4, d5, d6, d7, d8, d9) result(v)\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2, d3, d4, d5, d6, d7, d8, d9\n v = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2) + int(d3) + int(d4) + int(d5) + int(d6) + int(d7) + int(d8) + int(d9) + len_trim(tag)\n end function accumulate\n end function driver\nend program\n", |
| 498 | ); |
| 499 | let exe = dir.join("non_bindc_keyword_spills.bin"); |
| 500 | compile_fortran_program(&src, &exe); |
| 501 | |
| 502 | let run = Command::new(&exe) |
| 503 | .output() |
| 504 | .expect("non-bind(c) keyword spill runtime failed"); |
| 505 | assert!( |
| 506 | run.status.success(), |
| 507 | "non-bind(c) keyword spill runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 508 | run.status, |
| 509 | String::from_utf8_lossy(&run.stdout), |
| 510 | String::from_utf8_lossy(&run.stderr) |
| 511 | ); |
| 512 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 513 | assert!( |
| 514 | stdout.contains("542"), |
| 515 | "unexpected non-bind(c) keyword spill output: {}", |
| 516 | stdout |
| 517 | ); |
| 518 | |
| 519 | let _ = std::fs::remove_dir_all(&dir); |
| 520 | } |
| 521 | |
| 522 | #[test] |
| 523 | fn cross_tu_character_result_with_spills_survives_amod_import() { |
| 524 | let dir = unique_dir("cross_tu_char_result_spills"); |
| 525 | let mod_src = write_program_in( |
| 526 | &dir, |
| 527 | "abi_mod.f90", |
| 528 | "module abi_mod\ncontains\n function accumulate(tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2, d3, d4, d5, d6, d7, d8, d9) result(out)\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2, d3, d4, d5, d6, d7, d8, d9\n character(len=32) :: out\n write(out, '(A,I0)') trim(tag) // '=', a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2) + int(d3) + int(d4) + int(d5) + int(d6) + int(d7) + int(d8) + int(d9)\n end function accumulate\nend module abi_mod\n", |
| 529 | ); |
| 530 | let main_src = write_program_in( |
| 531 | &dir, |
| 532 | "main.f90", |
| 533 | "program p\n use abi_mod, only: accumulate\n implicit none\n character(len=32) :: out\n out = accumulate(a9=99, d8=8.5d0, a4=44, d2=2.5d0, tag='xy', a1=11, d5=5.25d0, a7=77, d1=1.25d0, &\n a2=22, d9=9.25d0, a5=55, d4=4.5d0, a8=88, a3=33, d6=6.5d0, a6=66, d3=3.75d0, d7=7.75d0)\n if (trim(out) /= 'xy=540') error stop 1\n print *, trim(out)\nend program\n", |
| 534 | ); |
| 535 | |
| 536 | let mod_obj = dir.join("abi_mod.o"); |
| 537 | let compile_mod = Command::new(compiler("armfortas")) |
| 538 | .current_dir(&dir) |
| 539 | .args([ |
| 540 | "-c", |
| 541 | "-J", |
| 542 | dir.to_str().unwrap(), |
| 543 | mod_src.to_str().unwrap(), |
| 544 | "-o", |
| 545 | mod_obj.to_str().unwrap(), |
| 546 | ]) |
| 547 | .output() |
| 548 | .expect("cross-TU char-result module compile failed to spawn"); |
| 549 | assert!( |
| 550 | compile_mod.status.success(), |
| 551 | "cross-TU char-result module compile failed: {}", |
| 552 | String::from_utf8_lossy(&compile_mod.stderr) |
| 553 | ); |
| 554 | |
| 555 | let main_obj = dir.join("main.o"); |
| 556 | let compile_main = Command::new(compiler("armfortas")) |
| 557 | .current_dir(&dir) |
| 558 | .args([ |
| 559 | "-c", |
| 560 | "-I", |
| 561 | dir.to_str().unwrap(), |
| 562 | "-J", |
| 563 | dir.to_str().unwrap(), |
| 564 | main_src.to_str().unwrap(), |
| 565 | "-o", |
| 566 | main_obj.to_str().unwrap(), |
| 567 | ]) |
| 568 | .output() |
| 569 | .expect("cross-TU char-result main compile failed to spawn"); |
| 570 | assert!( |
| 571 | compile_main.status.success(), |
| 572 | "cross-TU char-result main compile failed: {}", |
| 573 | String::from_utf8_lossy(&compile_main.stderr) |
| 574 | ); |
| 575 | |
| 576 | let exe = dir.join("cross_tu_char_result_spills.bin"); |
| 577 | link_program(&[&main_obj, &mod_obj], &exe); |
| 578 | |
| 579 | let run = Command::new(&exe) |
| 580 | .output() |
| 581 | .expect("cross-TU char-result runtime failed"); |
| 582 | assert!( |
| 583 | run.status.success(), |
| 584 | "cross-TU char-result runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 585 | run.status, |
| 586 | String::from_utf8_lossy(&run.stdout), |
| 587 | String::from_utf8_lossy(&run.stderr) |
| 588 | ); |
| 589 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 590 | assert!( |
| 591 | stdout.contains("xy=540"), |
| 592 | "unexpected cross-TU char-result output: {}", |
| 593 | stdout |
| 594 | ); |
| 595 | |
| 596 | let _ = std::fs::remove_dir_all(&dir); |
| 597 | } |
| 598 | |
| 599 | #[test] |
| 600 | fn cross_tu_bindc_keyword_spills_survive_amod_import() { |
| 601 | let dir = unique_dir("cross_tu_bindc_keyword_spills"); |
| 602 | let c_src = write_program_in( |
| 603 | &dir, |
| 604 | "check_keyword_spill.c", |
| 605 | "#include <stdint.h>\n\nint check_keyword_spill(int32_t *out0, int32_t a1, int32_t *io1, double d1, int32_t a2, int32_t *io2, double d2, int32_t a3, int32_t *io3, double d3, int32_t a4, int32_t *io4, int32_t a5) {\n if (!out0 || !io1 || !io2 || !io3 || !io4) return 100;\n if (a1 != 11) return 1;\n if (*io1 != 101) return 2;\n if (d1 != 1.25) return 3;\n if (a2 != 22) return 4;\n if (*io2 != 202) return 5;\n if (d2 != 2.5) return 6;\n if (a3 != 33) return 7;\n if (*io3 != 303) return 8;\n if (d3 != 3.75) return 9;\n if (a4 != 44) return 10;\n if (*io4 != 404) return 11;\n if (a5 != 55) return 12;\n *out0 = a1 + a2 + a3 + a4 + a5;\n *io4 += 1;\n return 0;\n}\n", |
| 606 | ); |
| 607 | let c_obj = dir.join("check_keyword_spill.o"); |
| 608 | compile_c_object(&c_src, &c_obj); |
| 609 | |
| 610 | let mod_src = write_program_in( |
| 611 | &dir, |
| 612 | "c_mix.f90", |
| 613 | "module c_mix\n use iso_c_binding, only: c_int, c_double\n implicit none\n interface\n function check_keyword_spill(out0, a1, io1, d1, a2, io2, d2, a3, io3, d3, a4, io4, a5) result(rc) bind(C, name='check_keyword_spill')\n import :: c_int, c_double\n integer(c_int), intent(out) :: out0\n integer(c_int), value :: a1, a2, a3, a4, a5\n integer(c_int), intent(inout) :: io1, io2, io3, io4\n real(c_double), value :: d1, d2, d3\n integer(c_int) :: rc\n end function check_keyword_spill\n end interface\nend module c_mix\n", |
| 614 | ); |
| 615 | let main_src = write_program_in( |
| 616 | &dir, |
| 617 | "main.f90", |
| 618 | "program p\n use iso_c_binding, only: c_int, c_double\n use c_mix, only: check_keyword_spill\n implicit none\n integer(c_int) :: rc, out0, io1, io2, io3, io4\n io1 = 101_c_int\n io2 = 202_c_int\n io3 = 303_c_int\n io4 = 404_c_int\n rc = check_keyword_spill(a5=55_c_int, io2=io2, d2=2.5_c_double, out0=out0, a1=11_c_int, io1=io1, d1=1.25_c_double, a2=22_c_int, io3=io3, d3=3.75_c_double, a3=33_c_int, io4=io4, a4=44_c_int)\n if (rc /= 0_c_int) error stop rc\n if (out0 /= 165_c_int) error stop 21\n if (io4 /= 405_c_int) error stop 22\n print *, 'ok'\nend program\n", |
| 619 | ); |
| 620 | |
| 621 | let mod_obj = dir.join("c_mix.o"); |
| 622 | let compile_mod = Command::new(compiler("armfortas")) |
| 623 | .current_dir(&dir) |
| 624 | .args([ |
| 625 | "-c", |
| 626 | "-J", |
| 627 | dir.to_str().unwrap(), |
| 628 | mod_src.to_str().unwrap(), |
| 629 | "-o", |
| 630 | mod_obj.to_str().unwrap(), |
| 631 | ]) |
| 632 | .output() |
| 633 | .expect("cross-TU bind(c) module compile failed to spawn"); |
| 634 | assert!( |
| 635 | compile_mod.status.success(), |
| 636 | "cross-TU bind(c) module compile failed: {}", |
| 637 | String::from_utf8_lossy(&compile_mod.stderr) |
| 638 | ); |
| 639 | |
| 640 | let main_obj = dir.join("main.o"); |
| 641 | let compile_main = Command::new(compiler("armfortas")) |
| 642 | .current_dir(&dir) |
| 643 | .args([ |
| 644 | "-c", |
| 645 | "-I", |
| 646 | dir.to_str().unwrap(), |
| 647 | "-J", |
| 648 | dir.to_str().unwrap(), |
| 649 | main_src.to_str().unwrap(), |
| 650 | "-o", |
| 651 | main_obj.to_str().unwrap(), |
| 652 | ]) |
| 653 | .output() |
| 654 | .expect("cross-TU bind(c) main compile failed to spawn"); |
| 655 | assert!( |
| 656 | compile_main.status.success(), |
| 657 | "cross-TU bind(c) main compile failed: {}", |
| 658 | String::from_utf8_lossy(&compile_main.stderr) |
| 659 | ); |
| 660 | |
| 661 | let exe = dir.join("cross_tu_bindc_keyword_spills.bin"); |
| 662 | link_program(&[&main_obj, &mod_obj, &c_obj], &exe); |
| 663 | |
| 664 | let run = Command::new(&exe) |
| 665 | .output() |
| 666 | .expect("cross-TU bind(c) runtime failed"); |
| 667 | assert!( |
| 668 | run.status.success(), |
| 669 | "cross-TU bind(c) runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 670 | run.status, |
| 671 | String::from_utf8_lossy(&run.stdout), |
| 672 | String::from_utf8_lossy(&run.stderr) |
| 673 | ); |
| 674 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 675 | assert!( |
| 676 | stdout.contains("ok"), |
| 677 | "unexpected cross-TU bind(c) output: {}", |
| 678 | stdout |
| 679 | ); |
| 680 | |
| 681 | let _ = std::fs::remove_dir_all(&dir); |
| 682 | } |
| 683 | |
| 684 | #[test] |
| 685 | fn character_result_actual_preserves_scalar_spills_in_nested_calls() { |
| 686 | let dir = unique_dir("char_result_nested_actual"); |
| 687 | let src = write_program_in( |
| 688 | &dir, |
| 689 | "main.f90", |
| 690 | "program p\n implicit none\n integer :: total\n total = consume(label=render(a9=9, d2=2.5d0, a3=3, a5=5, a1=1, tag='ab', d1=1.25d0, a7=7, a2=2, a4=4, a6=6, a8=8), &\n a9=9, d2=2.5d0, a3=3, a5=5, a1=1, d1=1.25d0, a7=7, a2=2, a4=4, a6=6, a8=8)\n if (total /= 53) error stop 1\n print *, total\ncontains\n function render(tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2) result(out)\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2\n character(len=16) :: out\n write(out, '(A,I0)') trim(tag) // '=', a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2)\n end function render\n\n integer function consume(label, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2) result(v)\n character(len=*), intent(in) :: label\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2\n v = len_trim(label) + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2)\n end function consume\nend program\n", |
| 691 | ); |
| 692 | let exe = dir.join("char_result_nested_actual.bin"); |
| 693 | compile_fortran_program(&src, &exe); |
| 694 | |
| 695 | let run = Command::new(&exe) |
| 696 | .output() |
| 697 | .expect("character-result nested-actual runtime failed"); |
| 698 | assert!( |
| 699 | run.status.success(), |
| 700 | "character-result nested-actual runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 701 | run.status, |
| 702 | String::from_utf8_lossy(&run.stdout), |
| 703 | String::from_utf8_lossy(&run.stderr) |
| 704 | ); |
| 705 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 706 | assert!( |
| 707 | stdout.contains("53"), |
| 708 | "unexpected character-result nested-actual output: {}", |
| 709 | stdout |
| 710 | ); |
| 711 | |
| 712 | let _ = std::fs::remove_dir_all(&dir); |
| 713 | } |
| 714 | |
| 715 | #[test] |
| 716 | fn hidden_result_builder_preserves_scalar_helper_spills() { |
| 717 | let dir = unique_dir("hidden_result_builder_spills"); |
| 718 | let src = write_program_in( |
| 719 | &dir, |
| 720 | "main.f90", |
| 721 | "program p\n implicit none\n character(len=32) :: out\n out = render(a9=99, d8=8.5d0, a4=44, d2=2.5d0, tag='xy', a1=11, d5=5.25d0, a7=77, d1=1.25d0, &\n a2=22, d9=9.25d0, a5=55, d4=4.5d0, a8=88, a3=33, d6=6.5d0, a6=66, d3=3.75d0, d7=7.75d0)\n if (trim(out) /= 'xy=542') error stop 1\n print *, trim(out)\ncontains\n function render(tag, a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2, d3, d4, d5, d6, d7, d8, d9) result(out)\n character(len=*), intent(in) :: tag\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2, d3, d4, d5, d6, d7, d8, d9\n character(len=32) :: out\n write(out, '(A,I0)') trim(tag) // '=', weight(a9=a9, d8=d8, a4=a4, d2=d2, a1=a1, d5=d5, a7=a7, d1=d1, a2=a2, d9=d9, a5=a5, d4=d4, a8=a8, a3=a3, d6=d6, a6=a6, d3=d3, d7=d7)\n end function render\n\n integer function weight(a1, a2, a3, a4, a5, a6, a7, a8, a9, d1, d2, d3, d4, d5, d6, d7, d8, d9) result(v)\n integer, intent(in) :: a1, a2, a3, a4, a5, a6, a7, a8, a9\n real(8), intent(in) :: d1, d2, d3, d4, d5, d6, d7, d8, d9\n v = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + int(d1) + int(d2) + int(d3) + int(d4) + int(d5) + int(d6) + int(d7) + int(d8) + int(d9) + 2\n end function weight\nend program\n", |
| 722 | ); |
| 723 | let exe = dir.join("hidden_result_builder_spills.bin"); |
| 724 | compile_fortran_program(&src, &exe); |
| 725 | |
| 726 | let run = Command::new(&exe) |
| 727 | .output() |
| 728 | .expect("hidden-result builder runtime failed"); |
| 729 | assert!( |
| 730 | run.status.success(), |
| 731 | "hidden-result builder runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 732 | run.status, |
| 733 | String::from_utf8_lossy(&run.stdout), |
| 734 | String::from_utf8_lossy(&run.stderr) |
| 735 | ); |
| 736 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 737 | assert!( |
| 738 | stdout.contains("xy=542"), |
| 739 | "unexpected hidden-result builder output: {}", |
| 740 | stdout |
| 741 | ); |
| 742 | |
| 743 | let _ = std::fs::remove_dir_all(&dir); |
| 744 | } |
| 745 | |
| 746 | #[test] |
| 747 | fn generic_character_function_dispatches_to_character_specific() { |
| 748 | let dir = unique_dir("generic_character_dispatch"); |
| 749 | let src = write_program_in( |
| 750 | &dir, |
| 751 | "main.f90", |
| 752 | "program p\n implicit none\n interface pick\n integer function pick_i(n)\n integer, intent(in) :: n\n end function pick_i\n integer function pick_c(s)\n character(len=*), intent(in) :: s\n end function pick_c\n end interface\n if (pick('ab') /= 2) error stop 1\n print *, pick('ab')\ncontains\n integer function pick_i(n)\n integer, intent(in) :: n\n pick_i = n + 100\n end function pick_i\n integer function pick_c(s)\n character(len=*), intent(in) :: s\n pick_c = len_trim(s)\n end function pick_c\nend program\n", |
| 753 | ); |
| 754 | let exe = dir.join("generic_character_dispatch.bin"); |
| 755 | compile_fortran_program(&src, &exe); |
| 756 | |
| 757 | let run = Command::new(&exe) |
| 758 | .output() |
| 759 | .expect("generic character dispatch runtime failed"); |
| 760 | assert!( |
| 761 | run.status.success(), |
| 762 | "generic character dispatch runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 763 | run.status, |
| 764 | String::from_utf8_lossy(&run.stdout), |
| 765 | String::from_utf8_lossy(&run.stderr) |
| 766 | ); |
| 767 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 768 | assert!( |
| 769 | stdout.contains("2"), |
| 770 | "unexpected generic character dispatch output: {}", |
| 771 | stdout |
| 772 | ); |
| 773 | |
| 774 | let _ = std::fs::remove_dir_all(&dir); |
| 775 | } |
| 776 | |
| 777 | #[test] |
| 778 | fn generic_hidden_result_character_dispatches_to_character_specific() { |
| 779 | let dir = unique_dir("generic_hidden_result_character_dispatch"); |
| 780 | let src = write_program_in( |
| 781 | &dir, |
| 782 | "main.f90", |
| 783 | "program p\n implicit none\n character(len=8) :: out\n interface build\n function build_i(n) result(out)\n integer, intent(in) :: n\n character(len=8) :: out\n end function build_i\n function build_c(s) result(out)\n character(len=*), intent(in) :: s\n character(len=8) :: out\n end function build_c\n end interface\n out = build('ab')\n if (trim(out) /= 'ab') error stop 1\n print *, trim(out)\ncontains\n function build_i(n) result(out)\n integer, intent(in) :: n\n character(len=8) :: out\n write(out, '(I0)') n\n end function build_i\n function build_c(s) result(out)\n character(len=*), intent(in) :: s\n character(len=8) :: out\n out = s\n end function build_c\nend program\n", |
| 784 | ); |
| 785 | let exe = dir.join("generic_hidden_result_character_dispatch.bin"); |
| 786 | compile_fortran_program(&src, &exe); |
| 787 | |
| 788 | let run = Command::new(&exe) |
| 789 | .output() |
| 790 | .expect("generic hidden-result character dispatch runtime failed"); |
| 791 | assert!( |
| 792 | run.status.success(), |
| 793 | "generic hidden-result character dispatch runtime failed: status={:?}\nstdout:\n{}\nstderr:\n{}", |
| 794 | run.status, |
| 795 | String::from_utf8_lossy(&run.stdout), |
| 796 | String::from_utf8_lossy(&run.stderr) |
| 797 | ); |
| 798 | let stdout = String::from_utf8_lossy(&run.stdout); |
| 799 | assert!( |
| 800 | stdout.contains("ab"), |
| 801 | "unexpected generic hidden-result character dispatch output: {}", |
| 802 | stdout |
| 803 | ); |
| 804 | |
| 805 | let _ = std::fs::remove_dir_all(&dir); |
| 806 | } |
| 807 |