flang/test/Semantics/assign06.f90

   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
   5 program 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
  50 1   continue
  51 3   format('yes')
  52   end subroutine test
  53 end program