OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [block_2.f08] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.