mORMot Open Source

Sha

Member

From: Russia

Registered: 2012-01-07

Posts: 34

Website

2 bugs in TTextWriter.RegisterCustomJSONSerializer

To reproduce this bug register/unregister/register custom serializer.
You can see that default serializer is used. Not the last registered.

Another bug is that length of JSONCustomParsers will increase
for each registration of previously unregistered serializer.

Here is correct code.

class procedure TTextWriter.RegisterCustomJSONSerializer(aTypeInfo: pointer;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var i: integer;
    DynArrayTI, RecordTI: pointer;
begin
  i := -MaxInt; //Sha: //i := -2;
  RecordTI := nil;
  DynArrayTI := nil;
  if aTypeInfo<>nil then
  case PDynArrayTypeInfo(aTypeInfo)^.kind of
  tkDynArray: begin
    DynArrayTI := aTypeInfo;
    RecordTI := TypeInfoToRecordInfo(aTypeInfo);
    i := JSONCustomParsersDynArrayIndex(aTypeInfo);
    if (i<0) and (RecordTI<>nil) then
      i := JSONCustomParsersRecordIndex(RecordTI);
    end;
  tkRecord: begin
    i := JSONCustomParsersRecordIndex(aTypeInfo);
    RecordTI := aTypeInfo;
    DynArrayTI := nil;
  end;
  end;
  if i=-MaxInt then //Sha: //if i=-2 then
    raise ESynException.Create('Invalid TTextWriter.RegisterCustomJSONSerializer call');
  if i<0 then
    if Assigned(aWriter) or Assigned(aReader) then
    if i<-1 then i := -(i+2) else //Sha: line added
    begin
      i := length(JSONCustomParsers);
      SetLength(JSONCustomParsers,i+1);
    end else
    exit;
  with JSONCustomParsers[i] do begin
    DynArrayTypeInfo := DynArrayTI;
    RecordTypeInfo := RecordTI;
    Writer := aWriter;
    Reader := aReader;
  end;
end;

//Sha
function JSONCustomParsersDynArrayIndex(aTypeInfo: pointer): integer; {$ifdef HASINLINE}inline;{$endif}
begin
  result := length(JSONCustomParsers) - 1;
  while result >= 0 do begin
    with JSONCustomParsers[result] do if DynArrayTypeInfo=aTypeInfo then begin
      if not Assigned(Reader) and not Assigned(Writer) then result := -(result+2);
      exit;
    end;
    dec(result);
  end;
end;

//Sha
function JSONCustomParsersRecordIndex(aTypeInfo: pointer): integer; {$ifdef HASINLINE}inline;{$endif}
begin
  result := length(JSONCustomParsers) - 1;
  while result >= 0 do begin
    with JSONCustomParsers[result] do if RecordTypeInfo=aTypeInfo then begin
      if not Assigned(Reader) and not Assigned(Writer) then result := -(result+2);
      exit;
    end;
    dec(result);
  end;
end;

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,660

Website

Re: 2 bugs in TTextWriter.RegisterCustomJSONSerializer

As such, this code won't work in TTextWriter.AddDynArrayJSON(), TTextWriter.AddRecordJSON() and JSONCustomParsersRecordIndex().

I've implement another pattern to fix TTextWriter.RegisterCustomJSONSerializer() method when unregistering.
See http://synopse.info/fossil/info/de61986540

Hope it works as expected.

Sha

Member

From: Russia

Registered: 2012-01-07

Posts: 34

Website

Re: 2 bugs in TTextWriter.RegisterCustomJSONSerializer

Thanks. It works.