mORMot Open Source

douglasmmm

Member

Registered: 2015-04-24

Posts: 6

Memoryleak on JSONToObject

Using "ReportMemoryLeaksOnShutdown : = True ;" the project below results in memory leak :

An unexpected memory leak has occurred. The unexpected small block leaks are:
13-20 bytes : TSectionBlock x 22
21-28 bytes : ttrain x 11

What am I doing wrong ?

(DelphiXE6 VCL FormsApplication)

type
  TTrainRequestAnswer = (etTRAnswerNone=0, etTRAnswerAccept=1, etTRAnswerReject=2);

  TSectionBlock = class(TPersistent)
  private
    FSBName: string;
    FId: LongInt;
    procedure SetId(const Value: LongInt);
    procedure SetSBName(const Value: string);
  published
    property Id : LongInt read FId write SetId;
    property SBName : string read FSBName write SetSBName;
  end;

  TTrain = class(TPersistent)
  private
    FLocomotive: string;
    FTail: string;
    FId: LongInt;
    FPrefix: string;
    procedure SetId(const Value: LongInt);
    procedure SetLocomotive(const Value: string);
    procedure SetPrefix(const Value: string);
    procedure SetTail(const Value: string);
  published
    property Id : LongInt read FId write SetId;
    property Prefix : string read FPrefix write SetPrefix;
    property Locomotive : string read FLocomotive write SetLocomotive;
    property Tail : string read FTail write SetTail;
  end;

  TTrainRequest = class(TPersistentWithCustomCreate)
  private
    FToSB: TSectionBlock;
    FTrain: TTrain;
    FDataHoraRequest: string;
    FTryAgainHour: Integer;
    FRequestAnswer: TTrainRequestAnswer;
    FFromSB: TSectionBlock;
    FIdStretch: LongInt;
    FOSNumber: LongInt;
    FRejectReason2: string;
    FTryAgainMinute: Integer;
    FRejectReason1: string;
    procedure SetDataHoraRequest(const Value: string);
    procedure SetFromSB(const Value: TSectionBlock);
    procedure SetIdStretch(const Value: LongInt);
    procedure SetOSNumber(const Value: LongInt);
    procedure SetRejectReason1(const Value: string);
    procedure SetRejectReason2(const Value: string);
    procedure SetRequestAnswer(const Value: TTrainRequestAnswer);
    procedure SetToSB(const Value: TSectionBlock);
    procedure SetTrain(const Value: TTrain);
    procedure SetTryAgainHour(const Value: Integer);
    procedure SetTryAgainMinute(const Value: Integer);
  public
    constructor Create; override;
    destructor Destroy(); override;
  published
    property Train : TTrain read FTrain write SetTrain;
    property FromSB : TSectionBlock read FFromSB write SetFromSB;
    property ToSB : TSectionBlock read FToSB write SetToSB;
    property RequestAnswer : TTrainRequestAnswer read FRequestAnswer write SetRequestAnswer;
    property OSNumber : LongInt read FOSNumber write SetOSNumber;
    property DataHoraRequest : string read FDataHoraRequest write SetDataHoraRequest;
    property RejectReason1 : string read FRejectReason1 write SetRejectReason1;
    property RejectReason2 : string read FRejectReason2 write SetRejectReason2;
    property TryAgainHour : Integer read FTryAgainHour write SetTryAgainHour;
    property TryAgainMinute : Integer read FTryAgainMinute write SetTryAgainMinute;
    property IdStretch : LongInt read FIdStretch write SetIdStretch;
  end;

......
{ TTrainRequest }
constructor TTrainRequest.Create;
begin
  inherited;
  FTrain  := TTrain.Create;
  FToSB   := TSectionBlock.Create;
  FFromSB := TSectionBlock.Create;
end;

destructor TTrainRequest.Destroy;
begin
  FTrain.Free;
  FToSB.Free;
  FFromSB.Free;
  inherited;
end;

....

procedure TForm3.BitBtn2Click(Sender: TObject);
var t_trainrequest : TTrainRequest;
    i              : integer;
    JSon           : RawUTF8;
    JsonPtr        : PUTF8Char;
    IsValidJson    : Boolean;
    objLista,
    objLista1      : TObjectList;
begin
    TSQLLog.Family.Level :=  LOG_VERBOSE;

    objLista := TObjectList.Create();
    for I := 0 to 10 do begin
      t_trainrequest := TTrainRequest.Create;

      t_trainrequest.Train.Id := i;
      t_trainrequest.Train.Prefix := 'A'+IntToStr(i);
      t_trainrequest.Train.Locomotive := IntToStr(i * 111);
      t_trainrequest.Train.Tail := 'CAUDA';

      t_trainrequest.FromSB.Id := i;
      t_trainrequest.FromSB.SBName := 'SB'+IntToStr(i);

      t_trainrequest.ToSB.Id := 0;
      t_trainrequest.ToSB.SBName := 'SB'+IntToStr(i*2);

      t_trainrequest.DataHoraRequest := FormatDateTime('dd/mm/yyyy hh:mm:ss:zzz ', NOW);

      t_trainrequest.IdStretch := 1;

      objLista.Add(t_trainrequest);
    end;
    TJSONSerializer.RegisterClassForJSON([TTrainRequest, TTrain, TSectionBlock]);
    JSon :=  ObjectToJson(objLista, [woStoreClassName, woHumanReadable]);

    JsonPtr := @Json[1];
    Memo1.Lines.Add( JsonPtr );

    FreeAndNil(objLista);
  //Parse1
  //objLista1 := TTrainRequestSet( JSONToNewObject(JsonPtr, IsValidJson, [j2oIgnoreUnknownProperty]) );

  //Parse2
    objLista1 := TObjectList.Create;
    JSONToObject(objLista1, JsonPtr, IsValidJson, TTrainRequest, [j2oIgnoreUnknownProperty]);

    if IsValidJson then begin

      if objLista1.Count > 0 then begin
        Memo1.Lines.Add( 'OBJ -TrainRequestCollection');
        for I := 0 to objLista1.Count -1 do begin
          Memo1.Lines.Add(
            'ID MSG: '         + TTrainRequest(objLista1[i]).Train.Prefix +
            ' - FromSB: '      + TTrainRequest(objLista1[i]).FromSB.SBName +
            ' - ToSB: '        + TTrainRequest(objLista1[i]).ToSB.SBName +
            ' - OSNumber: '    + IntToStr(TTrainRequest(objLista1.Items[i]).OSNumber)
            );

        end;
        Memo1.Lines.Add( '-----------------------------------------------');
      end;
      Memo1.Lines.Add( '-----------------------------------------------');
      Memo1.Lines.Add( 'JSon OK');
    end else begin
      Memo1.Lines.Add( 'JSon Invalid');
    end;
  Freeandnil(objLista1);
end;

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,651

Website

Re: Memoryleak on JSONToObject

What does your Set*() setters do?

JsonToObject() would call the setters, AFAIR.

I would not use Setters in such classes, just plain write F* fields.

douglasmmm

Member

Registered: 2015-04-24

Posts: 6

Re: Memoryleak on JSONToObject

The Sets * () make the default Delphi : F * : = Value.
Redid using your cue (without the Setters ) and worked without leaks.

thank you