1! { dg-do run } 2! { dg-options "-std=f2008 -fall-intrinsics -fcheck=bounds" } 3 4! PR fortran/29785 5! Check pointer rank remapping at runtime. 6 7! Contributed by Daniel Kraft, d@domob.eu. 8 9PROGRAM main 10 IMPLICIT NONE 11 INTEGER, TARGET :: arr(12), basem(3, 4) 12 INTEGER, POINTER :: vec(:), mat(:, :) 13 INTEGER :: i 14 15 arr = (/ (i, i = 1, 12) /) 16 basem = RESHAPE (arr, SHAPE (basem)) 17 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) CALL abort () 21 IF (ANY (vec /= (/ 1, 3, 5, 7 /))) CALL abort () 22 IF (vec(2) /= 1 .OR. vec(5) /= 7) CALL abort () 23 24 ! ...but it is of course the more interesting. Also try remapping a pointer. 25 vec => arr(1:12:2) 26 mat(1:3, 1:2) => vec 27 IF (ANY (LBOUND (mat) /= (/ 1, 1 /) .OR. UBOUND (mat) /= (/ 3, 2 /))) & 28 CALL abort () 29 IF (ANY (mat /= RESHAPE (arr(1:12:2), SHAPE (mat)))) CALL abort () 30 IF (mat(1, 1) /= 1 .OR. mat(1, 2) /= 7) CALL abort () 31 32 ! Remap with target of rank > 1. 33 vec(1:12_1) => basem 34 IF (LBOUND (vec, 1) /= 1 .OR. UBOUND (vec, 1) /= 12) CALL abort () 35 IF (ANY (vec /= arr)) CALL abort () 36 IF (vec(1) /= 1 .OR. vec(5) /= 5 .OR. vec(12) /= 12) CALL abort () 37END PROGRAM main 38