aboutsummaryrefslogtreecommitdiffstats
path: root/unicode
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--unicode/src/base/UCovers.pas6
-rw-r--r--unicode/src/base/UPath.pas152
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 04:50:21 +0000