stdlib: fix memory leak on file errors

stdlib: throw runtime error when reading invalid real number

stdlib: bugfix val (real) for empty strings

tdrimg: add another demo image

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:

lib/stdlib.pas

@@ -1182,8 +1182,18 @@ ext:
 		v := x;
 		code := 0;
 	end
+	else
+	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);
-		if aFile.lastError = 0 then
-		begin
-			fileerror(aFile, IOFileClosed);
+
 		{ writeln('close f.buffer:', aFile.buffer); }
 		dispose(aFile.buffer);
 		aFile.buffer := nil;
 
+		if aFile.lastError = 0 then
+		begin
 			if aFile.changed then
 				updatedirslot(aFile);
-
+			if aFile.lastError = 0 then
+				fileerror(aFile, IOFileClosed);
 		end;
 
 		closevolumeid(aFile.volumeid);

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)