mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
89 lines
1.5 KiB
Plaintext
89 lines
1.5 KiB
Plaintext
! { 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
|