@@ -28622,3 +28622,42 @@ fn cmplx_whole_array_with_kind_keyword_returns_correct_kind_descriptor() { |
| 28622 | let _ = std::fs::remove_file(&out); | 28622 | let _ = std::fs::remove_file(&out); |
| 28623 | let _ = std::fs::remove_file(&src); | 28623 | let _ = std::fs::remove_file(&src); |
| 28624 | } | 28624 | } |
| | 28625 | + |
| | 28626 | +#[test] |
| | 28627 | +fn rank2_section_with_vector_subscript_gathers_into_fresh_descriptor() { |
| | 28628 | + // F2018 §9.5.3.3: a section like `A(:, pivots)` where one subscript |
| | 28629 | + // is a range and another is a rank-1 integer array (vector subscript) |
| | 28630 | + // must produce a rank-2 result whose dim 1 is permuted/gathered by |
| | 28631 | + // the index array. afs_create_section can only express stride-based |
| | 28632 | + // sections, so vector subscripts force a per-element gather into a |
| | 28633 | + // fresh allocated descriptor. Without that path, the index array's |
| | 28634 | + // base pointer was being stored into the section's start/end i64 |
| | 28635 | + // slots with stride 0, producing garbage offsets and a SIGBUS |
| | 28636 | + // (matched stdlib pivoting_qr cluster). |
| | 28637 | + let src = write_program( |
| | 28638 | + "program p\n real :: A(4,3), B(4,3)\n integer :: pivots(3)\n integer :: i, j\n do i = 1, 3\n do j = 1, 4\n A(j,i) = real((i-1)*4 + j)\n end do\n end do\n pivots = [3, 1, 2]\n B = A(:, pivots)\n if (abs(B(1,1) - 9.0) > 1.0e-6) error stop 1\n if (abs(B(4,1) - 12.0) > 1.0e-6) error stop 2\n if (abs(B(1,2) - 1.0) > 1.0e-6) error stop 3\n if (abs(B(4,2) - 4.0) > 1.0e-6) error stop 4\n if (abs(B(1,3) - 5.0) > 1.0e-6) error stop 5\n if (abs(B(4,3) - 8.0) > 1.0e-6) error stop 6\n print *, 'ok'\nend program\n", |
| | 28639 | + "f90", |
| | 28640 | + ); |
| | 28641 | + let out = unique_path("rank2_vector_subscript_section", "bin"); |
| | 28642 | + let compile = Command::new(compiler("armfortas")) |
| | 28643 | + .args([src.to_str().unwrap(), "-o", out.to_str().unwrap()]) |
| | 28644 | + .output() |
| | 28645 | + .expect("rank-2 vector subscript compile failed to spawn"); |
| | 28646 | + assert!( |
| | 28647 | + compile.status.success(), |
| | 28648 | + "rank-2 vector subscript compile failed: {}", |
| | 28649 | + String::from_utf8_lossy(&compile.stderr) |
| | 28650 | + ); |
| | 28651 | + let run = Command::new(&out) |
| | 28652 | + .output() |
| | 28653 | + .expect("rank-2 vector subscript run failed"); |
| | 28654 | + assert!( |
| | 28655 | + run.status.success() && String::from_utf8_lossy(&run.stdout).contains("ok"), |
| | 28656 | + "rank-2 vector subscript run failed: status={:?} stdout={} stderr={}", |
| | 28657 | + run.status, |
| | 28658 | + String::from_utf8_lossy(&run.stdout), |
| | 28659 | + String::from_utf8_lossy(&run.stderr) |
| | 28660 | + ); |
| | 28661 | + let _ = std::fs::remove_file(&out); |
| | 28662 | + let _ = std::fs::remove_file(&src); |
| | 28663 | +} |
