URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [exit_3.f08] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do run }
! { dg-options "-std=f2008 -fall-intrinsics" }
 
! PR fortran/44602
! Check for correct behaviour 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
    CALL abort ()
    EXIT myif
  ELSE IF (i == 2) THEN
    EXIT myif
    CALL abort ()
  ELSE
    CALL abort ()
    EXIT myif
  END IF myif
 
  mysel: SELECT CASE (i)
    CASE (1)
      CALL abort ()
      EXIT mysel
    CASE (2)
      EXIT mysel
      CALL abort ()
    CASE DEFAULT
      CALL abort ()
      EXIT mysel
  END SELECT mysel
 
  mycharsel: SELECT CASE ("foobar")
    CASE ("abc")
      CALL abort ()
      EXIT mycharsel
    CASE ("xyz")
      CALL abort ()
      EXIT mycharsel
    CASE DEFAULT
      EXIT mycharsel
      CALL abort ()
  END SELECT mycharsel
 
  myblock: BLOCK
    EXIT myblock
    CALL abort ()
  END BLOCK myblock
 
  myassoc: ASSOCIATE (x => 5 + 2)
    EXIT myassoc
    CALL abort ()
  END ASSOCIATE myassoc
 
  ALLOCATE (t :: var)
  mytypesel: SELECT TYPE (var)
    TYPE IS (t)
      EXIT mytypesel
      CALL abort ()
    CLASS DEFAULT
      CALL abort ()
      EXIT mytypesel
  END SELECT mytypesel
 
  ! Check EXIT with nested constructs.
  outer: BLOCK
    inner: IF (.TRUE.) THEN
      EXIT outer
      CALL abort ()
    END IF inner
    CALL abort ()
  END BLOCK outer
END PROGRAM main

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { 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
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			`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`
88			`END PROGRAM main`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [exit_3.f08] - Blame information for rev 801