Be careful changing the DataContext of a TRemotable
Posted by jpluimers on 2020/11/11
Still not sure why the RTL code is like this:
procedure TRemotable.SetDataContext(Value: TDataContext); begin if (RemotableDataContext <> nil) and (RemotableDataContext = Self.DataContext) then begin TDataContext(RemotableDataContext).RemoveObjectToDestroy(Self); end; FDataContext := Value; end;
It means that if you ever have to change the DataContext property from the default global RemotableDataContext, it will be removed, but not added to the new DataContext.
When you assign it nil (so you can dump it to JSON, which often is easier to read than XML), and back to the old value, this results in a memory leak:
function TNotificationKeyPortTypeImplementation.prematchChanged(const prematchChangedRequest: prematchChangedRequest): prematchChangedResponse; var DataContext: TDataContext; begin // ... DataContext := prematchChangedRequest.DataContext; try prematchChangedRequest.DataContext := nil; // otherwise the JSON serializer will stackoverflow because DataContext points back to the TRemotable instance. Result := Format('prematchChanged: prematchChangedRequest=%s', [TJson.ObjectToJsonString(prematchChangedRequest)]); finally // `prematchChangedRequest.DataContext := nil` removed `prematchChangedRequest` from `DataContext.FObjsToDestroy` DataContext.AddObjectToDestroy(prematchChangedRequest); prematchChangedRequest.DataContext := DataContext; // does not add `prematchChangedRequest` to `DataContext.FObjsToDestroy` end; end;
or when you are outside an incoming SOAP call where DataContext might not be assigned at all:
function ToJSON(const Value: TRemotable): string; var DataContext: TDataContext; RemotableDataContext: Pointer; begin if Assigned(Value) then begin DataContext := Value.DataContext; try Value.DataContext := nil; // otherwise the JSON serializer will stackoverflow because DataContext points back to the TRemotable instance. Result := TJson.ObjectToJsonString(Value); Result := TRegExSanitiser.ReplaceSecretInText(Result, [rttJSON]); finally // `Value.DataContext := nil` removed `Value` from `DataContext.FObjsToDestroy` if Assigned(DataContext) then begin RemotableDataContext := GetRemotableDataContext(); if Assigned(RemotableDataContext) and (RemotableDataContext = DataContext) then DataContext.AddObjectToDestroy(Value); Value.DataContext := DataContext; // does not add `Value` to `DataContext.FObjsToDestroy` end; end; end else Result := ''; end;
–jeroen
The Wiert Corner - irregular stream of stuff 
Leave a comment