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;

[jaenicke]

Ich habe mir das noch nicht genau angeschaut. Zuerst einmal die Frage:
FastMM zeigt ja auch an, wo das Element vorher freigegeben wurde. Bringt dich das nicht schon weiter?

[Uwe Raabe]

Solltest du an dieser Stelle nicht einen Clone des TJSONValue verwenden?

Delphi-Quellcode:

  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]);

Immerhin wird das Pair aus dem der Value stammt ja direkt danach freigegeben:

Delphi-Quellcode:

  if HasValue( AJSONObject, AName) then
    AJSONObject.RemovePair( AName).Free; // <=== hier nach ist der Zugriff auf AJSONObject nicht mehr möglich, da gelöscht.

Mir stellt sich überhaupt die Frage: Wieso änderst du nicht einfach den Namen des Pairs von AName auf AName + cXDataRef?

Bei CheckIDValue verwendest du einen string als Speicher für den Value-Inhalt, deswegen gibt es dort kein Problem.

[t2000]

... Stunden später ...

ne, die entscheidende Routine extrahiert und den Fehler gefunden. JSON ist schon sehr tückisch.

Der Fehler liegt hier: AJSONObject.AddPair( AName + cXDataRef, AJSONObject.Values[ AName]); Dort wird nicht der String des alten Feldes dem neuen Feld zugewiesen, sondern eine Referenz auf den Wert des alten Wertes. (!!)
Indem ich "AJSONObject.Values[ AName]" einsetze, setze ich nur einen Link.

Richtig wäre es:

Delphi-Quellcode:

var
  tempStr: String;
begin
  // vor dem Löschen
  tempStr := AJSONObject.Values[ AName].Value;
  AJSONObject.AddPair( AName + cXDataRef, tempStr);

Nun ist alles sauber. Kein Fehler und auch kein Memoryleak.

Also: Bei TJSONObject.RemovePair IMMER das gelöschte Pair freigeben! Aber sicher gehen, dass keine Referenz mehr auf dieses Pair existiert.

Danke. Uwe hat es erkannt.

[t2000]

Zitat von Uwe Raabe:

Mir stellt sich überhaupt die Frage: Wieso änderst du nicht einfach den Namen des Pairs von AName auf AName + cXDataRef?

So weit ich weiß, geht das nicht, oder?

Namensänderung in (Standard-)Delphi nicht möglich.

[Uwe Raabe]

Klar geht das:

Delphi-Quellcode:

procedure Main;
begin
  var obj := TJSONObject.Create;
  try
    obj.AddPair('MyName', 'Uwe');
    Writeln(obj.ToJSON);
    var pair := obj.Pairs[0];
    pair.JsonString := TJSONString.Create('MyFullName');
    pair.JsonValue := TJSONString.Create('Uwe Raabe');
    Writeln(obj.ToJSON);
  finally
    obj.Free;
  end;
end;

[t2000]

Das werde ich ausprobieren.
Ich hatte die Information von 2 unterschiedlichen Stellen. (im Internet; und fragt bitte nicht wo; ich weiß es nicht mehr)

Aktuell liefert ChatGPT o3-mini-high dies hier:
Screenshot 2025-03-09 153102.jpg