Memoryleak oder fatale Exception bei TJSONObject.RemovePair

[t2000]

Hi Leute,

ja, der Titel beschreibt meine Optionen. Entweder habe ich ein Memoryleak oder es knallt, weil mein Objekt freigegeben wurde.

Ich kann jetzt nicht den kompletten Code hier reinstellen, aber folgendes zu den Funktionen.
Problem ist im eigenen REST Server. Entwickelt mit TMS XData. Aber das spielt keine Rolle.

Ich übergebe einer Funktion Parameter. DER Parameter ist ein TJSONObject. Da der Parameter durch XData freigegeben wird, mache ich mir ein Kopie.

ALso habe ich vor dem Aufruf diesen Code: (angedeutet, wahrscheinlich irrelevant)

Delphi-Quellcode:

var
  JSONDataClone: TJSONObject;
begin
  JSONDataClone := AsngParam.JSONData.Clone as TJSONObject;
  try
    ... mach was ...

  finally
    JSONDataClone.Free;
  end;

Hier jetzt meine Hilfsfunktionen, die den Fehler machen:

Ich möchte die übergebenen Parameter auf Vollständigkeit und korrekten Inhalt überprüfen.
Ggf. werden dort Feldnamen angepasst. Dass wird mit TJSONObject.AddPair bzw. TJSONObject.RemovePair gemacht. Deswegen auch der Clone.

Diese Routine heißt: TUtilJSON.CheckJSONEntity

Dort drin werden 2 andere Funktionen aufgerufen: TUtilJSON.CheckXDataRef und TUtilJSON.CheckIDValue

Ursprünglich hatte ich einfach "RemovePair" aufgerufen. Bei Programmende wurde dann aber ein MemoryLeak angezeigt. Nach sehr langem Suchen fand ich heraus, dass TJSONObject.RemovePair das zu löschende Paar zurückliefert und dies dann noch aus dem Speicher entfernt werden muss.
Das habe ich bei allen Vorkommen eingebaut.
An einer Stelle aber knallt es jetzt.

Interessant für die Untersuchung:

TUtilJSON.CheckIDValue funktioniert einwandfrei
TUtilJSON.CheckXDataRef funktioniert nicht

Fehler: Nachdem AJSONObject.RemovePair( AName).Free aufgerufen wurde (was auch funktioniert) ist die Abfrage von AJSONObject nicht mehr möglich.
Z.B. im Debugger mit STRG-F7 AJSONObject.toString auswerten verursacht sofort ein Absturz. Zugriff auf ein freigegebenes Object. Als ob das AJSONObject freigegeben wurde.
Ich habe aber nur das Pair freigegeben. Siehe Screenshot im Anhang.

Auch eine Änderung des Quelltextes in:

Delphi-Quellcode:

var
  LPair: TJSONPair;
begin
  LPair := Obj.RemovePair( Name);
  LPair.Free;

macht den gleichen Fehler.

Hier die Sourcen:

siehe Kommentar // <=== hier nach ist der Zugriff auf AJSONObject nicht mehr möglich, da gelöscht.


Sehe ich den Fehler einfach nicht?

Delphi-Quellcode:

class function TUtilJSON.CheckXDataRef( AJSONObject: TJSONObject; AName: String): TJSONObject;
begin
  // Wenn Entity und nicht Entity@ref
  if HasValue( AJSONObject, AName) and not HasValue( AJSONObject, AName + cXDataRef) then
    // dann neuer Eintrag mit ref anhängen
    AJSONObject.AddPair( AName + cXDataRef, AJSONObject.Values[ AName]);
  // falls noch vorhanden, Entity (ohne ref) löschen
  if HasValue( AJSONObject, AName) then
    AJSONObject.RemovePair( AName).Free;  //  <=== hier nach ist der Zugriff auf AJSONObject nicht mehr möglich, da gelöscht.
  // und zurückgeben
  Result := AJSONObject;
end;

class function TUtilJSON.CheckIDValue( AJSONObject: TJSONObject; AName: String): TJSONObject;
var
  LIDValue: String;
begin
  if HasValue( AJSONObject, AName) then begin
    // Eintrag löschen und mit bereinigtem ID-Value neu erzeugen
    LIDValue := AJSONObject.Values[ AName].AsType<String>;
    AJSONObject.RemovePair( AName).Free;
    // und mit bereinigtem ID-Value neu erzeugen
    AJSONObject.AddPair( AName, DirtyStringToGuidStr( LIDValue));
  end;
  Result := AJSONObject;
end;

class function TUtilJSON.CheckJSONEntity( AObj: TJSONObject; AForInsert: Boolean; AEntity, AIDField: String;
                                          AInsertArr, AFieldArr: TStringDynArray): TJSONObject;
var
  i: Integer;
  LFeldname: String;
begin
  // *** Falls Objekt im Feld liegt ***
  if TUtilJSON.HasObject( AObj, AEntity) then
    AObj := AObj.GetValue<TJSONObject>( AEntity);

  // *** ID-neu Prüfung ***
  AObj := TUtilJSON.CheckNewID( AObj, AIDField, AForInsert);

  if AForInsert then begin

    // *** alle Insert-Felder prüfen ***
    for i := Low( AInsertArr) to High( AInsertArr) do begin
      LFeldname := AInsertArr[i];
      // falls Referenz
      if copy( LFeldname, 1, 1) = '@' then begin
        delete( LFeldname, 1, 1);
        // Feldname
        AObj := TUtilJSON.CheckXDataRef( AObj, LFeldname);
        LFeldname := LFeldname + cXDataRef;
        // Value (ID bereinigen)
        AObj := TUtilJSON.CheckIDValue( AObj, LFeldname);
      end;
      // Prüfung
      if not TUtilJSON.HasValue( AObj, LFeldname) then
        raise Exception.Create('Feld ' + LFeldname + _nichtVorhanden);
    end;
  end else begin

    // *** alle Felder prüfen ***
    for i := Low( AFieldArr) to High( AFieldArr) do begin
      LFeldname := AFieldArr[i];
      // falls Referenz
      if copy( LFeldname, 1, 1) = '@' then begin
        delete( LFeldname, 1, 1);
        AObj := TUtilJSON.CheckXDataRef( AObj, LFeldname);
        LFeldname := LFeldname + cXDataRef;
      end;
      // Prüfung
      if not TUtilJSON.HasValue( AObj, LFeldname) then
        raise Exception.Create('Feld ' + LFeldname + _nichtVorhanden);
    end;
  end;

  Result := AObj;
end;