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

* fix for bug by Andrey 'Croco' Stolyarov

Browse Source 
git-svn-id: trunk@46853 -
This commit is contained in:
Tomas Hajny 2020-09-11 23:43:32 +00:00
parent f8b17c410b
commit 3c9257300d
1 changed files with 73 additions and 9 deletions

82
rtl/inc/text.inc
View File

@ -96,6 +96,12 @@ end;
Procedure Assign(out t:Text;const s : UnicodeString);
begin
InitText(t);
if Length (S) >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
{$ifdef FPC_ANSI_TEXTFILEREC}
TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
{$else FPC_ANSI_TEXTFILEREC}
@ -109,12 +115,29 @@ end;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure Assign(out t:Text;const s: RawByteString);
{$ifdef FPC_ANSI_TEXTFILEREC}
var
R: RawByteString;
{$endif FPC_ANSI_TEXTFILEREC}
Begin
InitText(t);
{$ifdef FPC_ANSI_TEXTFILEREC}
{ ensure the characters in the record's filename are encoded correctly }
TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
R:=ToSingleByteFileSystemEncodedFileName(S);
if Length (R) >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
TextRec(t).Name:=R;
{$else FPC_ANSI_TEXTFILEREC}
if Length (S) >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
TextRec(t).Name:=S;
{$endif FPC_ANSI_TEXTFILEREC}
{ null terminate, since the name array is regularly used as p(wide)char }
@ -138,27 +161,61 @@ End;
Procedure Assign(out t:Text;const p: PAnsiChar);
var
{$IFDEF FPC_HAS_FEATURE_ANSISTRINGS}
S: ansistring;
{$ELSE FPC_HAS_FEATURE_ANSISTRINGS}
Counter: SizeInt;
{$ENDIF FPC_HAS_FEATURE_ANSISTRINGS}
Begin
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Assign(t,AnsiString(p));
S := AnsiString (P);
if Length (S) >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
Assign(t,S);
{$else FPC_HAS_FEATURE_ANSISTRINGS}
{ no use in making this the one that does the work, since the name field is
limited to 255 characters anyway }
Assign(t,strpas(p));
{ Assign(t,strpas(p));}
{ TH: The length of name field may be extended sooner or later, let's play
safely }
Counter := IndexByte(P^,-1,0);
if Counter >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
Move(P^,TextRec(t).Name,counter+1);
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;
Procedure Assign(out t:Text;const c: AnsiChar);
{$IFNDEF FPC_HAS_FEATURE_ANSISTRINGS}
var
Counter: SizeInt;
{$ENDIF FPC_HAS_FEATURE_ANSISTRINGS}
Begin
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Assign(t,AnsiString(c));
{$else FPC_HAS_FEATURE_ANSISTRINGS}
Assign(t,ShortString(c));
Counter := IndexByte(c,-1,0);
if Counter >= Length (TextRec.Name) then
{ The last character of TextRec.Name needs to be #0 }
begin
InOutRes:=3;
Exit;
end;
Move(c,TextRec(F).Name,counter+1);
{ Assign(t,ShortString(c));}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;
Procedure Close(var t : Text);[IOCheck];
Begin
if InOutRes<>0 then
@ -472,6 +529,8 @@ Begin
(reads = 1) then
begin
oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
if InOutRes <> 0 then
isdevice := true;
InOutRes:=0;
end;
FileFunc(TextRec(t).InOutFunc)(TextRec(t));
@ -506,7 +565,7 @@ Begin
if not isdevice then
{ if we didn't modify the buffer, simply restore the BufPos and BufEnd }
{ (the latter because it's now probably set to zero because nothing was }
{ was read anymore) }
{ read anymore) }
if (reads = 0) then
begin
TextRec(t).BufPos:=oldbufpos;
@ -515,10 +574,15 @@ Begin
{ otherwise return to the old filepos and reset the buffer }
else
begin
InOutRes := 0;
do_seek(TextRec(t).handle,oldfilepos);
InOutRes:=0;
FileFunc(TextRec(t).InOutFunc)(TextRec(t));
TextRec(t).BufPos:=oldbufpos;
if InOutRes = 0 then
begin
FileFunc(TextRec(t).InOutFunc)(TextRec(t));
TextRec(t).BufPos:=oldbufpos;
end
else
InOutRes:=0;
end;
End;