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

* patch by Christophe Staïesse to implement more ISO-like read behaviour in iso mode, resolves #24060

Browse Source 
git-svn-id: trunk@23884 -
This commit is contained in:
florian 2013-03-17 08:27:21 +00:00
parent f12a0b7ece
commit d5985b4f0e
5 changed files with 260 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11199,6 +11199,7 @@ tests/test/tisogoto2.pp svneol=native#text/pascal
tests/test/tisogoto3.pp svneol=native#text/pascal
tests/test/tisogoto4.pp svneol=native#text/pascal
tests/test/tisogoto5.pp svneol=native#text/pascal
tests/test/tisoread.pp svneol=native#text/pascal
tests/test/tlib1a.pp svneol=native#text/plain
tests/test/tlib1b.pp svneol=native#text/plain
tests/test/tlib2a.pp svneol=native#text/plain

18
compiler/ninl.pas
View File

@ -603,6 +603,9 @@ implementation
name := procprefixes[do_read]+'float';
readfunctype:=pbestrealtype^;
end;
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
end;
enumdef:
begin
@ -620,6 +623,9 @@ implementation
s32bit :
begin
name := procprefixes[do_read]+'sint';
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
readfunctype:=sinttype;
end;
{$ifdef cpu64bitaddr}
@ -630,6 +636,9 @@ implementation
u32bit :
begin
name := procprefixes[do_read]+'uint';
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
readfunctype:=uinttype;
end;
uchar :
@ -649,17 +658,26 @@ implementation
s64bit :
begin
name := procprefixes[do_read]+'int64';
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
readfunctype:=s64inttype;
end;
u64bit :
begin
name := procprefixes[do_read]+'qword';
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
readfunctype:=u64inttype;
end;
{$endif not cpu64bitaddr}
scurrency:
begin
name := procprefixes[do_read]+'currency';
{ iso pascal needs a different handler }
if (m_iso in current_settings.modeswitches) and do_read then
name:=name+'_iso';
readfunctype:=s64currencytype;
is_real:=true;
end;

6
rtl/inc/compproc.inc
View File

@ -443,15 +443,21 @@ procedure fpc_Read_Text_WideChar(var f : Text; out wc: widechar); compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_Read_Text_Char_Iso(var f : Text; out c : char); compilerproc;
Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
Procedure fpc_Read_Text_SInt_Iso(var f : Text; out l : ValSInt); compilerproc;
Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
Procedure fpc_Read_Text_UInt_Iso(var f : Text; out u : ValUInt); compilerproc;
{$ifndef FPUNONE}
Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
Procedure fpc_Read_Text_Float_Iso(var f : Text; out v : ValReal); compilerproc;
{$endif}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
procedure fpc_Read_Text_Currency_Iso(var f : Text; out v : Currency); compilerproc;
{$ifndef CPU64}
Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;
procedure fpc_Read_Text_QWord_Iso(var f : text; out q : qword); compilerproc;
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;
procedure fpc_Read_Text_Int64_Iso(var f : text; out i : int64); compilerproc;
{$endif CPU64}
function fpc_GetBuf(var f : Text) : pchar; compilerproc;
{$endif FPC_HAS_FEATURE_TEXTIO}

195
rtl/inc/text.inc
View File

@ -1139,6 +1139,130 @@ begin
end;
procedure ReadInteger(var f:Text;var s:string);
{
Ignore leading blanks (incl. EOF) and return the first characters matching
an integer in the format recognized by the Val procedure:
[+-]?[0-9]+
or [+-]?(0x|0X|x|X)[0-9A-Za-z]+
or [+-]?&[0-7]+
or [+-]?%[0-1]+
A partial match may be returned, e.g.: '' or '+' or '0x'.
Used by some fpc_Read_Text_*_Iso functions which implement the read()
standard function in ISO mode.
}
var
Base: Integer;
begin
s := '';
with TextRec(f) do begin
if not CheckRead(f) then Exit;
IgnoreSpaces(f);
if BufPos >= BufEnd then Exit;
if BufPtr^[BufPos] in ['+','-'] then
NextChar(f,s);
Base := 10;
if BufPos >= BufEnd then Exit;
if BufPtr^[BufPos] in ['$','x','X','%','&'] then
begin
case BufPtr^[BufPos] of
'$','x','X': Base := 16;
'%': Base := 2;
'&': Base := 8;
end;
NextChar(f,s);
end else if BufPtr^[BufPos] = '0' then
begin
NextChar(f,s);
if BufPos >= BufEnd then Exit;
if BufPtr^[BufPos] in ['x','X'] then
begin
Base := 16;
NextChar(f,s);
end;
end;
while (BufPos < BufEnd) and (Length(s) < High(s)) do
if (((Base = 2) and (BufPtr^[BufPos] in ['0'..'1']))
or ((Base = 8) and (BufPtr^[BufPos] in ['0'..'7']))
or ((Base = 10) and (BufPtr^[BufPos] in ['0'..'9']))
or ((Base = 16) and (BufPtr^[BufPos] in ['0'..'9','a'..'f','A'..'F']))) then
NextChar(f,s)
else Exit;
end;
end;
procedure ReadReal(var f:Text;var s:string);
{
Ignore leading blanks (incl. EOF) and return the first characters matching
a float number in the format recognized by the Val procedure:
[+-]?([0-9]+)?\.[0-9]+([eE][+-]?[0-9]+)?
or [+-]?[0-9]+\.([0-9]+)?([eE][+-]?[0-9]+)?
A partial match may be returned, e.g.: '' or '+' or '.' or '1e' or even '+.'.
Used by some fpc_Read_Text_*_Iso functions which implement the read()
standard function in ISO mode.
}
var digit: Boolean;
begin
s := '';
with TextRec(f) do begin
if not CheckRead(f) then Exit;
IgnoreSpaces(f);
if BufPos >= BufEnd then Exit;
if BufPtr^[BufPos] in ['+','-'] then
NextChar(f,s);
digit := false;
if BufPos >= BufEnd then Exit;
if BufPtr^[BufPos] in ['0'..'9'] then
begin
digit := true;
repeat
NextChar(f,s);
if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
until not (BufPtr^[BufPos] in ['0'..'9']);
end;
if BufPtr^[BufPos] = '.' then
begin
NextChar(f,s);
if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
if BufPtr^[BufPos] in ['0'..'9'] then
begin
digit := true;
repeat
NextChar(f,s);
if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
until not (BufPtr^[BufPos] in ['0'..'9']);
end;
end;
{at least one digit is required on the left of the exponent}
if digit and (BufPtr^[BufPos] in ['e','E']) then
begin
NextChar(f,s);
if (BufPos >= BufEnd) or (Length(s) >= High(s)) then Exit;
if BufPtr^[BufPos] in ['+','-'] then
NextChar(f,s);
while (BufPos < BufEnd) and (Length(s) < High(s)) do
if BufPtr^[BufPos] in ['0'..'9'] then
NextChar(f,s)
else break;
end;
end;
end;
Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; compilerproc;
begin
if TextRec(f).FlushFunc<>nil then
@ -1534,6 +1658,19 @@ Begin
End;
Procedure fpc_Read_Text_SInt_Iso(var f : Text; out l : ValSInt); iocheck; compilerproc;
var
hs : String;
code : ValSInt;
Begin
ReadInteger(f,hs);
Val(hs,l,code);
if Code <> 0 then
InOutRes:=106;
End;
Procedure fpc_Read_Text_UInt(var f : Text; out u : ValUInt); iocheck; compilerproc;
var
hs : String;
@ -1561,6 +1698,17 @@ Begin
end;
End;
Procedure fpc_Read_Text_UInt_Iso(var f : Text; out u : ValUInt); iocheck; compilerproc;
var
hs : String;
code : ValSInt;
Begin
ReadInteger(f,hs);
Val(hs,u,code);
If code<>0 Then
InOutRes:=106;
End;
{$ifndef FPUNONE}
procedure fpc_Read_Text_Float(var f : Text; out v : ValReal); iocheck; compilerproc;
@ -1584,6 +1732,18 @@ begin
If code<>0 Then
InOutRes:=106;
end;
procedure fpc_Read_Text_Float_Iso(var f : Text; out v : ValReal); iocheck; compilerproc;
var
hs : string;
code : Word;
begin
ReadReal(f,hs);
Val(hs,v,code);
If code<>0 Then
InOutRes:=106;
end;
{$endif}
procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); iocheck;compilerproc;
@ -1634,6 +1794,18 @@ begin
end;
procedure fpc_Read_Text_Currency_Iso(var f : Text; out v : Currency); iocheck; compilerproc;
var
hs : string;
code : ValSInt;
begin
ReadReal(f,hs);
Val(hs,v,code);
If code<>0 Then
InOutRes:=106;
end;
{$ifndef cpu64}
procedure fpc_Read_Text_QWord(var f : text; out q : qword); iocheck; compilerproc;
@ -1658,6 +1830,17 @@ Begin
InOutRes:=106;
End;
procedure fpc_Read_Text_QWord_Iso(var f : text; out q : qword); iocheck; compilerproc;
var
hs : String;
code : longint;
Begin
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;
var
hs : String;
@ -1680,6 +1863,18 @@ Begin
InOutRes:=106;
End;
procedure fpc_Read_Text_Int64_Iso(var f : text; out i : int64); iocheck; compilerproc;
var
hs : String;
code : Longint;
Begin
ReadInteger(f,hs);
Val(hs,i,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif CPU64}

40
tests/test/tisoread.pp Normal file
View File

@ -0,0 +1,40 @@
{$mode iso}
program tisoread(f);
{
Test Read in ISO mode when reading real and integer numbers.
}
var
f: text;
i,j,k: integer;
r,s,t: real;
begin
assign(f,'tisoread.tmp');
rewrite(f);
writeln(f,' ');
writeln(f);
writeln(f,'1234567890+1234567890-1234567890');
writeln(f,'0x12345678$ABCDEF0x12345678');
writeln(f,'0X12345678X12345678');
writeln(f,'%10101010&12345670');
writeln(f,' ');
writeln(f);
writeln(f,'+123.-.123.123');
writeln(f,'1e2+1e-2');
close(f);
reset(f);
read(f,i,j,k);
if not ((i = 1234567890) and (i=j) and (i=-k)) then halt(1);
read(f,i,j,k);
if not ((i = $12345678) and (j = $abcdef0) and (k = $12345678)) then halt(2);
read(f,i,j);
if not ((i = $12345678) and (j = $12345678)) then halt(3);
read(f,i,j);
if not((i = 170) and (j = 2739128)) then halt(4);
read(f,r,s,t);
if not((r=123) and (round(s*1000)=-123) and (round(t*1000)=123)) then halt(5);
read(f,r,s);
if not((r = 1e2) and (trunc(s*100) = 1)) then halt(6);
close(f);
erase(f);
writeln('ok');
end.