This is my first shot, so be gentle :-)
The patch assumes FP wants sufficient compatibility with BP 7. If so, it
fixes two problems; if not, at least it was a fun exercise.
First, BP ignores non-numeric characters when a ReadLn is called with an
integer parameter. To fix this, I changed ReadNumeric's end condition to
explicitly terminate on all non-numerics.
Second, BP will not read a Text file past an EOF character at all,
regardless of its location in the file. The fix for this is inelegant
(inline buffer check), but I can move this out to an external proc if it's
onerous to maintain.
It's likely there are things I haven't thought of, so I appreciate comments
on it.
Sterling
Index: text.inc
===================================================================
RCS file: /FPC/CVS/fpc/rtl/inc/text.inc,v
retrieving revision 1.29
diff -w -b -i -u -p -1 -0 -r1.29 text.inc
--- text.inc 14 Feb 2005 17:13:29 -0000 1.29
+++ text.inc 26 Mar 2005 21:34:02 -0000
@@ -756,21 +756,21 @@ Begin
End;
{$endif HASWIDECHAR}
{*****************************************************************************
Read(Ln)
*****************************************************************************}
Function NextChar(var f:Text;var s:string):Boolean;
begin
- if TextRec(f).BufPos<TextRec(f).BufEnd then
+ if (TextRec(f).BufPos<TextRec(f).BufEnd) {$ifdef EOF_CTRLZ} and
(TextRec(f).Bufptr^[TextRec(f).BufPos]<>#26) {$endif} then
begin
if length(s)<high(s) then
begin
inc(s[0]);
s[length(s)]:=TextRec(f).BufPtr^[TextRec(f).BufPos];
end;
Inc(TextRec(f).BufPos);
If TextRec(f).BufPos>=TextRec(f).BufEnd Then
FileFunc(TextRec(f).InOutFunc)(TextRec(f));
NextChar:=true;
@@ -784,43 +784,43 @@ Function IgnoreSpaces(var f:Text):Boolea
{
Removes all leading spaces,tab,eols from the input buffer, returns true if
the buffer is empty
}
var
s : string;
begin
s:='';
IgnoreSpaces:=false;
{ Return false when already at EOF }
- if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) {$ifdef EOF_CTRLZ} and
(TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) {$endif} then
exit;
while (TextRec(f).Bufptr^[TextRec(f).BufPos] in [#9,#10,#13,' ']) do
begin
if not NextChar(f,s) then
exit;
{ EOF? }
- if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) {$ifdef EOF_CTRLZ} or
(TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) {$endif} then
break;
end;
IgnoreSpaces:=true;
end;
procedure ReadNumeric(var f:Text;var s:string);
{
Read numeric input, if buffer is empty then return True
}
begin
repeat
if not NextChar(f,s) then
exit;
- until (length(s)=high(s)) or (TextRec(f).BufPtr^[TextRec(f).BufPos] in
[#9,#10,#13,' ']);
+ until (length(s)=high(s)) or not (TextRec(f).BufPtr^[TextRec(f).BufPos] in
['+','-','.',',','0'..'9']);
end;
Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck;
{$ifdef hascompilerproc} compilerproc; {$endif}
begin
if TextRec(f).FlushFunc<>nil then
FileFunc(TextRec(f).FlushFunc)(TextRec(f));
end;
@@ -1049,24 +1049,25 @@ Begin
end;
exit;
end;
If TextRec(f).BufPos>=TextRec(f).BufEnd Then
FileFunc(TextRec(f).InOutFunc)(TextRec(f));
hs:='';
if IgnoreSpaces(f) then
begin
{ When spaces were found and we are now at EOF,
then we return 0 }
- if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) {$ifdef EOF_CTRLZ} or
(TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) {$endif} then
exit;
ReadNumeric(f,hs);
end;
+ if (hs <> '') then
{$ifdef hascompilerproc}
Val(hs,l,code);
{$else hascompilerproc}
Val(hs,fpc_Read_Text_SInt,code);
{$endif hascompilerproc}
If code<>0 Then
InOutRes:=106;
End;
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
