mORMot Open Source

Firali

Member

Registered: 2015-02-09

Posts: 15

Possible bug in mORMot.TTypeInfo

Hello,

I have WordBool params in methods of my legacy DCOM interface. When I ported this interface to mormot, sometimes output param pointers is broken.

I have found strange behavior of mORMot.TTypeInfo.

var
  wb: WordBool;
  pt: PTypeInfo;
  ValueType: TServiceMethodValueType;
  SizeInStorage: Integer;
  RealSize: Integer;
begin
  pt := TypeInfo(WordBool);
  ValueType := TypeInfoToMethodValueType(pt);
  //ValueType = smvEnum
  SizeInStorage := pt^.EnumBaseType^.SizeInStorageAsEnum;
  //SizeInStorage = 4
  RealSize := SizeOf(wb);
  //RealSize = 2
  if SizeInStorage <> RealSize then
    raise Exception.Create('SizeInStorage <> RealSize');
end;

Must be different SizeInStorage and RealSize?

Thanks.

Firali

Member

Registered: 2015-02-09

Posts: 15

Re: Possible bug in mORMot.TTypeInfo

More details:

Shared.pas

unit Shared;

interface

const
  ROOT_NAME = 'root';
  PORT_NAME = '888';
  APPLICATION_NAME = 'TestMormot';

type
  ITest = interface(IInvokable)
    ['{35F48518-9622-448C-9670-18B77EBD9179}']
    procedure TestProc(out AWStr: WideString; out AWBool: WordBool);
  end;

implementation

uses mORMot;

initialization

TInterfaceFactory.RegisterInterfaces([TypeInfo(ITest)]);

end.

TestMormotServer.dpr

program TestMormotServer;

{$APPTYPE CONSOLE}

uses
  {$I SynDprUses.inc}
  SysUtils,
  Classes,
  SynCommons,
  mORMot,
  mORMotHttpServer,
  Shared in 'Shared.pas';

type
  TServiceTest = class(TInterfacedObject, ITest)
  public
    procedure TestProc(out AWStr: WideString; out AWBool: WordBool);
  end;

procedure TServiceTest.TestProc(out AWStr: WideString; out AWBool: WordBool);
begin
  AWStr := 'test';
  AWBool := False;
end;

var
  Model: TSQLModel;
  Server: TSQLRestServer;
  HTTPServer: TSQLHttpServer;
begin
  Model := TSQLModel.Create([], ROOT_NAME);
  try
    Server := TSQLRestServerFullMemory.Create(Model, 'test.json', false, True);
    try
      Server.ServiceDefine(TServiceTest, [ITest], sicShared);
      HTTPServer := TSQLHttpServer.Create(PORT_NAME, [Server], '+', useHttpApiRegisteringURI);
      try
        Writeln('server started');
        Writeln('press enter to exit');
        Readln;
      finally
        HTTPServer.Free;
      end;
    finally
      Server.Free;
    end;
  finally
    Model.Free;
  end;
end.

TestMormotClient.dpr

program TestMormotClient;

{$APPTYPE CONSOLE}

uses
{$I SynDprUses.inc}
  SysUtils,
  Classes,
  SynCommons,
  mORMot,
  mORMotHttpClient,
  Shared in 'Shared.pas';

var
  Model: TSQLModel;
  Client: TSQLRestClientURI;

procedure TestProc;
var
  Test: ITest;
  I: Integer;
  WStr: WideString;
  WBool: WordBool;
begin
  if Client.Services['Test'].Get(Test) then
    try
      Writeln('client started');
      for I := 0 to 1000 do
      begin
        Test.TestProc(WStr, WBool);
        if (WStr <> 'test') or WBool then 
          Writeln(Format('%s <> ''test''', [WStr])); //here raised accees violation
      end;
    finally
      Test := nil;
    end;
end;

begin
  Model := TSQLModel.Create([], ROOT_NAME);
  try
    Client := TSQLHttpClient.Create('localhost', PORT_NAME, Model);
    try
      Client.ServerTimeStampSynchronize;
      Client.SetUser('User', 'synopse');
      Client.ServiceDefine([ITest], sicShared);
      TestProc;
    finally
      Client.Free;
    end;
  finally
    Model.Free;
  end;
  Writeln('press enter to exit');
  ReadLn;
end.

Accees violation is raising when WStr(WideString) and WBool(WordBool) params are stack allocated (e.g. local variables).
if this params are declared as global variables then no exception happens.

IMHO, problem is in procedure InternalProcess (TInterfacedObjectFake.FakeCall's internal procedure).

procedure InternalProcess;
...
  case ValueType of
    smvBoolean, smvEnum, smvSet, smvCardinal:
      case SizeInStorage of
        1: PByte(V)^     := GetCardinal(Val);
        2: PWord(V)^     := GetCardinal(Val);
        4: PCardinal(V)^ := GetCardinal(Val);
      end;
...
end;

SizeInStorage is 4 and must be 2.

Thanks.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,235

Website

Re: Possible bug in mORMot.TTypeInfo

In fact, the MaxValue as returned by the Delphi RTTI was incorrect.
It indicates maxInt (2^32) for a WordBool.
Sounds clearly like a Delphi compiler bug. WordBool is a built-in type.

We have changed to use the OrdType RTTI information, which seems accurate.

Should be fixed by http://synopse.info/fossil/info/befb577145

Firali

Member

Registered: 2015-02-09

Posts: 15

Re: Possible bug in mORMot.TTypeInfo

Thanks ab.

In SynSelfTests.pas you added:

with PTypeInfo(TypeInfo(WordBool))^.EnumBaseType^ do
  Check(SizeInStorageAsEnum=2);

It would be better to change it like this:

with PTypeInfo(TypeInfo(WordBool))^.EnumBaseType^ do
  Check(SizeInStorageAsEnum=SizeOf(WordBool));

Regards.