Nadpisywanie elementów listy (Delphi 10.4)

Potrzebuję sparsować JSON'a.
W tym celu utworzyłem sobie własną klasę TMJson która przetwarza JSON'a i tworzy listę obiektów typu TMJsonItem.
Jedno property z JSON'a to jeden obiekt na liście.

unit MyJson;

interface

uses sysutils, strutils, dialogs, system.json.Readers, json, system.json.Types, generics.Collections, system.Classes;

type
  TMJsonItem = class
  public
    tokenType: TJsonToken;
    propertyName: string;
    strValue: string;
    strPath: string;
    function asString: string;
    procedure AfterConstruction; override;
  end;

type
  TMJson = class
  private
    Ftext: string;
    procedure setText(const Value: string);
  public
    items: Tobjectlist<TMJsonItem>;
    function asString: string;
    property text: string read Ftext write setText;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

implementation

{ TMJson }

procedure TMJson.AfterConstruction;
begin
  inherited;
  items := Tobjectlist<TMJsonItem>.Create;
end;

function TMJson.asString: string;
var
  i: integer;
begin
  result := '';
  for i := 0 to self.items.Count - 1 do
    result := result + self.items[i].asString + #13;
end;

procedure TMJson.BeforeDestruction;
begin
  inherited;
  items.Free;
end;

procedure TMJson.setText(const Value: string);
var
  Sr: TStringReader;
  Reader: TJsonTextReader;
  lItem: TMJsonItem;
begin
  self.items.Clear;
  Ftext := Value;
  Sr := TStringReader.Create(Ftext);
  Reader := TJsonTextReader.Create(Sr);
  try
    while Reader.read do
    begin
      if Reader.tokenType = TJsonToken.propertyName then
      begin
        lItem := TMJsonItem.Create;
        lItem.propertyName := Reader.Value.ToString;
        if Reader.read then
        begin
          self.items.Add(lItem);
          lItem.tokenType := Reader.tokenType;
          lItem.strPath := Reader.Path;
          lItem.strValue := Reader.Value.ToString;
        end
        else
          lItem.Free;
      end;
    end;
  finally
    Reader.Free;
    Sr.Free;
  end;
end;

{ TMJsonItem }

procedure TMJsonItem.AfterConstruction;
begin
  inherited;
  self.propertyName := '';
  self.strPath := '';
  self.strValue := '';
end;

function TMJsonItem.asString: string;
begin
   result := 'Token type: '+inttostr(byte(self.tokenType)) + ' : {PropertyName: ' + self.propertyName + '} {strPath: ' + self.strPath + '} {strValue=' + self.strValue + '}';

end;

end.

Przykład użycia klasy:

const
  JsonTxt1 = //
    '{' + //
    '"numberOfElements":2291,' + //
    '"timestamp":"2023-09-23T08:19:14.511Z"' + //
    '}';
  JsonTxt2 = //
    '{' + //
    '"numberOfElementsX":2291,' + //
    '"timestamp":"2023-09-23T08:19:14.511Z"' + //
    '}';
  JsonTxt3 = //
    '{' + //
    '"numberOfElements":2291,' + //
    '"timestampXXXXXXXXXXXXXXXXX":"2023-09-23T08:19:14.511Z"' + //
    '}';

procedure TForm4.Button5Click(Sender: TObject);
var
  lJson: TMJson;
  tmpStr: string;
begin

  lJson := TMJson.create;
  tmpStr := 'JSON1 =============' + #13;
  lJson.Text := JsonTxt1;
  tmpStr := tmpStr + lJson.asString+#13;

  tmpStr := tmpStr + 'JSON2 =============' + #13;
  lJson.Text := JsonTxt2;
  tmpStr := tmpStr + lJson.asString + #13;

  tmpStr := tmpStr + 'JSON3 =============' + #13;
  lJson.Text := JsonTxt3;
  tmpStr := tmpStr + lJson.asString + #13;

  self.Memo1.Lines.Text := tmpStr;
  lJson.Free;
end;

Treść memo (rezultat działania programu)

JSON1 =============
Token type: 7 : {PropertyName: numberOfElements} {strPath: timestamplements} {strValue=2291}       <= zamiast  
                                                                                                          {strPath:numberOfElements}
                                                                                                      jest
                                                                                                          {strPath:timestamplements}
Token type: 9 : {PropertyName: timestamp} {strPath: timestamp} {strValue=2023-09-23T08:19:14.511Z}

JSON2 =============
Token type: 7 : {PropertyName: numberOfElementsX} {strPath: numberOfElementsX} {strValue=2291}
Token type: 9 : {PropertyName: timestamp} {strPath: timestamp} {strValue=2023-09-23T08:19:14.511Z}

JSON3 =============
Token type: 7 : {PropertyName: numberOfElements} {strPath: numberOfElements} {strValue=2291}
Token type: 9 : {PropertyName: timestampXXXXXXXXXXXXXXXXX} {strPath: timestampXXXXXXXXXXXXXXXXX} {strValue=2023-09-23T08:19:14.511Z}

Niby działa, ale dzieją się dziwne rzeczy.
Drugi i trzeci JSON jest przetwarzany prawidłowo
W pierwszym, treść pola strPath pierwszego elementu listy zostaje nadpisana treścią pola strPath drugiego elementu listy.
Może jestem ślepy i nie widzę jakiegoś elementarnego błędu :)

Spakowany projekt
4p.zip

a nie możęsz skorzystać z tego?
https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.JSON

@kAzek: : Dzięki za sprawdzenie. Dodatkowo sprawdziłem w D10.2 i jest OK. Czyli w D10.4 jest jakiś bug.
Zamiast listy obiektów Tobjectlist próbowałem użyć tablicy obiektów. Efekt ten sam, czyli błąd.
I co najdziwniejsze, zauważyłem że błąd pojawia się (i to nie zawsze) tylko wtedy kiedy nazwa pierwszego obiektu ma dokładnie 16 znaków, np. numberOfElements. Przy innej długości nazwy obiektu program działa prawidłowo

To postaw na tym Reader.Path brak pointa i debuguj (F7 aby wejśc do tej metody) .
W Delphi 11 wygląda ona tak:

function TJsonFiler.GetPath(AFromDepth: Integer): string;
var
  I: Integer;
begin
  if FCurrentPosition.ContainerType = TJsonContainerType.None then
    Result := ''
  else
  begin
    if AFromDepth < 0 then
      AFromDepth := 0;

    FPathBuilder.Length := 0;
    for I := AFromDepth to FStack.Count - 1 do
      FStack[I].WriteTo(FPathBuilder);

    if InsideContainer and (AFromDepth <= FStack.Count) then
      FCurrentPosition.WriteTo(FPathBuilder);

    Result := FPathBuilder.ToString(False);
  end;
end;

Tylko ostatnia instrukcja warunkowa na tym powinna sie wykonać poprzednie ani pętla nie.

@kAzek:
Tak wygląda pod D10.4. Kod jest identyczny. Trzeba by głębiej szukać

function TJsonFiler.GetPath(AFromDepth: Integer): string;
var
  I: Integer;
begin
  if FCurrentPosition.ContainerType = TJsonContainerType.None then
    Result := ''
  else
  begin
    if AFromDepth < 0 then
      AFromDepth := 0;

    FPathBuilder.Length := 0;
    for I := AFromDepth to FStack.Count - 1 do
      FStack[I].WriteTo(FPathBuilder);

    if InsideContainer and (AFromDepth <= FStack.Count) then
      FCurrentPosition.WriteTo(FPathBuilder);

    Result := FPathBuilder.ToString(False);
  end;
end;

Jest błąd z typem UnicodeString (string) - chyba jest to związane z RSP-20365: https://docwiki.embarcadero.com/RADStudio/Alexandria/en/List_of_publicly_reported_bugs_fixed_in_10.4.1. Jeżeli zdefiniujesz:

TMJsonItem = class
  public
    ...
    strPath: WideString; //lub AnsiString lub wymusisz długość zmiennej, np.: String[100]
    ...
  end;

lub (bez zmiany typu) przy odczycie rzutujesz jako WideString:

lItem.strPath := WideString(Reader.Path);

to będzie ok.

Sprawdzane w 10.4 Community.

@Paweł Dmitruk:

Jest błąd z typem UnicodeString (string) - chyba jest to związane z RSP-20365: https://docwiki.embarcadero.com/RADStudio/Alexandria/en/List_of_publicly_reported_bugs_fixed_in_10.4.1. >

przejrzałem serwis Embarcadero z raportami błędów..
Myślę że mój problem bardziej pasuje do tego:
TJSONObject.ToJSON outputs unicode as ascii and not (JSON) escapes: RSP-29121

grzegorz_so napisał(a):

TJSONObject.ToJSON outputs unicode as ascii and not (JSON) escapes: RSP-29121

Ale nigdzie nie korzystasz z funkcji ToJSON.