gcc/testsuite/gfortran.dg/coarray_3.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 ! Coarray support
   5 ! PR fortran/18918
   6
   7 implicit none
   8 integer :: n, m(1), k
   9 character(len=30) :: str(2)
  10
  11 critical fkl ! { dg-error "Syntax error in CRITICAL" }
  12 end critical fkl ! { dg-error "Expecting END PROGRAM" }
  13
  14 sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
  15 sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
  16 sync memory (errmsg=str)
  17 sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
  18 sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
  19 sync images (-1) ! { dg-error "must between 1 and num_images" }
  20 sync images (1)
  21 sync images ( [ 1 ])
  22 sync images ( m(1:0) )
  23 sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
  24 end
  25
  26 subroutine foo
  27 critical
  28   stop 'error' ! { dg-error "Image control statement STOP" }
  29   sync all     ! { dg-error "Image control statement SYNC" }
  30   return 1     ! { dg-error "Image control statement RETURN" }
  31   critical     ! { dg-error "Nested CRITICAL block" }
  32   end critical
  33 end critical   ! { dg-error "Expecting END SUBROUTINE" }
  34 end
  35
  36 subroutine bar()
  37 do
  38   critical
  39     cycle ! { dg-error "leaves CRITICAL construct" }
  40   end critical
  41 end do
  42
  43 outer: do
  44   critical
  45     do
  46       exit
  47       exit outer ! { dg-error "leaves CRITICAL construct" }
  48     end do
  49   end critical
  50 end do outer
  51 end subroutine bar
  52
  53
  54 subroutine sub()
  55 333 continue ! { dg-error "leaves CRITICAL construct" }
  56 do
  57   critical
  58     if (.false.) then
  59       goto 333 ! { dg-error "leaves CRITICAL construct" }
  60       goto 777
  61 777 end if
  62   end critical
  63 end do
  64
  65 if (.true.) then
  66 outer: do
  67   critical
  68     do
  69       goto 444
  70       goto 555 ! { dg-error "leaves CRITICAL construct" }
  71     end do
  72 444 continue
  73   end critical
  74  end do outer
  75 555 end if ! { dg-error "leaves CRITICAL construct" }
  76 end subroutine sub
  77
  78 pure subroutine pureSub()
  79   critical ! { dg-error "Image control statement CRITICAL" }
  80   end critical ! { dg-error "Expecting END SUBROUTINE statement" }
  81   sync all ! { dg-error "Image control statement SYNC" }
  82   error stop ! { dg-error "not allowed in PURE procedure" }
  83 end subroutine pureSub
  84
  85
  86 SUBROUTINE TEST
  87    goto 10 ! { dg-warning "is not in the same block" }
  88    CRITICAL
  89      goto 5  ! OK
  90 5    continue ! { dg-warning "is not in the same block" }
  91      goto 10 ! OK
  92      goto 20 ! { dg-error "leaves CRITICAL construct" }
  93      goto 30 ! { dg-error "leaves CRITICAL construct" }
  94 10 END CRITICAL ! { dg-warning "is not in the same block" }
  95    goto 5 ! { dg-warning "is not in the same block" }
  96 20 continue ! { dg-error "leaves CRITICAL construct" }
  97    BLOCK
  98 30   continue ! { dg-error "leaves CRITICAL construct" }
  99    END BLOCK
 100 end SUBROUTINE TEST