You are not logged in.
In unit mORMot:
procedure TCQRSService.InternalCqrsSetResult(Error: TCQRSResult; var Result: TCQRSResult);
procedure TJSONSerializer.WriteObject(Value: TObject; Options: TTextWriterWriteObjectOptions);
procedure WriteProp(P: PPropInfo);
Kind := P^.PropType^.Kind;
case Kind of <<<< Kind is 28 (TSQLRecordTableDeletedClass)
===== Raises exception External: SIGSEGV
tkInt64{$ifdef FPC}, tkQWord{$endif}: begin
This happends when I call the function ORMGetNextAggregate when there is no data left and when
it sets the cqrsStatus via InternalCqrsSetResult.
The code sequence in my testapp looks like:
ticketServer.DBServer.Services.Resolve(IDomTicketCommand,IDTC);
theTicket := TDTOTicket.Create;
theTicket.ticketNo := 199;
cqrsStatus := IDTC.Add(theTicket);
IDTC.Commit;
try
cqrsStatus := IDTC.SelectAll;
if cqrsStatus in [cqrsSuccess, cqrsSuccessWithMoreData] then begin
while cqrsStatus in [cqrsSuccessWithMoreData, cqrsSuccess] do
begin
cqrsStatus := IDTC.getNext(theTicket);
What can I do here? Is it a system bug or am I the bug?
Last edited by larand54 (2019-05-05 11:43:29)
Delphi-11, WIN10
Offline
As simple as this:
TDTOTicket = class(TSQLRecord)
protected
fticketNo: integer; // TTicketNo
fdescription: RawUTF8; // TDescription
fdateCreated: TDateTime; // TDateTime
fdateOpened: TDateTime; // TDateTime
fdateSolved: TDateTime; // TDateTime
published
/// maps TTicket.ticketNo (TTicketNo)
property ticketNo: integer read fticketNo write fticketNo;
/// maps TTicket.description (TDescription)
property description: RawUTF8 read fdescription write fdescription;
/// maps TTicket.dateCreated
property dateCreated: TDateTime read fdateCreated write fdateCreated;
/// maps TTicket.dateOpened
property dateOpened: TDateTime read fdateOpened write fdateOpened;
/// maps TTicket.dateSolved
property dateSolved: TDateTime read fdateSolved write fdateSolved;
end;
The server is running in the same program as the client, to simplify testing.
The server looks like this:
constructor TTicketServer.create(const aObserver: IErrorObserver);
begin
DBConnect(rseZeosMySQL, 'zdbc:mysql://localhost:3306', 'test_mormot', 'root', 'gT7Wqa96S');
Model := CreateTicketModel;
VirtualTableExternalRegister(Model, [TTicket], Props);
DBServer := TSQLRestServerDB.Create(Model, true); // true -> Authorization used
try
DBServer.CreateMissingTables;
DBServer.ServiceContainer.InjectResolver([TInfraRepoTicketFactory.create(DBServer)], false);
DBServer.ServiceDefine(TInfraRepoTicket, [IDomTicketCommand], sicClientDriven);
httpServer := TSQLHttpServer.Create(PORT_NAME, [DBServer], '+', HTTP_DEFAULT_MODE);
try
httpServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
CodeHalted := true;
while CodeHalted do begin
Application.ProcessMessages;
sleep(1000);
end;
finally
httpServer.Free;
end;
finally
DBServer.Free;
end;
end;
TTicket is defined as:
TTicket = class(TSQLRecord)
private
fTicketNo: TTicketNo;
fDescription : TDescription;
fDateCreated: TDateTime;
fDateModified: TDateTime;
fDateOpened: TDateTime;
fDateSolved: TDateTime;
fCategory: TTicketCategory;
function getTicketID: TTicketID;
published
property ticketNo: TTicketNo read fTicketNo write fTicketNo;
property description: TDescription read fDescription write fDescription;
property dateCreated: TDateTime read fDateCreated write fDateCreated;
property dateOpened: TDateTime read fDateOpened write fDateOpened;
property dateSolved: TDateTime read fDateSolved write fDateSolved;
end;
Last edited by larand54 (2019-04-23 20:56:08)
Delphi-11, WIN10
Offline
Still not solved, I've no idea how to proceed.. Help needed.
Here it crashes: https://pastebin.com/0fxPPnEB
Last edited by larand54 (2019-05-01 10:14:54)
Delphi-11, WIN10
Offline
Ok,
I'm using a Lazarus installation, installed by using fpcupDeluxe choosing the trunk version and got fpc-3.3.1 and Lazarus-2.1.0. I included mORMot in the installation.
I also installed ZEOS (7.2.4-stable build at 2018-03-25 11:08:27).
I also installed the latest WAMP-server to get MySQL together with a convenient environment.
To test that I could use MySQL and ZEOS in future programming I created a simple simple application to test all this.
First I had both server and client in the same application but later I splited it into one client and one server application but the result is the same.
It has no problem adding new records in the database table and it can also read them back without any problem. But,
if I want to read them all by using the function "ORMGetNextAggregate" I get all records delivered but at the end, when this function tries to read beyond the last record,
it gets the cqrsStatuscode=cqrsSuccessWithMoreData. So far so good but then it tries to create the JSON-message to be sent back to the client it goes wrong.
It looks like it doesn't know when to stop the process so it goes to far and get garbage data.
The "PPropInfo^PropType^.Kind the point outside it's buffer and returns a value to the TTextKind variable Kind that is outside its definition.
Maybe it can be in the function listed below:
function InternalClassProp(ClassType: TClass): PClassProp;
{$ifdef FPC}
begin
with GetFPCTypeData(pointer(ClassType.ClassInfo))^ do
result := AlignToPtr(@UnitName[ord(UnitName[0])+1]);
{$else}
{$ifdef PUREPASCAL}
var PTI: PTypeInfo;
begin // code is a bit abstract, but compiles very well
PTI := PPointer(PtrInt(ClassType)+vmtTypeInfo)^;
if PTI<>nil then // avoid GPF if no RTTI available for this class
with PTI^, PClassType(@Name[ord(Name[0])+1])^ do
result := PClassProp(@UnitName[ord(UnitName[0])+1]) else
result := nil;
{$else}
asm // this code is the fastest possible
mov eax, [eax + vmtTypeInfo]
test eax, eax
jz @z // avoid GPF if no RTTI available for this class
movzx edx, byte ptr[eax].TTypeInfo.Name
lea eax, [eax + edx].TTypeInfo.Name[1]
movzx edx, byte ptr[eax].TClassType.UnitName
lea eax, [eax + edx].TClassType.UnitName[1].TClassProp
@z:
{$endif PUREPASCAL}
{$endif FPC}
end;
The delphi version returns NIL when it don't find the classtype but the fpc version just returns the result from: AlignToPtr(@UnitName[ord(UnitName[0])+1]);
I failed to check what this function ( or isn't it a function?) returns.
I'm totally stuck here and if I don't solve this soon, there is nothing more than to leave this project I'm afraid.
I have struggled for days trying to solve this but now I understand I can't get any further without help.
Last edited by larand54 (2019-05-02 09:43:56)
Delphi-11, WIN10
Offline
It is difficult to find out what your problem is.
ORMGetNextAggregate() should not deserialize void items...
https://en.wikipedia.org/wiki/Minimal_working_example ?
Please don't put big extend of code in the forum - especially of the framework code - see https://synopse.info/forum/misc.php?action=rules
Offline
An immedite answer here, I'm just try to debug the "TestSQL3" app. It fails with access violation and it seems to be in the same code part as in my app.
What's common is that when a call result in a cqrsStatus <> cqrsSuccess and it tries to create the JSON formatted response it crasches.
It is very hard for me to understand what's really happends here and I've been trying to find out by debugging. So far I have not find it.
It should be simple though to reproduce it by running TestSQL3 with the same FPC-compiler 3.3.1 as I use.
The first test that fails is this:
Check(service.StartEmailValidation(template,'toto','toto@toto .com')=cqrsDDDValidationFailed);
This test is made to give an error status and that causes the crasch.
Is it enough to put the code into paste.bin, all code in one file or...?
Delphi-11, WIN10
Offline
I am not able to reproduce it here.
https://gist.github.com/synopse/975ec9f … 15ec8a835e
What is your FPC revision?
Verbose: Free Pascal Compiler version 3.3.1-r40491 [2019/03/25] for x86_64
There may be a transient bug in the trunk...
Try to follow https://synopse.info/files/html/Synopse … l#TITL_203 instructions.
Offline
I got the same revision.. very strange when you can't reproduce it. Can it be something with Lazarus?
Free Pascal Compiler version 3.3.1-r41736 [2019/03/19] for x86_64
Delphi-11, WIN10
Offline
It is not the same revision: we use r40491 and you have a more recent one, r41736.
Try to follow https://synopse.info/files/html/Synopse … l#TITL_203 instructions.
Offline
I have now installed a new version of fpc and lazarus following your instructions.
And now the testSQLite3 and my testapp works as it should.
Easy solved but hard to find
Delphi-11, WIN10
Offline