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 1481 format (A) 1499 continue 150end 151