flang/test/Semantics/io04.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2   character(kind=1,len=50) internal_file
   3   character(kind=1,len=100) msg
   4   character(20) sign
   5   character, parameter :: const_internal_file*(*) = "(I6)"
   6   integer*1 stat1, id1
   7   integer*2 stat2
   8   integer*4 stat4
   9   integer*8 stat8
  10   integer :: iunit = 10
  11   integer, parameter :: junit = 11
  12   integer, pointer :: a(:)
  13   integer, parameter :: const_id = 66666
  14   procedure(), pointer :: procptr
  15   external external
  16   intrinsic acos
  17
  18   namelist /nnn/ nn1, nn2
  19
  20   sign = 'suppress'
  21
  22   open(10)
  23
  24   write(*)
  25   write(*, *)
  26   write(*)
  27   write(*, *)
  28   write(unit=*) 'Ok'
  29   write(unit=iunit)
  30   write(unit=junit)
  31   write(unit=iunit, *)
  32   write(unit=junit, *)
  33   write(10)
  34   write(unit=10) 'Ok'
  35   write(*, nnn)
  36   write(10, nnn)
  37   !ERROR: If UNIT=internal-file appears, FMT or NML must also appear
  38   write(internal_file)
  39   write(internal_file, *)
  40   write(internal_file, fmt=*)
  41   write(internal_file, fmt=1) 'Ok'
  42   write(internal_file, nnn)
  43   write(internal_file, nml=nnn)
  44   write(unit=internal_file, *)
  45   write(fmt=*, unit=internal_file)
  46   write(10, advance='yes', fmt=1) 'Ok'
  47   write(10, *, delim='quote', sign='plus') jj
  48   write(10, '(A)', advance='no', asynchronous='yes', decimal='comma', &
  49       err=9, id=id, iomsg=msg, iostat=stat2, round='processor_defined', &
  50       sign=sign) 'Ok'
  51
  52   print*
  53   print*, 'Ok'
  54
  55   allocate(a(2), stat=stat2)
  56   allocate(a(8), stat=stat8)
  57
  58   !ERROR: Duplicate UNIT specifier
  59   write(internal_file, unit=*, fmt=*)
  60
  61   !ERROR: WRITE statement must have a UNIT specifier
  62   write(nml=nnn)
  63
  64   !ERROR: WRITE statement must not have a BLANK specifier
  65   !ERROR: WRITE statement must not have a END specifier
  66   !ERROR: WRITE statement must not have a EOR specifier
  67   !ERROR: WRITE statement must not have a PAD specifier
  68   write(*, eor=9, blank='zero', end=9, pad='no')
  69
  70   !ERROR: If NML appears, REC must not appear
  71   !ERROR: If NML appears, FMT must not appear
  72   !ERROR: If NML appears, a data list must not appear
  73   write(10, nnn, rec=40, fmt=1) 'Ok'
  74
  75   !ERROR: Internal file variable 'const_internal_file' is not definable
  76   !BECAUSE: '"(I6)"' is not a variable or pointer
  77   write(const_internal_file, fmt=*)
  78
  79   !ERROR: If UNIT=* appears, POS must not appear
  80   write(*, pos=n, nml=nnn)
  81
  82   !ERROR: If UNIT=* appears, REC must not appear
  83   write(*, rec=n)
  84
  85   !ERROR: If UNIT=internal-file appears, POS must not appear
  86   write(internal_file, err=9, pos=n, nml=nnn)
  87
  88   !ERROR: If UNIT=internal-file appears, FMT or NML must also appear
  89   !ERROR: If UNIT=internal-file appears, REC must not appear
  90   write(internal_file, rec=n, err=9)
  91
  92   !ERROR: If UNIT=* appears, REC must not appear
  93   write(*, rec=13) 'Ok'
  94
  95   !ERROR: I/O unit must be a character variable or a scalar integer expression
  96   write(unit, *) 'Ok'
  97
  98   !ERROR: If ADVANCE appears, UNIT=internal-file must not appear
  99   write(internal_file, advance='yes', fmt=1) 'Ok'
 100
 101   !ERROR: If ADVANCE appears, an explicit format must also appear
 102   write(10, advance='yes') 'Ok'
 103
 104   !ERROR: Invalid ASYNCHRONOUS value 'non'
 105   write(*, asynchronous='non')
 106
 107   !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
 108   write(*, asynchronous='yes')
 109
 110   !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear
 111   write(internal_file, *, asynchronous='yes')
 112
 113   !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
 114   write(10, *, id=id) "Ok"
 115
 116   !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear
 117   write(10, *, id=id, asynchronous='no') "Ok"
 118
 119   !ERROR: If POS appears, REC must not appear
 120   write(10, pos=13, rec=13) 'Ok'
 121
 122   !ERROR: If DECIMAL appears, FMT or NML must also appear
 123   !ERROR: If ROUND appears, FMT or NML must also appear
 124   !ERROR: If SIGN appears, FMT or NML must also appear
 125   !ERROR: Invalid DECIMAL value 'Komma'
 126   write(10, decimal='Komma', sign='plus', round='down') jj
 127
 128   !ERROR: If DELIM appears, FMT=* or NML must also appear
 129   !ERROR: Invalid DELIM value 'Nix'
 130   write(delim='Nix', fmt='(A)', unit=10) 'Ok'
 131
 132   !ERROR: ID kind (1) is smaller than default INTEGER kind (4)
 133   write(id=id1, unit=10, asynchronous='Yes') 'Ok'
 134
 135   !ERROR: ID variable 'const_id' is not definable
 136   !BECAUSE: '66666_4' is not a variable or pointer
 137   write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'
 138
 139   write(*, '(X)')
 140
 141   !ERROR: Output item must not be a procedure
 142   print*, procptr
 143   !ERROR: Output item must not be a procedure
 144   print*, acos
 145   !ERROR: Output item must not be a procedure
 146   print*, external
 147
 148 1 format (A)
 149 9 continue
 150 end