URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Details |
Compare with Previous |
View Log
| Line No. |
Rev |
Author |
Line |
| 1 |
694 |
jeremybenn |
! { 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 |
|
|
|
| 9 |
|
|
PROGRAM 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 ()
|
| 37 |
|
|
END PROGRAM main
|
© copyright 1999-2024
OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.