1! { dg-do run }
2! { dg-options "-Warray-temporaries -fall-intrinsics" }
3
4! Check that LBOUND/UBOUND/SIZE/SHAPE of array-expressions get simplified
5! in certain cases.
6! There should no array-temporaries warnings pop up, as this means that
7! the intrinsic call has not been properly simplified.
8
9! Contributed by Daniel Kraft, d@domob.eu.
10
11PROGRAM main
12  IMPLICIT NONE
13
14  ! Some explicitely shaped arrays and allocatable ones.
15  INTEGER :: a(2, 3), b(0:1, 4:6)
16  INTEGER, ALLOCATABLE :: x(:, :), y(:, :)
17
18  ! Allocate to matching sizes and initialize.
19  ALLOCATE (x(-1:0, -3:-1), y(11:12, 3))
20  a = 0
21  b = 1
22  x = 2
23  y = 3
24
25  ! Run the checks.  This should be simplified without array temporaries,
26  ! and additionally correct (of course).
27
28  ! Shape of expressions known at compile-time.
29  IF (ANY (LBOUND (a + b) /= 1)) CALL abort ()
30  IF (ANY (UBOUND (2 * b) /= (/ 2, 3 /))) CALL abort ()
31  IF (ANY (SHAPE (- b) /= (/ 2, 3 /))) CALL abort ()
32  IF (SIZE (a ** 2) /= 6) CALL abort
33
34  ! Shape unknown at compile-time.
35  IF (ANY (LBOUND (x + y) /= 1)) CALL abort ()
36  IF (SIZE (x ** 2) /= 6) CALL abort ()
37
38  ! Unfortunately, the array-version of UBOUND and SHAPE keep generating
39  ! temporary arrays for their results (not for the operation).  Thus we
40  ! can not check SHAPE in this case and do UBOUND in the single-dimension
41  ! version.
42  IF (UBOUND (2 * y, 1) /= 2 .OR. UBOUND (2 * y, 2) /= 3) CALL abort ()
43  !IF (ANY (SHAPE (- y) /= (/ 2, 3 /))) CALL abort ()
44END PROGRAM main
45