OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [goto_2.f90] - Blame information for rev 308

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

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! Checks for corrects warnings if branching to then end of a
3
! construct at various nesting levels
4
  subroutine check_if(i)
5
    goto 10  ! { dg-warning "Label at ... is not in the same block" }
6
    if (i > 0) goto 40
7
    if (i < 0) then
8
       goto 40
9
10  end if    ! { dg-warning "Label at ... is not in the same block" }
10
    if (i == 0) then
11
       i = i+1
12
       goto 20
13
       goto 40
14
20  end if
15
    if (i == 1) then
16
       i = i+1
17
       if (i == 2) then
18
          goto 30
19
       end if
20
       goto 40
21
30  end if
22
    return
23
40  i = -1
24
  end subroutine check_if
25
 
26
  subroutine check_select(i)
27
    goto 10  ! { dg-warning "Label at ... is not in the same block" }
28
    select case (i)
29
    case default
30
       goto 999
31
10  end select  ! { dg-warning "Label at ... is not in the same block" }
32
    select case (i)
33
    case (2)
34
       i = 1
35
       goto 20
36
       goto 999
37
    case default
38
       goto 999
39
20  end select
40
    j = i
41
    select case (j)
42
    case default
43
       select case (i)
44
       case (1)
45
          i = 2
46
          goto 30
47
       end select
48
       goto 999
49
30  end select
50
    return
51
999 i = -1
52
  end subroutine check_select
53
 
54
  i = 0
55
  call check_if (i)
56
  if (i /= 2) call abort ()
57
  call check_select (i)
58
  if (i /= 2) call abort ()
59
end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.