mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-09 22:09:25 +02:00
* check properly for i/o errors in the iso read helpers, resolves #37154
* 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:
parent
810ec836dd
commit
50c48349d5
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -18323,6 +18323,7 @@ tests/webtbs/tw37095.pp svneol=native#text/plain
|
||||
tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
|
||||
tests/webtbs/tw37107.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/tw3721.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3742.pp svneol=native#text/plain
|
||||
|
@ -1457,7 +1457,7 @@ begin
|
||||
end;
|
||||
if TextRec(f).BufPos>=TextRec(f).BufEnd Then
|
||||
FileFunc(TextRec(f).InOutFunc)(TextRec(f));
|
||||
CheckRead:=True;
|
||||
CheckRead:=InOutRes=0;
|
||||
end;
|
||||
|
||||
|
||||
@ -1991,11 +1991,15 @@ var
|
||||
hs : String;
|
||||
code : ValSInt;
|
||||
Begin
|
||||
ReadInteger(f,hs);
|
||||
l:=0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
Val(hs,l,code);
|
||||
if Code <> 0 then
|
||||
InOutRes:=106;
|
||||
ReadInteger(f,hs);
|
||||
|
||||
Val(hs,l,code);
|
||||
if Code <> 0 then
|
||||
InOutRes:=106;
|
||||
End;
|
||||
|
||||
|
||||
@ -2031,10 +2035,14 @@ var
|
||||
hs : String;
|
||||
code : ValSInt;
|
||||
Begin
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,u,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
u:=0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,u,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
End;
|
||||
|
||||
|
||||
@ -2067,6 +2075,10 @@ var
|
||||
hs : string;
|
||||
code : Word;
|
||||
begin
|
||||
v:=0.0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
ReadReal(f,hs);
|
||||
Val(hs,v,code);
|
||||
If code<>0 Then
|
||||
@ -2127,6 +2139,10 @@ var
|
||||
hs : string;
|
||||
code : ValSInt;
|
||||
begin
|
||||
v:=0.0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
ReadReal(f,hs);
|
||||
Val(hs,v,code);
|
||||
If code<>0 Then
|
||||
@ -2163,10 +2179,14 @@ var
|
||||
hs : String;
|
||||
code : longint;
|
||||
Begin
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,q,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
q:=0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,q,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
End;
|
||||
|
||||
procedure fpc_Read_Text_Int64(var f : text; out i : int64); iocheck; compilerproc;
|
||||
@ -2196,10 +2216,14 @@ var
|
||||
hs : String;
|
||||
code : Longint;
|
||||
Begin
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,i,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
l:=0;
|
||||
if not CheckRead(f) then
|
||||
Exit;
|
||||
|
||||
ReadInteger(f,hs);
|
||||
Val(hs,i,code);
|
||||
If code<>0 Then
|
||||
InOutRes:=106;
|
||||
End;
|
||||
|
||||
|
||||
|
11
tests/webtbs/tw37154.pp
Normal file
11
tests/webtbs/tw37154.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user