paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ allow defining classrefdefs for objcclasses. Note, this happens using the

Browse Source 
"class" keyword like for regular Object Pascal classes, not using the
    "objcclass" keyword. E.g.: NSObjectClass = class of NSObject;
  * modified tobjc18 to test this functionality

git-svn-id: branches/objc@13701 -
This commit is contained in:
Jonas Maebe 2009-09-12 16:46:41 +00:00
parent 8e81477fcf
commit f238f7c74b
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/ptype.pas
View File

@ -113,7 +113,8 @@ implementation
inc(ttypesym(srsym).refs);
{ we need a class type for classrefdef }
if (def.typ=classrefdef) and
not(is_class(ttypesym(srsym).typedef)) then
not(is_class(ttypesym(srsym).typedef)) and
not(is_objcclass(ttypesym(srsym).typedef)) then
MessagePos1(def.typesym.fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
end
else
@ -971,7 +972,8 @@ implementation
begin
consume(_OF);
single_type(hdef,(block_type=bt_type),false);
if is_class(hdef) then
if is_class(hdef) or
is_objcclass(hdef) then
def:=tclassrefdef.create(hdef)
else
if hdef.typ=forwarddef then
@ -980,7 +982,7 @@ implementation
current_module.checkforwarddefs.add(def);
end
else
Message1(type_e_class_type_expected,hdef.typename);
Message1(type_e_class_or_objcclass_type_expected,hdef.typename);
end
else
def:=object_dec(odt_class,name,genericdef,genericlist,nil);

12
tests/test/tobjc18.pp
View File

@ -14,8 +14,11 @@ type
procedure release; override;
class procedure testClassOverride; override;
end;
tmyoverrideclass = class of myoverride;
var
selfshouldbe: tmyoverrideclass;
selfshouldbetestinlinetypedefinition: class of myoverride2;
overridescalled: longint;
procedure MyOverride.release;
@ -29,6 +32,9 @@ end;
class procedure MyOverride.testClassOverride;
begin
if (self<>selfshouldbe) then
halt(20);
writeln('MyOverride.testClassOverride');
if (overridescalled<>1) then
halt(3);
@ -47,6 +53,9 @@ end;
class procedure MyOverride2.testClassOverride;
begin
if (self<>selfshouldbe) then
halt(21);
if (overridescalled<>0) then
halt(5);
writeln('MyOverride2.testClassOverride');
@ -59,14 +68,17 @@ var
begin
a:=MyOverride2.alloc;
a:=a.init;
selfshouldbe:=MyOverride2;
MyOverride2.testClassOverride;
if (overridescalled<>2) then
halt(6);
dec(overridescalled);
selfshouldbe:=MyOverride;
MyOverride.testClassOverride;
if (overridescalled<>2) then
halt(7);
overridescalled:=0;
selfshouldbe:=MyOverride2;
a.testClassOverride;
overridescalled:=1;
a.release;