paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 23:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

tests: added program to test method compares

Browse Source 
git-svn-id: trunk@32580 -
This commit is contained in:
mattias 2011-10-01 12:23:51 +00:00
parent 8b557e425b
commit 82b1642a94
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5940,6 +5940,7 @@ test/codetoolstests/testcth2pas.pas svneol=native#text/pascal
test/codetoolstests/testctrangescan.pas svneol=native#text/plain
test/codetoolstests/testctxmlfixfragments.pas svneol=native#text/pascal
test/hello.ahk svneol=native#text/plain
test/lcltests/testmethodcompare.pas svneol=native#text/plain
test/lcltests/testpen.pas svneol=native#text/plain
test/lcltests/testpreferredsize.pas svneol=native#text/plain
test/lcltests/testunicode.pas svneol=native#text/plain

58
test/lcltests/testmethodcompare.pas Normal file
View File

@ -0,0 +1,58 @@
program testmethodcompare;
{$mode objfpc}{$H+}
uses
Classes, SysUtils;
var
M1, M2: TNotifyEvent;
procedure WriteReport;
begin
writeln('WriteReport',
' M1.Data=',PtrUInt(TMethod(M1).Data),
' M1.Code=',PtrUInt(TMethod(M1).Code),
' M2.Data=',PtrUInt(TMethod(M2).Data),
' M2.Code=',PtrUInt(TMethod(M2).Code),
' Assigned(M1)=',Assigned(M1),
' Assigned(M2)=',Assigned(M2),
' M1=nil=',(M1=nil),
' M2=nil=',(M2=nil),
' M1<>nil=',(M1<>nil),
' M2<>nil=',(M2<>nil),
' M1=M2=',(M1=M2),
' M1<>M2=',(M1<>M2),
''
);
end;
function Meth(Code, Data: Pointer): TNotifyEvent;
var
m: TMethod;
begin
m.Code:=Code;
m.Data:=Data;
Result:=TNotifyEvent(m);
end;
begin
M1:=nil;
M2:=nil;
WriteReport;
M1:=Meth(Pointer(1),Pointer(0));
WriteReport;
M2:=M1;
WriteReport;
M2:=nil;
M1:=Meth(Pointer(0),Pointer(1));
WriteReport;
M2:=M1;
WriteReport;
M2:=nil;
M1:=Meth(Pointer(1),Pointer(1));
WriteReport;
M2:=M1;
WriteReport;
end.