paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 09:29:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* check properly for i/o errors in the iso read helpers, resolves #37154

Browse Source 
* CheckRead checks if reading caused an I/O error and returns false in this case

git-svn-id: trunk@45635 -
This commit is contained in:
florian 2020-06-10 20:47:58 +00:00
parent 810ec836dd
commit 50c48349d5
3 changed files with 53 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -18323,6 +18323,7 @@ tests/webtbs/tw37095.pp svneol=native#text/plain
tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
tests/webtbs/tw37107.pp svneol=native#text/pascal tests/webtbs/tw37107.pp svneol=native#text/pascal
tests/webtbs/tw37136.pp svneol=native#text/pascal tests/webtbs/tw37136.pp svneol=native#text/pascal
tests/webtbs/tw37154.pp svneol=native#text/pascal
tests/webtbs/tw3719.pp svneol=native#text/plain tests/webtbs/tw3719.pp svneol=native#text/plain
tests/webtbs/tw3721.pp svneol=native#text/plain tests/webtbs/tw3721.pp svneol=native#text/plain
tests/webtbs/tw3742.pp svneol=native#text/plain tests/webtbs/tw3742.pp svneol=native#text/plain

58
rtl/inc/text.inc
View File

@ -1457,7 +1457,7 @@ begin
end; end;
if TextRec(f).BufPos>=TextRec(f).BufEnd Then if TextRec(f).BufPos>=TextRec(f).BufEnd Then
FileFunc(TextRec(f).InOutFunc)(TextRec(f)); FileFunc(TextRec(f).InOutFunc)(TextRec(f));
CheckRead:=True; CheckRead:=InOutRes=0;
end; end;
@ -1991,11 +1991,15 @@ var
hs : String; hs : String;
code : ValSInt; code : ValSInt;
Begin Begin
ReadInteger(f,hs); l:=0;
if not CheckRead(f) then
Exit;
Val(hs,l,code); ReadInteger(f,hs);
if Code <> 0 then
InOutRes:=106; Val(hs,l,code);
if Code <> 0 then
InOutRes:=106;
End; End;
@ -2031,10 +2035,14 @@ var
hs : String; hs : String;
code : ValSInt; code : ValSInt;
Begin Begin
ReadInteger(f,hs); u:=0;
Val(hs,u,code); if not CheckRead(f) then
If code<>0 Then Exit;
InOutRes:=106;
ReadInteger(f,hs);
Val(hs,u,code);
If code<>0 Then
InOutRes:=106;
End; End;
@ -2067,6 +2075,10 @@ var
hs : string; hs : string;
code : Word; code : Word;
begin begin
v:=0.0;
if not CheckRead(f) then
Exit;
ReadReal(f,hs); ReadReal(f,hs);
Val(hs,v,code); Val(hs,v,code);
If code<>0 Then If code<>0 Then
@ -2127,6 +2139,10 @@ var
hs : string; hs : string;
code : ValSInt; code : ValSInt;
begin begin
v:=0.0;
if not CheckRead(f) then
Exit;
ReadReal(f,hs); ReadReal(f,hs);
Val(hs,v,code); Val(hs,v,code);
If code<>0 Then If code<>0 Then
@ -2163,10 +2179,14 @@ var
hs : String; hs : String;
code : longint; code : longint;
Begin Begin
ReadInteger(f,hs); q:=0;
Val(hs,q,code); if not CheckRead(f) then
If code<>0 Then Exit;
InOutRes:=106;
ReadInteger(f,hs);
Val(hs,q,code);
If code<>0 Then
InOutRes:=106;
End; End;
procedure fpc_Read_Text_Int64(var f : text; out i : int64); iocheck; compilerproc; procedure fpc_Read_Text_Int64(var f : text; out i : int64); iocheck; compilerproc;
@ -2196,10 +2216,14 @@ var
hs : String; hs : String;
code : Longint; code : Longint;
Begin Begin
ReadInteger(f,hs); l:=0;
Val(hs,i,code); if not CheckRead(f) then
If code<>0 Then Exit;
InOutRes:=106;
ReadInteger(f,hs);
Val(hs,i,code);
If code<>0 Then
InOutRes:=106;
End; End;

11
tests/webtbs/tw37154.pp Normal file
View File

@ -0,0 +1,11 @@
{ %RESULT=6 }
{$mode ISO}
program isoModeReadingNumbers(input, output);
var
i: integer;
begin
{ we cannot call the executable with <&- >&- while running the test suite,
so render the file handle manually illegal }
Textrec(input).handle:=$1234;
readLn(i);
end.