1! RUN: %python %S/test_errors.py %s %flang_fc1 2! Test ASSIGN statement, assigned GOTO, and assigned format labels 3! (see subclause 8.2.4 in Fortran 90 (*not* 2018!) 4 5program main 6 call test(0) 7 contains 8 subroutine test(n) 9 integer, intent(in) :: n 10 integer :: lab 11 integer(kind=1) :: badlab1 12 real :: badlab2 13 integer :: badlab3(1) 14 character, pointer :: badlab4(:) ! not contiguous 15 character, pointer, contiguous :: oklab4(:) 16 assign 1 to lab ! ok 17 assign 1 to implicitlab1 ! ok 18 !ERROR: 'badlab1' must be a default integer scalar variable 19 assign 1 to badlab1 20 !ERROR: 'badlab2' must be a default integer scalar variable 21 assign 1 to badlab2 22 !ERROR: 'badlab3' must be a default integer scalar variable 23 assign 1 to badlab3 24 !ERROR: 'test' must be a default integer scalar variable 25 assign 1 to test 26 if (n==1) goto lab ! ok 27 if (n==1) goto implicitlab2 ! ok 28 !ERROR: 'badlab1' must be a default integer scalar variable 29 if (n==1) goto badlab1 30 !ERROR: 'badlab2' must be a default integer scalar variable 31 if (n==1) goto badlab2 32 !ERROR: 'badlab3' must be a default integer scalar variable 33 if (n==1) goto badlab3 34 if (n==1) goto lab(1) ! ok 35 if (n==1) goto lab,(1) ! ok 36 if (n==1) goto lab(1,1) ! ok 37 assign 3 to lab ! ok 38 write(*,fmt=lab) ! ok 39 write(*,fmt=implicitlab3) ! ok 40 !ERROR: Format expression must be default character or default scalar integer 41 write(*,fmt=badlab1) 42 !ERROR: Format expression must be default character or default scalar integer 43 write(*,fmt=z'feedface') 44 !Legacy extension cases 45 write(*,fmt=badlab2) 46 write(*,fmt=badlab3) 47 !Array cases 48 write(*,fmt=badlab4) ! ok 49 write(*,fmt=badlab5) ! ok 501 continue 513 format('yes') 52 end subroutine test 53end program 54