brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.8 KiB · 70b3f60 Raw
54 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test ASSIGN statement, assigned GOTO, and assigned format labels3! (see subclause 8.2.4 in Fortran 90 (*not* 2018!)4 5program main6  call test(0)7 contains8  subroutine test(n)9    integer, intent(in) :: n10    integer :: lab11    integer(kind=1) :: badlab112    real :: badlab213    integer :: badlab3(1)14    character, pointer :: badlab4(:) ! not contiguous15    character, pointer, contiguous :: oklab4(:)16    assign 1 to lab ! ok17    assign 1 to implicitlab1 ! ok18    !ERROR: 'badlab1' must be a default integer scalar variable19    assign 1 to badlab120    !ERROR: 'badlab2' must be a default integer scalar variable21    assign 1 to badlab222    !ERROR: 'badlab3' must be a default integer scalar variable23    assign 1 to badlab324    !ERROR: 'test' must be a default integer scalar variable25    assign 1 to test26    if (n==1) goto lab ! ok27    if (n==1) goto implicitlab2 ! ok28    !ERROR: 'badlab1' must be a default integer scalar variable29    if (n==1) goto badlab130    !ERROR: 'badlab2' must be a default integer scalar variable31    if (n==1) goto badlab232    !ERROR: 'badlab3' must be a default integer scalar variable33    if (n==1) goto badlab334    if (n==1) goto lab(1) ! ok35    if (n==1) goto lab,(1) ! ok36    if (n==1) goto lab(1,1) ! ok37    assign 3 to lab ! ok38    write(*,fmt=lab) ! ok39    write(*,fmt=implicitlab3) ! ok40    !ERROR: Format expression must be default character or default scalar integer41    write(*,fmt=badlab1)42    !ERROR: Format expression must be default character or default scalar integer43    write(*,fmt=z'feedface')44    !Legacy extension cases45    write(*,fmt=badlab2)46    write(*,fmt=badlab3)47    !Array cases48    write(*,fmt=badlab4) ! ok49    write(*,fmt=badlab5) ! ok501   continue513   format('yes')52  end subroutine test53end program54