gcc/testsuite/gfortran.dg/block_2.f08

   1 ! { dg-do run }
   2 ! { dg-options "-std=f2008 -fall-intrinsics -fdump-tree-original" }
   3
   4 ! More sophisticated BLOCK runtime checks for correct initialization/clean-up.
   5
   6 PROGRAM main
   7   IMPLICIT NONE
   8   INTEGER :: n
   9
  10   n = 5
  11
  12   myblock: BLOCK
  13     INTEGER :: arr(n)
  14     IF (SIZE (arr) /= 5) CALL abort ()
  15     BLOCK
  16       INTEGER :: arr(2*n)
  17       IF (SIZE (arr) /= 10) CALL abort ()
  18     END BLOCK
  19     IF (SIZE (arr) /= 5) CALL abort ()
  20   END BLOCK myblock
  21
  22   BLOCK
  23     INTEGER, ALLOCATABLE :: alloc_arr(:)
  24     IF (ALLOCATED (alloc_arr)) CALL abort ()
  25     ALLOCATE (alloc_arr(n))
  26     IF (SIZE (alloc_arr) /= 5) CALL abort ()
  27     ! Should be free'ed here (but at least somewhere), this is checked
  28     ! with pattern below.
  29   END BLOCK
  30
  31   BLOCK
  32     CHARACTER(LEN=n) :: str
  33     IF (LEN (str) /= 5) CALL abort ()
  34     str = "123456789"
  35     IF (str /= "12345") CALL abort ()
  36   END BLOCK
  37 END PROGRAM main
  38 ! { dg-final { scan-tree-dump-times "free \\(\\(void \\*\\) alloc_arr\\.data" 1 "original" } }
  39 ! { dg-final { cleanup-tree-dump "original" } }