InterlockedCompareExchangePointer with Delphi string-CodePudding

In my server code I use the following pattern for creating "just in time" objects:

function TSomeObject.GetChildObjects: TChildObjects;
var
  ChildObjects: TChildObjects;
begin
  if FChildObjects=nil then
    begin
      ChildObjects:=TChildObjects.Create;
// Fill child objects here
      if InterlockedCompareExchangePointer(Pointer(FChildObjects),ChildObjects,nil) <> nil then
        ChildObjects.Free;
    end;
  result:=FChildObjects;
end;

This works fine, but how would I do something similar with Delphi strings? e.g. if I wanted to initialise a string "just in time" in a multi threaded envrionment? Or do I have to use a critical section? e.g:

function TSomeObject.GetSomeString: string;
var
  s :string;
begin
  if FSomeString='' then
    begin
      s:='Test';
//      InterlockedCompareExchangePointer(Pointer(FSomeString),s,nil);
    end;
  result:=FSomeString;
end;

CodePudding user response：

Strings are reference counted, so it is not enough to just swap the pointer, you have to be manage the reference count, too.

function InterlockedCompareExchangeString(var VTarget: String; const AValue, Compare: String): String; inline;
var
  P: PStrRec;
begin
  if AValue <> '' then begin
    P := PStrRec(PByte(AValue) - SizeOf(StrRec));
    AtomicIncrement(P.refCnt);
  end;
  Result := String(InterlockedCompareExchangePointer(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
  if (AValue <> '') and (Pointer(Result) <> Pointer(Compare)) then begin
    P := PStrRec(PByte(AValue) - SizeOf(StrRec));
    if AtomicDecrement(P.refCnt) = 0 then
      FreeMem(P);
  end;
end;

Unfortunately, the RTL doesn't expose functions to manipulate a string's reference count, only to query it (StringRefCount()), which is why you have to access and manipulate the string's inner StrRec header manually.