- interface ref-cnt bug workaround for IPath

- IPath.Intern to be able to see the string contents while debugging (at least with delphi)
- previous workaround with temp-paths removed

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@1897 b956fd51-792f-4845-bead-9b4dfca2ff2c

2 files changed, 122 insertions, 36 deletions

diff --git a/unicode/src/base/UCovers.pas b/unicode/src/base/UCovers.pas
index 228a0783..0dbe672a 100644
--- a/unicode/src/base/UCovers.pas
+++ b/unicode/src/base/UCovers.pas
@@ -211,11 +211,9 @@ end;
 procedure TCoverDatabase.Open();
 var
   Version: integer;
-  Filename, TmpPath: IPath;
+  Filename: IPath;
 begin
-  // TODO: remove fpc refcount workaround
-  TmpPath := Platform.GetGameUserPath();
-  Filename := TmpPath.Append(COVERDB_FILENAME);
+  Filename := Platform.GetGameUserPath().Append(COVERDB_FILENAME);
 
   DB := TSQLiteDatabase.Create(Filename.ToUTF8());
   Version := GetVersion();
diff --git a/unicode/src/base/UPath.pas b/unicode/src/base/UPath.pas
index eeec5b74..32e1bc02 100644
--- a/unicode/src/base/UPath.pas
+++ b/unicode/src/base/UPath.pas
@@ -39,6 +39,7 @@ uses
   {$IFDEF MSWINDOWS}
   TntClasses,
   {$ENDIF}
+  UConfig,
   UUnicodeUtils;
 
 type
@@ -331,6 +332,12 @@ type
 
     // TODO: Dirwatch stuff
     // AddFileChangeListener(Listener: TFileChangeListener);
+
+    {**
+     * Internal string representation. For debugging only.
+     *}
+    function GetIntern: UTF8String;
+    property Intern: UTF8String READ GetIntern;
   end;
 
 {**
@@ -358,6 +365,89 @@ uses
   RTLConsts,
   UFilesystem;
 
+{*
+ * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work
+ * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019).
+ *
+ * There are two (probably more) scenarios causes a program to crash:
+ *
+ * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will
+ * internally create a temporary variable to hold the result of Path('fail').
+ * This temporary var is then passed as Self to GetParent(). Unfortunately FPC
+ * does already decrement the ref-count of the temporary var at the end of the
+ * call to Path('fail') and the ref-count drops to zero and the temp object
+ * is destroyed as FPC erroneously assumes that the temp is not used anymore.
+ * As a result the Self variable in GetParent() will be invalid, the same
+ * applies to TPathImpl.fName which reference count dropped to zero when the
+ * temp was destroyed. Hence GetParent() will likely crash.
+ * If it does not, ToUTF8() will either return some random string
+ * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash.
+ * Either way the result of ToUTF8() is messed up.
+ * This scenario applies whenever a function (or method) is called that returns
+ * an interfaced object (e.g. an IPath) and the result is used without storing
+ * a reference to it in a (temporary) variable first.
+ *
+ *  Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8();
+ *
+ * will not crash but is very impractical and error-prone. Note that Tmp2 cannot
+ * be replaced with Tmp (see scenario 2).
+ *
+ * 2. Another situation this bug will ruin our lives is when a variable to an
+ * interfaced object is used at the left and right side of an assignment as in:
+ *   MyPath := MyPath.GetParent()
+ *
+ * Although the bug is already fixed in the FPC development version 2.3.1
+ * it will take quite some time till the next FPC release (> 2.2.4) in which
+ * this issue is fixed.
+ *
+ * To workaround this bug we use some very simple and stupid kind of garbage
+ * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList)
+ * to artificially increase the ref-count of the newly created object.
+ * This keeps the object alive when FPC's temporary variable comes to the end
+ * of its lifetime and the object's ref-count is decremented
+ * (and is now 1 instead of 0).
+ * Later on, the object is either garbage or referenced by another variable.
+ *
+ * Look at
+ *   MyPath := Path('SomeDir/SubDir').GetParent()
+ *
+ * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore.
+ * (2) The result of GetParent() is referenced by MyPath
+ * Object (1) has a reference count of 1 (as it is only referenced by the
+ * GarbageList). Object (2) is referenced twice (MyPath + GarbageList).
+ * When the reference to (2) is finally stored in MyPath we can safely remove
+ * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of
+ * (2) will be decremented to 1.
+ *
+ * As we do not know when it is safe to remove an object from the GarbageList
+ * we assume that there are max. GarbageMaxCount IPath elements created until
+ * the execution of the expression is performed and a reference to the resulting
+ * object is assigned to a variable so all temps can be safely deleted.
+ *
+ * Worst-case scenarios are recursive calls or calls with large call stacks with
+ * functions that return an IPath. Also keep in mind that multiple threads might
+ * be executing such functions at the same time.
+ * A reasonable count might be a max. of 20.000 elements. With an average length
+ * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath
+ * this will consume ~1.2MB.
+ *}
+{$IFDEF FPC}
+{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4
+  {$DEFINE HAVE_REFCNTBUG}
+{$IFEND}
+{$ENDIF}
+
+{$IFDEF HAVE_REFCNTBUG}
+const
+  // when GarbageList.Count reaches GarbageMaxCount the oldest references in
+  // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount.
+  GarbageMaxCount = 20000;
+  GarbageAfterCleanCount = GarbageMaxCount-1000;
+
+var
+  GarbageList: IInterfaceList;
+{$ENDIF}
+
 type
   TPathImpl = class(TInterfacedObject, IPath)
     private
@@ -437,6 +527,8 @@ type
       function DeleteEmptyDir(): boolean;
       function Rename(const NewName: IPath): boolean;
       function CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+
+      function GetIntern(): UTF8String;
   end;
 
 function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath;
@@ -458,7 +550,7 @@ end;
 
 procedure TPathImpl.AssertRefCount;
 begin
-  {$IFDEF FPC}
+  {$IFDEF HAVE_REFCNTBUG}
   if (FRefCount <= 0) then
     raise Exception.Create('RefCount error: ' + IntToStr(FRefCount));
   {$ENDIF}
@@ -469,6 +561,16 @@ begin
   inherited Create();
   fName := Name;
   Unify(DelimOption);
+  {$IFDEF HAVE_REFCNTBUG}
+  GarbageList.Lock;
+  if (GarbageList.Count > GarbageMaxCount) then
+  begin
+    while (GarbageList.Count > GarbageAfterCleanCount) do
+      GarbageList.Delete(0);
+  end;
+  GarbageList.Add(Self);
+  GarbageList.Unlock;
+  {$ENDIF}
 end;
 
 destructor TPathImpl.Destroy();
@@ -619,7 +721,6 @@ end;
 function TPathImpl.SplitDirs(): IPathDynArray;
 var
   CurPath: IPath;
-  TmpPath: IPath;
   Components: array of IPath;
   CurPathStr: UTF8String;
   DelimPos: integer;
@@ -639,9 +740,7 @@ begin
     DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr));
     Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr)));
 
-    // TODO: remove this workaround for FPC bug
-    TmpPath := CurPath;
-    CurPath := TmpPath.GetParent();
+    CurPath := CurPath.GetParent();
   until (CurPath = PATH_NONE);
 
   // reverse list
@@ -683,13 +782,9 @@ end;
 function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean;
 var
   SelfPath, OtherPath: UTF8String;
-  TmpPath: IPath;
 begin
-  // TODO: remove fpc refcount bug workaround
-  TmpPath := Self.GetAbsolutePath();
-  SelfPath := TmpPath.RemovePathDelim().ToUTF8();
-  TmpPath := Other.GetAbsolutePath();
-  OtherPath := TmpPath.RemovePathDelim().ToUTF8();
+  SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8();
+  OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8();
   if (FileSystem.IsCaseSensitive() and not IgnoreCase) then
     Result := (CompareStr(SelfPath, OtherPath) = 0)
   else
@@ -709,33 +804,21 @@ end;
 function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean;
 var
   SelfPath, ParentPath: UTF8String;
-  TmpPath, TmpPath2: IPath;
 begin
   Result := false;
 
   if (Direct) then
   begin
-    // TODO: remove workaround for fpc refcount bug
-    TmpPath := Self.GetParent();
-    TmpPath2 := TmpPath.GetAbsolutePath();
-    SelfPath := TmpPath2.AppendPathDelim().ToUTF8();
-
-    // TODO: remove workaround for fpc refcount bug
-    TmpPath := Parent.GetAbsolutePath();
-    ParentPath := TmpPath.AppendPathDelim().ToUTF8();
+    SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8();
+    ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
 
     // simply check if this paths parent path (SelfPath) equals ParentPath
     Result := (SelfPath = ParentPath);
   end
   else
   begin
-    // TODO: remove workaround for fpc refcount bug
-    TmpPath := Self.GetAbsolutePath();
-    SelfPath := TmpPath.AppendPathDelim().ToUTF8();
-
-    // TODO: remove workaround for fpc refcount bug
-    TmpPath := Parent.GetAbsolutePath();
-    ParentPath := TmpPath.AppendPathDelim().ToUTF8();
+    SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8();
+    ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
 
     if (Length(SelfPath) <= Length(ParentPath)) then
       Exit;
@@ -751,7 +834,6 @@ end;
 function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath;
 var
   OldParent, AdjustedParent: IPath;
-  TmpPath: IPath;
   LocalName: IPath;
   PathFound: IPath;
   PathWithAdjParent: IPath;
@@ -766,10 +848,7 @@ begin
     Exit;
   end;
 
-  // extract name component of current path
-  // TODO: remove workaround for fpc refcount bug
-  TmpPath := CurPath.RemovePathDelim();
-  LocalName := TmpPath.GetName();
+  LocalName := CurPath.RemovePathDelim().GetName();
 
   // try to adjust parent
   OldParent := CurPath.GetParent();
@@ -975,6 +1054,11 @@ begin
   Result := FileSystem.CopyFile(Self, Target, FailIfExists);
 end;
 
+function TPathImpl.GetIntern(): UTF8String;
+begin
+  Result := fName;
+end;
+
 
 { TBinaryFileStream }
 
@@ -1238,6 +1322,10 @@ begin
 end;
 
 initialization
+  {$IFDEF HAVE_REFCNTBUG}
+  GarbageList := TInterfaceList.Create();
+  GarbageList.Capacity := GarbageMaxCount;
+  {$ENDIF}
   PATH_NONE_Singelton := Path('');
 
 finalization