2 ! { dg-options "-std=f2008 -fcheck=bounds" }
5 ! Check pointer rank remapping at runtime.
7 ! Contributed by Daniel Kraft, d@domob.eu.
11 INTEGER, TARGET :: arr(12), basem(3, 4)
12 INTEGER, POINTER :: vec(:), mat(:, :)
15 arr = (/ (i, i = 1, 12) /)
16 basem = RESHAPE (arr, SHAPE (basem))
18 ! We need not necessarily change the rank...
19 vec(2_1:5) => arr(1_1:12_1:2_1)
20 IF (LBOUND (vec, 1) /= 2 .OR. UBOUND (vec, 1) /= 5) STOP 1
21 IF (ANY (vec /= (/ 1, 3, 5, 7 /))) STOP 2
22 IF (vec(2) /= 1 .OR. vec(5) /= 7) STOP 3
24 ! ...but it is of course the more interesting. Also try remapping a pointer.
27 IF (ANY (LBOUND (mat) /= (/ 1, 1 /) .OR. UBOUND (mat) /= (/ 3, 2 /))) &
29 IF (ANY (mat /= RESHAPE (arr(1:12:2), SHAPE (mat)))) STOP 5
30 IF (mat(1, 1) /= 1 .OR. mat(1, 2) /= 7) STOP 6
32 ! Remap with target of rank > 1.
34 IF (LBOUND (vec, 1) /= 1 .OR. UBOUND (vec, 1) /= 12) STOP 7
35 IF (ANY (vec /= arr)) STOP 8
36 IF (vec(1) /= 1 .OR. vec(5) /= 5 .OR. vec(12) /= 12) STOP 9