! { dg-do compile }
! { dg-options "-fcoarray=single" }
! 
! Coarray support
! PR fortran/18918

implicit none
integer :: n, m(1), k
character(len=30) :: str(2)

critical fkl ! { dg-error "Syntax error in CRITICAL" }
end critical fkl ! { dg-error "Expecting END PROGRAM" }

sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
sync memory (errmsg=str)
sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
sync images (-1) ! { dg-error "must between 1 and num_images" }
sync images (1)
sync images ( [ 1 ])
sync images ( m(1:0) ) 
sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
end

subroutine foo
critical
  stop 'error' ! { dg-error "Image control statement STOP" }
  sync all     ! { dg-error "Image control statement SYNC" }
  return 1     ! { dg-error "Image control statement RETURN" }
  critical     ! { dg-error "Nested CRITICAL block" }
  end critical 
end critical   ! { dg-error "Expecting END SUBROUTINE" }
end

subroutine bar()
do
  critical
    cycle ! { dg-error "leaves CRITICAL construct" }
  end critical
end do

outer: do
  critical
    do
      exit
      exit outer ! { dg-error "leaves CRITICAL construct" }
    end do
  end critical
end do outer
end subroutine bar


subroutine sub()
333 continue ! { dg-error "leaves CRITICAL construct" }
do
  critical
    if (.false.) then
      goto 333 ! { dg-error "leaves CRITICAL construct" }
      goto 777
777 end if
  end critical
end do

if (.true.) then
outer: do
  critical
    do
      goto 444
      goto 555 ! { dg-error "leaves CRITICAL construct" }
    end do
444 continue
  end critical
 end do outer
555 end if ! { dg-error "leaves CRITICAL construct" }
end subroutine sub

pure subroutine pureSub()
  critical ! { dg-error "Image control statement CRITICAL" }
  end critical ! { dg-error "Expecting END SUBROUTINE statement" }
  sync all ! { dg-error "Image control statement SYNC" }
  error stop ! { dg-error "not allowed in PURE procedure" }
end subroutine pureSub


SUBROUTINE TEST
   goto 10 ! { dg-warning "is not in the same block" }
   CRITICAL
     goto 5  ! OK
5    continue ! { dg-warning "is not in the same block" }
     goto 10 ! OK
     goto 20 ! { dg-error "leaves CRITICAL construct" }
     goto 30 ! { dg-error "leaves CRITICAL construct" }
10 END CRITICAL ! { dg-warning "is not in the same block" }
   goto 5 ! { dg-warning "is not in the same block" }
20 continue ! { dg-error "leaves CRITICAL construct" }
   BLOCK
30   continue ! { dg-error "leaves CRITICAL construct" }
   END BLOCK
end SUBROUTINE TEST