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

git-svn-id: trunk@47263 -

rtl/inc/file.inc

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

rtl/inc/filerec.inc

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

rtl/inc/systemh.inc

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

rtl/inc/text.inc

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

rtl/inc/textrec.inc

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