169 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12 character(kind=1,len=50) internal_file3 character(kind=1,len=100) msg4 character(20) sign5 character, parameter :: const_internal_file*(*) = "(I6)"6 character(kind=1,len=50) internal_fileA(20)7 integer*1 stat1, id18 integer*2 stat29 integer*4 stat410 integer*8 stat811 integer :: iunit = 1012 integer, parameter :: junit = 1113 integer, pointer :: a(:)14 integer, parameter :: const_id = 6666615 procedure(), pointer :: procptr16 external external17 intrinsic acos18 19 namelist /nnn/ nn1, nn220 21 sign = 'suppress'22 23 open(10)24 25 write(*)26 write(*, *)27 write(*)28 write(*, *)29 write(unit=*) 'Ok'30 write(unit=iunit)31 write(unit=junit)32 write(unit=iunit, *)33 write(unit=junit, *)34 write(10)35 write(unit=10) 'Ok'36 write(*, nnn)37 write(10, nnn)38 !ERROR: If UNIT=internal-file appears, FMT or NML must also appear39 write(internal_file)40 write(internal_file, *)41 write(internal_file, fmt=*)42 write(internal_file, fmt=1) 'Ok'43 write(internal_file, nnn)44 write(internal_file, nml=nnn)45 write(unit=internal_file, *)46 write(fmt=*, unit=internal_file)47 write(10, advance='yes', fmt=1) 'Ok'48 write(10, *, delim='quote', sign='plus') jj49 write(10, '(A)', advance='no', asynchronous='yes', decimal='comma', &50 err=9, id=id, iomsg=msg, iostat=stat2, round='processor_defined', &51 sign=sign) 'Ok'52 53 print*54 print*, 'Ok'55 56 allocate(a(2), stat=stat2)57 allocate(a(8), stat=stat8)58 59 !ERROR: Duplicate UNIT specifier60 write(internal_file, unit=*, fmt=*)61 62 !ERROR: WRITE statement must have a UNIT specifier63 write(nml=nnn)64 65 !ERROR: WRITE statement must not have a BLANK specifier66 !ERROR: WRITE statement must not have a END specifier67 !ERROR: WRITE statement must not have a EOR specifier68 !ERROR: WRITE statement must not have a PAD specifier69 write(*, eor=9, blank='zero', end=9, pad='no')70 71 !ERROR: If NML appears, REC must not appear72 !ERROR: If NML appears, FMT must not appear73 !ERROR: If NML appears, a data list must not appear74 write(10, nnn, rec=40, fmt=1) 'Ok'75 76 !ERROR: Internal file variable 'const_internal_file' is not definable77 !BECAUSE: '"(I6)"' is not a variable or pointer78 write(const_internal_file, fmt=*)79 80 !ERROR: If UNIT=* appears, POS must not appear81 write(*, pos=n, nml=nnn)82 83 !ERROR: If UNIT=* appears, REC must not appear84 write(*, rec=n)85 86 !ERROR: If UNIT=internal-file appears, POS must not appear87 write(internal_file, err=9, pos=n, nml=nnn)88 89 !ERROR: If UNIT=internal-file appears, FMT or NML must also appear90 !ERROR: If UNIT=internal-file appears, REC must not appear91 write(internal_file, rec=n, err=9)92 93 !ERROR: If UNIT=* appears, REC must not appear94 write(*, rec=13) 'Ok'95 96 !ERROR: I/O unit must be a character variable or a scalar integer expression97 write(unit, *) 'Ok'98 99 !ERROR: If ADVANCE appears, UNIT=internal-file must not appear100 write(internal_file, advance='yes', fmt=1) 'Ok'101 102 !ERROR: If ADVANCE appears, an explicit format must also appear103 write(10, advance='yes') 'Ok'104 105 !ERROR: Invalid ASYNCHRONOUS value 'non'106 write(*, asynchronous='non')107 108 !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear109 write(*, asynchronous='yes')110 111 !ERROR: If ASYNCHRONOUS='YES' appears, UNIT=number must also appear112 write(internal_file, *, asynchronous='yes')113 114 !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear115 write(10, *, id=id) "Ok"116 117 !ERROR: If ID appears, ASYNCHRONOUS='YES' must also appear118 write(10, *, id=id, asynchronous='no') "Ok"119 120 !ERROR: If POS appears, REC must not appear121 write(10, pos=13, rec=13) 'Ok'122 123 !ERROR: If DECIMAL appears, FMT or NML must also appear124 !ERROR: If ROUND appears, FMT or NML must also appear125 !ERROR: If SIGN appears, FMT or NML must also appear126 !ERROR: Invalid DECIMAL value 'Komma'127 write(10, decimal='Komma', sign='plus', round='down') jj128 129 !ERROR: If DELIM appears, FMT=* or NML must also appear130 !ERROR: Invalid DELIM value 'Nix'131 write(delim='Nix', fmt='(A)', unit=10) 'Ok'132 133 !ERROR: ID kind (1) is smaller than default INTEGER kind (4)134 write(id=id1, unit=10, asynchronous='Yes') 'Ok'135 136 !ERROR: ID variable 'const_id' is not definable137 !BECAUSE: '66666_4' is not a variable or pointer138 write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'139 140 write(*, '(X)')141 142 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type CHARACTER(1)143 write((msg), *)144 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type CHARACTER(KIND=1,LEN=8_8)145 write("a string", *)146 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type CHARACTER(1)147 write(msg//msg, *)148 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type LOGICAL(4)149 write(.true., *)150 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type REAL(4)151 write(1.0, *)152 write(internal_fileA, *)153 !ERROR: I/O unit must be a character variable or a scalar integer expression, but is an expression of type CHARACTER(1)154 write((internal_fileA), *)155 !ERROR: I/O unit number must be scalar156 write([1,2,3], *)157 158 159 !ERROR: Output item must not be a procedure160 print*, procptr161 !ERROR: Output item must not be a procedure162 print*, acos163 !ERROR: Output item must not be a procedure164 print*, external165 1661 format (A)1679 continue168end169