mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 07:19:29 +01:00
8a2696eb24
* fix string message method handling data structures to reflect this change, and also use the correct types for accessing them (longint vs. dword) * output proper alignment code for string message method data structures to avoid issues on big-endian 64 bit architectures or architectures requiring proper alignment * same for integer message methods; also, like string message method data structures, do not use packed records for them when accessing * extend the test case (tw14145) do do multiple message dispatches, both integer and string ones, to complete successfully git-svn-id: trunk@16254 -
81 lines
1.2 KiB
ObjectPascal
81 lines
1.2 KiB
ObjectPascal
{$mode objfpc}
|
|
program testm;
|
|
|
|
uses
|
|
Strings;
|
|
|
|
Type
|
|
TMyObject = Class(TObject)
|
|
public
|
|
Procedure MyMessage(Var Msg); message 'somestring';
|
|
Procedure MyMessage2(Var Msg); message 'otherstring';
|
|
|
|
procedure Message2(var msg); message 1;
|
|
procedure Message3(var msg); message 10000;
|
|
end;
|
|
|
|
TMyMessage = record
|
|
MsgStr : ShortString;
|
|
Data : pointer;
|
|
end;
|
|
|
|
TMyIntMessage = record
|
|
Id: integer;
|
|
Data : pointer;
|
|
end;
|
|
|
|
Var
|
|
MyExitCode : Longint;
|
|
|
|
Procedure TMyObject.MyMessage(Var Msg);
|
|
|
|
begin
|
|
Writeln('Got Message');
|
|
dec(MyExitCode);
|
|
end;
|
|
|
|
Procedure TMyObject.MyMessage2(Var Msg);
|
|
|
|
begin
|
|
Writeln('Got Message');
|
|
dec(MyExitCode);
|
|
end;
|
|
|
|
procedure TMyObject.Message2(var msg);
|
|
begin
|
|
Writeln('Got Message 2');
|
|
dec(MyExitCode)
|
|
end;
|
|
|
|
procedure TMyObject.Message3(var msg);
|
|
begin
|
|
Writeln('Got message 3');
|
|
dec(MyExitCode);
|
|
end;
|
|
|
|
var
|
|
msg : TMyMessage;
|
|
msgi : TMyIntMessage;
|
|
M : TMyObject;
|
|
s : shortstring;
|
|
begin
|
|
MyExitCode:=4;
|
|
M:=TMyObject.Create;
|
|
try
|
|
msg.MsgStr:='somestring';
|
|
M.DispatchStr(Msg);
|
|
|
|
msg.MsgStr:='otherstring';
|
|
M.DispatchStr(msg);
|
|
|
|
msgi.id := 10000;
|
|
M.Dispatch(msgi);
|
|
|
|
msgi.id := 1;
|
|
M.Dispatch(msgi);
|
|
finally
|
|
M.Free;
|
|
end;
|
|
halt(MyExitCode);
|
|
end.
|