1! { dg-do compile } 2! { dg-options "-fcoarray=single" } 3! 4! Coarray support 5! PR fortran/18918 6 7implicit none 8integer :: n, m(1), k 9character(len=30) :: str(2) 10 11critical fkl ! { dg-error "Syntax error in CRITICAL" } 12end critical fkl ! { dg-error "Expecting END PROGRAM" } 13 14sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" } 15sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" } 16sync memory (errmsg=str) 17sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" } 18sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" } 19sync images (-1) ! { dg-error "must between 1 and num_images" } 20sync images (1) 21sync images ( [ 1 ]) 22sync images ( m(1:0) ) 23sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" } 24end 25 26subroutine foo 27critical 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 33end critical ! { dg-error "Expecting END SUBROUTINE" } 34end 35 36subroutine bar() 37do 38 critical 39 cycle ! { dg-error "leaves CRITICAL construct" } 40 end critical 41end do 42 43outer: do 44 critical 45 do 46 exit 47 exit outer ! { dg-error "leaves CRITICAL construct" } 48 end do 49 end critical 50end do outer 51end subroutine bar 52 53 54subroutine sub() 55333 continue ! { dg-error "leaves CRITICAL construct" } 56do 57 critical 58 if (.false.) then 59 goto 333 ! { dg-error "leaves CRITICAL construct" } 60 goto 777 61777 end if 62 end critical 63end do 64 65if (.true.) then 66outer: do 67 critical 68 do 69 goto 444 70 goto 555 ! { dg-error "leaves CRITICAL construct" } 71 end do 72444 continue 73 end critical 74 end do outer 75555 end if ! { dg-error "leaves CRITICAL construct" } 76end subroutine sub 77 78pure 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 83end subroutine pureSub 84 85 86SUBROUTINE TEST 87 goto 10 ! { dg-warning "is not in the same block" } 88 CRITICAL 89 goto 5 ! OK 905 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" } 9410 END CRITICAL ! { dg-warning "is not in the same block" } 95 goto 5 ! { dg-warning "is not in the same block" } 9620 continue ! { dg-error "leaves CRITICAL construct" } 97 BLOCK 9830 continue ! { dg-error "leaves CRITICAL construct" } 99 END BLOCK 100end SUBROUTINE TEST 101