fpc/tests/webtbs/tw14145.pp
tom_at_work 8a2696eb24 * limit the number of string message methods per class to 2^31 independent of architecture width: this avoids lots of compiler changes when allowing 2^63 (for 64 bit targets)
* 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 -
2010-10-29 13:26:50 +00:00

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.