1! { dg-do run }
2! { dg-options "-std=f2008 -fall-intrinsics" }
3
4! PR fortran/44709
5! Check that exit and cycle from within a BLOCK works for loops as expected.
6
7! Contributed by Daniel Kraft, d@domob.eu.
8
9PROGRAM main
10  IMPLICIT NONE
11  INTEGER :: i
12  
13  ! Simple exit without loop name.
14  DO
15    BLOCK
16      EXIT
17    END BLOCK
18    CALL abort ()
19  END DO
20
21  ! Cycle without loop name.
22  DO i = 1, 1
23    BLOCK
24      CYCLE
25    END BLOCK
26    CALL abort ()
27  END DO
28
29  ! Exit loop by name from within a BLOCK.
30  loop1: DO
31    DO
32      BLOCK
33        EXIT loop1
34      END BLOCK
35      CALL abort ()
36    END DO
37    CALL abort ()
38  END DO loop1
39
40  ! Cycle loop by name from within a BLOCK.
41  loop2: DO i = 1, 1
42    loop3: DO
43      BLOCK
44        CYCLE loop2
45      END BLOCK
46      CALL abort ()
47    END DO loop3
48    CALL abort ()
49  END DO loop2
50END PROGRAM main
51