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

git-svn-id: trunk@23884 -

.gitattributes

@@ -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

compiler/ninl.pas

@@ -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;

rtl/inc/compproc.inc

@@ -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}

rtl/inc/text.inc

@@ -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}
 
 

tests/test/tisoread.pp

@@ -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.