mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 10:19:28 +02:00
1633341906
same way as regular methods as far as overriding is concerned ("override"
is now allowed, and even required, to override them in a descendent class;
and similarly, "reintroduce" must be used if a category wants to replace
a method in a child class if that method was added by another category in
a parent class)
* print the name of owning objcclass/category of the original method in case
override/reintroduce is missing for objc methods, since this is no longer
always the parent class
git-svn-id: trunk@16035 -
125 lines
2.5 KiB
ObjectPascal
125 lines
2.5 KiB
ObjectPascal
{ %target=darwin }
|
|
{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
|
|
|
|
{ Written by Jonas Maebe in 2009, released into the public domain }
|
|
|
|
{$mode objfpc}
|
|
{$modeswitch objectivec1}
|
|
|
|
type
|
|
tbaseclass = objccategory(NSObject)
|
|
function tabaseproc(cp: longint): double; message 'tabaseproc:';
|
|
class function taclassproc: longint; message 'taclassproc';
|
|
end;
|
|
|
|
ta = objcclass(NSObject)
|
|
a: longint;
|
|
procedure taproc; message 'taproc';
|
|
function tabaseproc(cp: longint): double; message 'tabaseproc:'; override;
|
|
class function taclassproc: longint; message 'taclassproc'; override;
|
|
end;
|
|
|
|
ca = objccategory(ta)
|
|
procedure categorymethod; message 'categorymethod';
|
|
function tabaseproc(cp: longint): double; reintroduce;
|
|
end;
|
|
|
|
da = objccategory(ta)
|
|
procedure anothercategorymethod; message 'anothercategorymethod';
|
|
class function taclassproc: longint; reintroduce;
|
|
end;
|
|
|
|
class function tbaseclass.taclassproc: longint;
|
|
begin
|
|
writeln('tbaseclass.taclassproc');
|
|
result:=654321;
|
|
end;
|
|
|
|
function tbaseclass.tabaseproc(cp: longint): double;
|
|
begin
|
|
writeln('tbaseclass.tabaseproc');
|
|
if (cp<>98765) then
|
|
halt(12);
|
|
result:=1234.875;
|
|
end;
|
|
|
|
procedure ta.taproc;
|
|
begin
|
|
a:=0;
|
|
categorymethod;
|
|
if (a<>1) then
|
|
halt(1);
|
|
anothercategorymethod;
|
|
if (a<>2) then
|
|
halt(2);
|
|
if taclassproc<>123456 then
|
|
halt(5);
|
|
end;
|
|
|
|
function ta.tabaseproc(cp: longint): double;
|
|
begin
|
|
{ should be replaced/hidden by ca.tabaseproc }
|
|
halt(9);
|
|
result:=-1.0;
|
|
end;
|
|
|
|
class function ta.taclassproc: longint;
|
|
begin
|
|
{ should be replaced/hidden by da.taclassproc }
|
|
halt(3);
|
|
result:=0;
|
|
end;
|
|
|
|
procedure ca.categorymethod;
|
|
begin
|
|
a:=1;
|
|
if tabaseproc(555) <> 1.0 then
|
|
halt(16);
|
|
end;
|
|
|
|
function ca.tabaseproc(cp: longint): double;
|
|
begin
|
|
writeln('start ca.tabaseproc');
|
|
if (cp<>555) then
|
|
halt(13);
|
|
if inherited tabaseproc(98765)<>1234.875 then
|
|
halt(11);
|
|
writeln('end ca.tabaseproc');
|
|
result:=1.0;
|
|
end;
|
|
|
|
procedure da.anothercategorymethod;
|
|
begin
|
|
a:=2;
|
|
if tabaseproc(555)<>1.0 then
|
|
halt(15);
|
|
end;
|
|
|
|
class function da.taclassproc: longint;
|
|
begin
|
|
writeln('start da.taclassproc, calling inherited');
|
|
if inherited taclassproc<>654321 then
|
|
halt(4);
|
|
writeln('end da.taclassproc');
|
|
result:=123456;
|
|
end;
|
|
|
|
var
|
|
a: ta;
|
|
begin
|
|
a:=ta(ta.alloc).init;
|
|
a.taproc;
|
|
a.a:=0;
|
|
a.categorymethod;
|
|
if (a.a<>1) then
|
|
halt(6);
|
|
a.anothercategorymethod;
|
|
if (a.a<>2) then
|
|
halt(7);
|
|
if a.taclassproc<>123456 then
|
|
halt(8);
|
|
if (a.tabaseproc(555)<>1.0) then
|
|
halt(14);
|
|
a.release;
|
|
end.
|