paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-25 13:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Test program for bug #9261.

Browse Source 
git-svn-id: trunk@8057 -
This commit is contained in:
daniel 2007-07-14 21:21:07 +00:00
parent 4a3870eb12
commit c0fbd64a42
2 changed files with 27 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8331,6 +8331,7 @@ tests/webtbs/tw9187.pp svneol=native#text/plain
tests/webtbs/tw9190.pp svneol=native#text/plain
tests/webtbs/tw9209.pp svneol=native#text/plain
tests/webtbs/tw9221.pp svneol=native#text/plain
tests/webtbs/tw9261.pp svneol=native#text/x-pascal
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

26
tests/webtbs/tw9261.pp Normal file
View File

@ -0,0 +1,26 @@
program tw9261;
{$mode objfpc}
type methodprocvar = function(): Boolean of object;
procedure test_procedure(a1, a2, a3, a4, a5, a6: integer; mv: methodprocvar);
begin
with Tmethod(mv) do
if (code<>pointer($11111111)) or (data<>pointer($22222222)) then
begin
writeln('test failed');
halt(1);
end;
end;
var a:methodprocvar;
begin
with Tmethod(a) do
begin
code:=pointer($11111111);
data:=pointer($22222222);
end;
test_procedure(1, 2, 3, 4, 5, 6, a);
end.