gcc/testsuite/gfortran.dg/exit_3.f08

   1 ! { dg-do run }
   2 ! { dg-options "-std=f2008 " }
   3
   4 ! PR fortran/44602
   5 ! Check for correct behavior of EXIT / CYCLE combined with non-loop
   6 ! constructs at run-time.
   7
   8 ! Contributed by Daniel Kraft, d@domob.eu.
   9
  10 PROGRAM 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     STOP 1
  27     EXIT myif
  28   ELSE IF (i == 2) THEN
  29     EXIT myif
  30     STOP 2
  31   ELSE
  32     STOP 3
  33     EXIT myif
  34   END IF myif
  35
  36   mysel: SELECT CASE (i)
  37     CASE (1)
  38       STOP 4
  39       EXIT mysel
  40     CASE (2)
  41       EXIT mysel
  42       STOP 5
  43     CASE DEFAULT
  44       STOP 6
  45       EXIT mysel
  46   END SELECT mysel
  47
  48   mycharsel: SELECT CASE ("foobar")
  49     CASE ("abc")
  50       STOP 7
  51       EXIT mycharsel
  52     CASE ("xyz")
  53       STOP 8
  54       EXIT mycharsel
  55     CASE DEFAULT
  56       EXIT mycharsel
  57       STOP 9
  58   END SELECT mycharsel
  59
  60   myblock: BLOCK
  61     EXIT myblock
  62     STOP 10
  63   END BLOCK myblock
  64
  65   myassoc: ASSOCIATE (x => 5 + 2)
  66     EXIT myassoc
  67     STOP 11
  68   END ASSOCIATE myassoc
  69
  70   ALLOCATE (t :: var)
  71   mytypesel: SELECT TYPE (var)
  72     TYPE IS (t)
  73       EXIT mytypesel
  74       STOP 12
  75     CLASS DEFAULT
  76       STOP 13
  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       STOP 14
  85     END IF inner
  86     STOP 15
  87   END BLOCK outer
  88 END PROGRAM main