@@ -13853,6 +13853,47 @@ fn inline_array_intrinsic_in_print_walks_descriptor_elements() { |
| 13853 | let _ = std::fs::remove_file(&src); | 13853 | let _ = std::fs::remove_file(&src); |
| 13854 | } | 13854 | } |
| 13855 | | 13855 | |
| | 13856 | +#[test] |
| | 13857 | +fn merge_intrinsic_routes_array_operands_through_descriptor_path() { |
| | 13858 | + // F2018 §16.9.135: MERGE is elemental and returns an array when any |
| | 13859 | + // of its operands is an array. The transformational-intrinsic table |
| | 13860 | + // in stmt.rs picks which calls go through `lower_array_assign`, and |
| | 13861 | + // `merge` was missing — so `x = merge(b, x, mask)` fell through to |
| | 13862 | + // scalar `b.select(mask, ptr_a, ptr_b)`, producing const-zero or |
| | 13863 | + // ptr-typed garbage that the assignment treated as a source |
| | 13864 | + // descriptor. stdlib's iterative solvers (solve_cg/bicgstab/pcg) and |
| | 13865 | + // pseudoinverse (`Am1 = .pinv.A`) all SEGV'd on this path. The fix |
| | 13866 | + // routes merge() through `lower_array_merge_descriptor`, which |
| | 13867 | + // materializes a temp descriptor via per-element select. |
| | 13868 | + let src = write_program( |
| | 13869 | + "subroutine s(x, b, mask)\n real(8), intent(inout) :: x(:)\n real(8), intent(in) :: b(:)\n logical, intent(in) :: mask(:)\n x = merge(b, x, mask)\nend subroutine\nprogram p\n real(8) :: x(3) = [1.0_8, 2.0_8, 3.0_8]\n real(8) :: b(3) = [10.0_8, 20.0_8, 30.0_8]\n logical :: mask(3) = [.true., .false., .true.]\n call s(x, b, mask)\n if (abs(x(1) - 10.0_8) > 1.0e-12_8) error stop 1\n if (abs(x(2) - 2.0_8) > 1.0e-12_8) error stop 2\n if (abs(x(3) - 30.0_8) > 1.0e-12_8) error stop 3\n print *, 'ok'\nend program\n", |
| | 13870 | + "f90", |
| | 13871 | + ); |
| | 13872 | + let out = unique_path("merge_array", "bin"); |
| | 13873 | + let compile = Command::new(compiler("armfortas")) |
| | 13874 | + .args([src.to_str().unwrap(), "-o", out.to_str().unwrap()]) |
| | 13875 | + .output() |
| | 13876 | + .expect("merge array compile failed"); |
| | 13877 | + assert!( |
| | 13878 | + compile.status.success(), |
| | 13879 | + "merge array should compile: {}", |
| | 13880 | + String::from_utf8_lossy(&compile.stderr) |
| | 13881 | + ); |
| | 13882 | + let run = Command::new(&out).output().expect("merge array run failed"); |
| | 13883 | + assert!( |
| | 13884 | + run.status.success(), |
| | 13885 | + "merge array should pass: status={:?} stdout={} stderr={}", |
| | 13886 | + run.status, |
| | 13887 | + String::from_utf8_lossy(&run.stdout), |
| | 13888 | + String::from_utf8_lossy(&run.stderr) |
| | 13889 | + ); |
| | 13890 | + let stdout = String::from_utf8_lossy(&run.stdout); |
| | 13891 | + assert!(stdout.contains("ok"), "expected ok, got: {}", stdout); |
| | 13892 | + |
| | 13893 | + let _ = std::fs::remove_file(&out); |
| | 13894 | + let _ = std::fs::remove_file(&src); |
| | 13895 | +} |
| | 13896 | + |
| 13856 | #[test] | 13897 | #[test] |
| 13857 | fn complex_scalar_assigned_from_integer_promotes_via_buffer_not_pointer_cast() { | 13898 | fn complex_scalar_assigned_from_integer_promotes_via_buffer_not_pointer_cast() { |
| 13858 | // F2018 §10.2.1.3: complex variables can be assigned a scalar of | 13899 | // F2018 §10.2.1.3: complex variables can be assigned a scalar of |
