stdlib: fix memory leak on file errors

stdlib: throw runtime error when reading invalid real number

tdrimg: add another demo image
This commit is contained in:
slederer 2025-08-22 02:20:21 +02:00
parent 0ea7dcef29
commit e4f6c8746d
2 changed files with 30 additions and 9 deletions

View file

@ -1186,12 +1186,17 @@ ext:
code := i - 1; code := i - 1;
end; end;
procedure errorhalt(var fil:file);
begin
RuntimeError(ioerrordesc[fil.lastError]);
end;
procedure checkerror(var fil:file); procedure checkerror(var fil:file);
begin begin
if fil.lastError <> 0 then if fil.lastError <> 0 then
begin begin
if not fil.errorAck then if not fil.errorAck then
RuntimeError(ioerrordesc[fil.lastError]) errorhalt(fil)
else else
begin begin
fil.lastError := 0; fil.lastError := 0;
@ -1339,7 +1344,10 @@ begin
if f.lastError = 0 then if f.lastError = 0 then
val(buf, v, errpos); val(buf, v, errpos);
if errpos <> 0 then if errpos <> 0 then
begin
fileerror(f, IOInvalidFormat); fileerror(f, IOInvalidFormat);
checkerror(f);
end;
end; end;
procedure freadstring(var s:string; var f:file); procedure freadstring(var s:string; var f:file);
@ -1665,12 +1673,21 @@ begin
{ writeln(' readbuf data: ', fil.buffer^[0][0]); } { writeln(' readbuf data: ', fil.buffer^[0][0]); }
end; 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); procedure fileerror(var fil:file; error:integer);
begin begin
(* should check if there was an error already
and throw a runtime error in that case *)
fil.lastError := error; fil.lastError := error;
fil.errorAck := false; fil.errorAck := false;
if fil.buffer <> nil then
begin
fil.needsflush := false;
close(fil);
end;
end; end;
function IOResult(var fil:file):integer; function IOResult(var fil:file):integer;
@ -2052,19 +2069,22 @@ procedure close(var aFile:file);
begin begin
if aFile.typ = IODiskFile then if aFile.typ = IODiskFile then
begin begin
if aFile.lastError = IOFileClosed then
errorhalt(aFile);
{ writeln('close needsflush:', aFile.needsflush, ' changed:', aFile.changed, ' error:', aFile.lastError); } { writeln('close needsflush:', aFile.needsflush, ' changed:', aFile.changed, ' error:', aFile.lastError); }
if aFile.needsflush then if aFile.needsflush then
flushfile(aFile); flushfile(aFile);
{ writeln('close f.buffer:', aFile.buffer); }
dispose(aFile.buffer);
aFile.buffer := nil;
if aFile.lastError = 0 then if aFile.lastError = 0 then
begin begin
fileerror(aFile, IOFileClosed);
{ writeln('close f.buffer:', aFile.buffer); }
dispose(aFile.buffer);
aFile.buffer := nil;
if aFile.changed then if aFile.changed then
updatedirslot(aFile); updatedirslot(aFile);
if aFile.lastError = 0 then
fileerror(aFile, IOFileClosed);
end; end;
closevolumeid(aFile.volumeid); closevolumeid(aFile.volumeid);

View file

@ -604,6 +604,7 @@ def create_image_with_stuff(imgfile):
slotnr = putfile("../examples/Toco_Toucan.pict", None , f, part, partstart, slotnr) slotnr = putfile("../examples/Toco_Toucan.pict", None , f, part, partstart, slotnr)
slotnr = putfile("../examples/shinkansen.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/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) slotnr = putfile("../examples/benchmarks.pas", None , f, part, partstart, slotnr)