gcc/testsuite/gfortran.dg/coarray_3.f90

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