gcc/testsuite/gfortran.dg/bound_8.f90

   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
  11 PROGRAM 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 ()
  44 END PROGRAM main