! { dg-do run } | |
! { dg-options "-std=f2008 " } | |
! PR fortran/44602 | |
! Check for correct behavior of EXIT / CYCLE combined with non-loop | |
! constructs at run-time. | |
! Contributed by Daniel Kraft, d@domob.eu. | |
PROGRAM main | |
IMPLICIT NONE | |
TYPE :: t | |
END TYPE t | |
INTEGER :: i | |
CLASS(t), ALLOCATABLE :: var | |
! EXIT and CYCLE without names always refer to innermost *loop*. This | |
! however is checked at run-time already in exit_1.f08. | |
! Basic EXITs from different non-loop constructs. | |
i = 2 | |
myif: IF (i == 1) THEN | |
STOP 1 | |
EXIT myif | |
ELSE IF (i == 2) THEN | |
EXIT myif | |
STOP 2 | |
ELSE | |
STOP 3 | |
EXIT myif | |
END IF myif | |
mysel: SELECT CASE (i) | |
CASE (1) | |
STOP 4 | |
EXIT mysel | |
CASE (2) | |
EXIT mysel | |
STOP 5 | |
CASE DEFAULT | |
STOP 6 | |
EXIT mysel | |
END SELECT mysel | |
mycharsel: SELECT CASE ("foobar") | |
CASE ("abc") | |
STOP 7 | |
EXIT mycharsel | |
CASE ("xyz") | |
STOP 8 | |
EXIT mycharsel | |
CASE DEFAULT | |
EXIT mycharsel | |
STOP 9 | |
END SELECT mycharsel | |
myblock: BLOCK | |
EXIT myblock | |
STOP 10 | |
END BLOCK myblock | |
myassoc: ASSOCIATE (x => 5 + 2) | |
EXIT myassoc | |
STOP 11 | |
END ASSOCIATE myassoc | |
ALLOCATE (t :: var) | |
mytypesel: SELECT TYPE (var) | |
TYPE IS (t) | |
EXIT mytypesel | |
STOP 12 | |
CLASS DEFAULT | |
STOP 13 | |
EXIT mytypesel | |
END SELECT mytypesel | |
! Check EXIT with nested constructs. | |
outer: BLOCK | |
inner: IF (.TRUE.) THEN | |
EXIT outer | |
STOP 14 | |
END IF inner | |
STOP 15 | |
END BLOCK outer | |
END PROGRAM main |