1! { dg-do run }
2! { dg-options "-std=f2008 -fall-intrinsics" }
3
4! PR fortran/44602
5! Check for correct behaviour of EXIT / CYCLE combined with non-loop
6! constructs at run-time.
7
8! Contributed by Daniel Kraft, d@domob.eu.
9
10PROGRAM main
11  IMPLICIT NONE
12
13  TYPE :: t
14  END TYPE t
15
16  INTEGER :: i
17  CLASS(t), ALLOCATABLE :: var
18
19  ! EXIT and CYCLE without names always refer to innermost *loop*.  This
20  ! however is checked at run-time already in exit_1.f08.
21
22  ! Basic EXITs from different non-loop constructs.
23
24  i = 2
25  myif: IF (i == 1) THEN
26    CALL abort ()
27    EXIT myif
28  ELSE IF (i == 2) THEN
29    EXIT myif
30    CALL abort ()
31  ELSE
32    CALL abort ()
33    EXIT myif
34  END IF myif
35
36  mysel: SELECT CASE (i)
37    CASE (1)
38      CALL abort ()
39      EXIT mysel
40    CASE (2)
41      EXIT mysel
42      CALL abort ()
43    CASE DEFAULT
44      CALL abort ()
45      EXIT mysel
46  END SELECT mysel
47
48  mycharsel: SELECT CASE ("foobar")
49    CASE ("abc")
50      CALL abort ()
51      EXIT mycharsel
52    CASE ("xyz")
53      CALL abort ()
54      EXIT mycharsel
55    CASE DEFAULT
56      EXIT mycharsel
57      CALL abort ()
58  END SELECT mycharsel
59
60  myblock: BLOCK
61    EXIT myblock
62    CALL abort ()
63  END BLOCK myblock
64
65  myassoc: ASSOCIATE (x => 5 + 2)
66    EXIT myassoc
67    CALL abort ()
68  END ASSOCIATE myassoc
69
70  ALLOCATE (t :: var)
71  mytypesel: SELECT TYPE (var)
72    TYPE IS (t)
73      EXIT mytypesel
74      CALL abort ()
75    CLASS DEFAULT
76      CALL abort ()
77      EXIT mytypesel
78  END SELECT mytypesel
79
80  ! Check EXIT with nested constructs.
81  outer: BLOCK
82    inner: IF (.TRUE.) THEN
83      EXIT outer
84      CALL abort ()
85    END IF inner
86    CALL abort ()
87  END BLOCK outer
88END PROGRAM main
89