diff --git a/doc/pascalprogramming.md b/doc/pascalprogramming.md index f45a0be..b534f2b 100644 --- a/doc/pascalprogramming.md +++ b/doc/pascalprogramming.md @@ -153,10 +153,12 @@ var f:file; ### Error Handling When an I/O error occurs, the _IOResult_ function can be called to get the error code. Unlike TP, the _IOResult_ function requires a file variable as a parameter. When you call _IOResult_, an error that may have occurred is considered to be _acknowledged_. If an -error is not ackowledged and you do another I/O operation, a runtime error is thrown. +error is not ackowledged and you do another I/O operation on that file, a runtime error is thrown. That means you can either write programs without checking for I/O errors, while resting assured that the program will exit if an I/O error occurs. You can also choose to check for errors with _IOResult_ if you want to avoid having runtime errors. +If an I/O error occurs on a file, it is then considered closed. Closing a file in this state, or a file that has been closed normally, will cause a runtime error. + The function _ErrorStr_ from the standard library takes an error code as an argument and returns the corresponding textual description as a string. Example: diff --git a/lib/stdlib.pas b/lib/stdlib.pas index 8ad45d9..dc122eb 100644 --- a/lib/stdlib.pas +++ b/lib/stdlib.pas @@ -1183,7 +1183,17 @@ ext: code := 0; end else - code := i - 1; + begin + if i = 1 then (* empty string gives error position 1 *) + code := 1 + else + code := i - 1; + end; +end; + +procedure errorhalt(var fil:file); +begin + RuntimeError(ioerrordesc[fil.lastError]); end; procedure checkerror(var fil:file); @@ -1191,7 +1201,7 @@ begin if fil.lastError <> 0 then begin if not fil.errorAck then - RuntimeError(ioerrordesc[fil.lastError]) + errorhalt(fil) else begin fil.lastError := 0; @@ -1334,12 +1344,16 @@ procedure freadreal(var v:real;var f:file); var buf:string[40]; errpos:integer; begin + errpos := -1; fskipwhite(f); fscanbuf(f,ScanReal, buf); if f.lastError = 0 then val(buf, v, errpos); if errpos <> 0 then + begin fileerror(f, IOInvalidFormat); + checkerror(f); + end; end; procedure freadstring(var s:string; var f:file); @@ -1665,12 +1679,21 @@ begin { writeln(' readbuf data: ', fil.buffer^[0][0]); } end; +procedure close(var aFile:file); forward; + +(* Set error state on file and close it. + Buffer will not be flushed as that might + have caused the error. +*) procedure fileerror(var fil:file; error:integer); begin - (* should check if there was an error already - and throw a runtime error in that case *) fil.lastError := error; fil.errorAck := false; + if fil.buffer <> nil then + begin + fil.needsflush := false; + close(fil); + end; end; function IOResult(var fil:file):integer; @@ -2052,19 +2075,22 @@ procedure close(var aFile:file); begin if aFile.typ = IODiskFile then begin + if aFile.lastError = IOFileClosed then + errorhalt(aFile); { writeln('close needsflush:', aFile.needsflush, ' changed:', aFile.changed, ' error:', aFile.lastError); } if aFile.needsflush then flushfile(aFile); + + { writeln('close f.buffer:', aFile.buffer); } + dispose(aFile.buffer); + aFile.buffer := nil; + if aFile.lastError = 0 then begin - fileerror(aFile, IOFileClosed); - { writeln('close f.buffer:', aFile.buffer); } - dispose(aFile.buffer); - aFile.buffer := nil; - if aFile.changed then updatedirslot(aFile); - + if aFile.lastError = 0 then + fileerror(aFile, IOFileClosed); end; closevolumeid(aFile.volumeid); diff --git a/utils/tdrimg.py b/utils/tdrimg.py index 6061a98..be93ed9 100644 --- a/utils/tdrimg.py +++ b/utils/tdrimg.py @@ -604,6 +604,7 @@ def create_image_with_stuff(imgfile): slotnr = putfile("../examples/Toco_Toucan.pict", None , f, part, partstart, slotnr) slotnr = putfile("../examples/shinkansen.pict", None , f, part, partstart, slotnr) slotnr = putfile("../examples/snow_leopard.pict", None , f, part, partstart, slotnr) + slotnr = putfile("../examples/ADDS-Envoy-620.pict", None , f, part, partstart, slotnr) slotnr = putfile("../examples/benchmarks.pas", None , f, part, partstart, slotnr)