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

+ initial implementation of a FullName field in file records to overcome length limitions of the name field

Browse Source 
git-svn-id: trunk@47263 -
This commit is contained in:
florian 2020-10-31 19:54:40 +00:00
parent 3d049a3309
commit 408fc819b3
5 changed files with 94 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
rtl/inc/file.inc
View File

@ -35,8 +35,16 @@ Begin
InitFile(F);
{$ifdef FPC_ANSI_TEXTFILEREC}
FileRec(f).Name:=ToSingleByteFileSystemEncodedFileName(Name);
{$ifdef USE_FILEREC_FULLNAME}
if Length(Name)>255 then
RawByteString(FileRec(f).FullName):=Name;
{$endif USE_FILEREC_FULLNAME}
{$else FPC_ANSI_TEXTFILEREC}
FileRec(f).Name:=Name;
{$ifdef USE_FILEREC_FULLNAME}
if Length(Name)>255 then
UnicodeString(FileRec(f).FullName):=Name;
{$endif USE_FILEREC_FULLNAME}
{$endif FPC_ANSI_TEXTFILEREC}
{ null terminate, since the name array is regularly used as p(wide)char }
FileRec(f).Name[high(FileRec(f).Name)]:=#0;
@ -54,8 +62,16 @@ Begin
{$ifdef FPC_ANSI_TEXTFILEREC}
{ ensure the characters in the record's filename are encoded correctly }
FileRec(f).Name:=ToSingleByteFileSystemEncodedFileName(Name);
{$ifdef USE_FILEREC_FULLNAME}
if Length(Name)>255 then
RawbyteString(FileRec(f).FullName):=Name;
{$endif USE_FILEREC_FULLNAME}
{$else FPC_ANSI_TEXTFILEREC}
FileRec(f).Name:=Name;
{$ifdef USE_FILEREC_FULLNAME}
if Length(Name)>255 then
UnicodeString(FileRec(f).FullName):=Name;
{$endif USE_FILEREC_FULLNAME}
{$endif FPC_ANSI_TEXTFILEREC}
{ null terminate, since the name array is regularly used as p(wide)char }
FileRec(f).Name[high(FileRec(f).Name)]:=#0;
@ -119,7 +135,12 @@ Begin
else
Begin
{ Reopen with filemode 2, to be Tp compatible (PFV) }
Do_Open(f,PFileTextRecChar(@FileRec(f).Name),$1002,false);
{$ifdef USE_FILEREC_FULLNAME}
if Assigned(FileRec(f).FullName) then
Do_Open(f,FileRec(f).FullName,$1002,false)
else
{$endif USE_FILEREC_FULLNAME}
Do_Open(f,PFileTextRecChar(@FileRec(f).Name),$1002,false);
FileRec(f).RecSize:=l;
End;
End;
@ -145,7 +166,12 @@ Begin
InOutRes:=2
else
Begin
Do_Open(f,PFileTextRecChar(@FileRec(f).Name),Filemode,false);
{$ifdef USE_FILEREC_FULLNAME}
if Assigned(FileRec(f).FullName) then
Do_Open(f,FileRec(f).FullName,Filemode,false)
else
{$endif USE_FILEREC_FULLNAME}
Do_Open(f,PFileTextRecChar(@FileRec(f).Name),Filemode,false);
FileRec(f).RecSize:=l;
End;
End;
@ -493,6 +519,9 @@ Begin
end
else InOutRes:=103;
end;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
UnicodeString(FileRec(f).FullName):='';
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
End;
@ -650,3 +679,13 @@ Begin
End;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
Function GetFullName(var f:File) : UnicodeString;
begin
{$ifdef USE_FILEREC_FULLNAME}
if Assigned(FileRec(f).FullName) then
Result:=UnicodeString(FileRec(f).FullName)
else
{$endif USE_FILEREC_FULLNAME}
Result:=PFileTextRecChar(@FileRec(f).Name);
end;

3
rtl/inc/filerec.inc
View File

@ -40,5 +40,8 @@ type
_private : array[1..3 * SizeOf(SizeInt) + 5 * SizeOf (pointer)] of byte;
UserData : array[1..32] of byte;
name : array[0..filerecnamelength] of TFileTextRecChar;
{$ifdef USE_FILEREC_FULLNAME}
FullName : Pointer;
{$endif USE_FILEREC_FULLNAME}
End;

9
rtl/inc/systemh.inc
View File

@ -87,6 +87,13 @@
{$define FPC_HAS_FEATURE_UNICODESTRINGS}
{$endif VER2_6}
{ for now, the presence of unicode strings is just an approximation,
USE_FILEREC_FULLNAME can be also enabled for other targets if
they need file names longer than 255 chars }
{$if defined(FPC_HAS_FEATURE_UNICODESTRINGS)}
{$define USE_FILEREC_FULLNAME}
{$endif defined(FPC_HAS_FEATURE_UNICODESTRINGS)}
{****************************************************************************
Global Types and Constants
****************************************************************************}
@ -1372,6 +1379,7 @@ Procedure Seek(var f:File;Pos:Int64);
Function EOF(var f:File):Boolean;
Procedure Erase(var f:File);
Procedure Truncate (var F:File);
Function GetFullName(var f:File) : UnicodeString;
{$endif FPC_HAS_FEATURE_FILEIO}
@ -1431,6 +1439,7 @@ Procedure SetTextBuf(var f:Text; var Buf; Size:SizeInt);
Procedure SetTextLineEnding(var f:Text; Ending:string);
function GetTextCodePage(var T: Text): TSystemCodePage;
procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
Function GetFullName(var T:Text) : UnicodeString;
{$endif FPC_HAS_FEATURE_TEXTIO}
{****************************************************************************

39
rtl/inc/text.inc
View File

@ -57,7 +57,12 @@ Begin
exit;
end;
End;
Do_Open(t,PFileTextRecChar(@t.Name),Flags,False);
{$ifdef USE_FILEREC_FULLNAME}
if Assigned(t.FullName) then
Do_Open(t,PFileTextRecChar(t.FullName),Flags,False)
else
{$endif USE_FILEREC_FULLNAME}
Do_Open(t,PFileTextRecChar(@t.Name),Flags,False);
t.CloseFunc:=@FileCloseFunc;
t.FlushFunc:=nil;
if t.Mode=fmInput then
@ -98,8 +103,16 @@ begin
InitText(t);
{$ifdef FPC_ANSI_TEXTFILEREC}
TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
{$ifdef USE_FILEREC_FULLNAME}
if length(s)>255 then
RawByteString(TextRec(t).FullName):=ToSingleByteFileSystemEncodedFileName(S);
{$endif USE_FILEREC_FULLNAME}
{$else FPC_ANSI_TEXTFILEREC}
TextRec(t).Name:=S;
{$ifdef USE_FILEREC_FULLNAME}
if length(s)>255 then
UnicodeString(TextRec(t).FullName):=S;
{$endif USE_FILEREC_FULLNAME}
{$endif FPC_ANSI_TEXTFILEREC}
{ null terminate, since the name array is regularly used as p(wide)char }
TextRec(t).Name[high(TextRec(t).Name)]:=#0;
@ -114,8 +127,16 @@ Begin
{$ifdef FPC_ANSI_TEXTFILEREC}
{ ensure the characters in the record's filename are encoded correctly }
TextRec(t).Name:=ToSingleByteFileSystemEncodedFileName(S);
{$ifdef USE_FILEREC_FULLNAME}
if length(s)>255 then
RawByteString(TextRec(t).FullName:=ToSingleByteFileSystemEncodedFileName(S);
{$endif USE_FILEREC_FULLNAME}
{$else FPC_ANSI_TEXTFILEREC}
TextRec(t).Name:=S;
{$ifdef USE_FILEREC_FULLNAME}
if length(s)>255 then
UnicodeString(TextRec(t).FullName):=S;
{$endif USE_FILEREC_FULLNAME}
{$endif FPC_ANSI_TEXTFILEREC}
{ null terminate, since the name array is regularly used as p(wide)char }
TextRec(t).Name[high(TextRec(t).Name)]:=#0;
@ -183,6 +204,13 @@ Begin
End
else inOutRes := 103;
End;
{$ifdef USE_FILEREC_FULLNAME}
{$ifdef FPC_ANSI_TEXTFILEREC}
RawByteString(TextRec(t).FullName):='';
{$else FPC_ANSI_TEXTFILEREC}
UnicodeString(TextRec(t).FullName):='';
{$endif FPC_ANSI_TEXTFILEREC}
{$endif USE_FILEREC_FULLNAME}
End;
@ -2618,6 +2646,15 @@ begin
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
Function GetFullName(var t:Text) : UnicodeString;
begin
{$ifdef USE_FILEREC_FULLNAME}
if Assigned(TextRec(t).FullName) then
Result:=UnicodeString(TextRec(t).FullName)
else
{$endif USE_FILEREC_FULLNAME}
Result:=PFileTextRecChar(@TextRec(t).Name);
end;
{*****************************************************************************
Initializing

3
rtl/inc/textrec.inc
View File

@ -57,5 +57,8 @@ type
{$ifdef FPC_HAS_CPSTRING}
CodePage : TSystemCodePage;
{$endif}
{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
FullName : Pointer;
{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
End;