diff options
| author | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
|---|---|---|
| committer | Ben Cheng <bccheng@google.com> | 2014-03-25 22:37:19 -0700 |
| commit | 1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch) | |
| tree | c607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 | |
| parent | 283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff) | |
| download | toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2 toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip | |
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 b/gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 new file mode 100644 index 000000000..28c0a7d8d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 @@ -0,0 +1,37 @@ +! { dg-do run } +! { dg-options "-std=f2008 -fall-intrinsics -fcheck=bounds" } + +! PR fortran/29785 +! Check pointer rank remapping at runtime. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + INTEGER, TARGET :: arr(12), basem(3, 4) + INTEGER, POINTER :: vec(:), mat(:, :) + INTEGER :: i + + arr = (/ (i, i = 1, 12) /) + basem = RESHAPE (arr, SHAPE (basem)) + + ! We need not necessarily change the rank... + vec(2_1:5) => arr(1_1:12_1:2_1) + IF (LBOUND (vec, 1) /= 2 .OR. UBOUND (vec, 1) /= 5) CALL abort () + IF (ANY (vec /= (/ 1, 3, 5, 7 /))) CALL abort () + IF (vec(2) /= 1 .OR. vec(5) /= 7) CALL abort () + + ! ...but it is of course the more interesting. Also try remapping a pointer. + vec => arr(1:12:2) + mat(1:3, 1:2) => vec + IF (ANY (LBOUND (mat) /= (/ 1, 1 /) .OR. UBOUND (mat) /= (/ 3, 2 /))) & + CALL abort () + IF (ANY (mat /= RESHAPE (arr(1:12:2), SHAPE (mat)))) CALL abort () + IF (mat(1, 1) /= 1 .OR. mat(1, 2) /= 7) CALL abort () + + ! Remap with target of rank > 1. + vec(1:12_1) => basem + IF (LBOUND (vec, 1) /= 1 .OR. UBOUND (vec, 1) /= 12) CALL abort () + IF (ANY (vec /= arr)) CALL abort () + IF (vec(1) /= 1 .OR. vec(5) /= 5 .OR. vec(12) /= 12) CALL abort () +END PROGRAM main |