gcc/testsuite/gfortran.dg/goto_2.f90

   1 ! { 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