paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Protocol can also be external

Browse Source 
git-svn-id: trunk@47479 -
This commit is contained in:
michael 2020-11-20 13:03:07 +00:00
parent 9d4a1d1ac5
commit 319c00b832
2 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-passrc/src/pparser.pp
View File

@ -7470,7 +7470,7 @@ end;
function TPasParser.DoParseClassExternalHeader(AObjKind: TPasObjKind; out AExternalNameSpace, AExternalName: string): Boolean;
begin
Result:=False;
if ((aObjKind in [okObjcCategory,okObjcClass]) or
if ((aObjKind in [okObjcCategory,okObjcClass,okObjcProtocol]) or
((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)))
and CurTokenIsIdentifier('external') then
begin

20
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -33,7 +33,7 @@ type
Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass);
Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False; UseObjcClass : Boolean = False);
Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False; UseObjcClass : Boolean = False; UseExternal : Boolean = False);
Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
Procedure StartVisibility(A : TPasMemberVisibility);
Procedure EndClass(AEnd : String = 'end');
@ -170,6 +170,7 @@ type
procedure TestClassHelperOneMethod;
procedure TestInterfaceEmpty;
procedure TestObjcProtocolEmpty;
procedure TestObjcProtocolEmptyExternal;
procedure TestObjcProtocolOptional;
procedure TestObjcProtocolRequired;
procedure TestInterfaceDisp;
@ -322,7 +323,7 @@ begin
end;
procedure TTestClassType.StartInterface(AParent: String; UUID: String;
Disp: Boolean = False; UseObjcClass : Boolean = False);
Disp: Boolean = False; UseObjcClass : Boolean = False; UseExternal : Boolean = False);
Var
S : String;
begin
@ -330,7 +331,9 @@ begin
if UseObjCClass then
begin
FDecl.Add('{$modeswitch objectivec1}');
S:='TMyClass = objcprotocol'
S:='TMyClass = objcprotocol';
if UseExternal then
S:=S+' external name ''abc'' ';
end
else if Disp then
S:='TMyClass = DispInterface'
@ -1931,6 +1934,17 @@ begin
AssertNull('No UUID',TheClass.GUIDExpr);
end;
procedure TTestClassType.TestObjcProtocolEmptyExternal;
begin
StartInterface('','',False,True,true);
EndClass();
ParseClass;
AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
AssertTrue('Is objectivec',TheClass.IsObjCClass);
AssertEquals('No members',0,TheClass.Members.Count);
AssertNull('No UUID',TheClass.GUIDExpr);
end;
procedure TTestClassType.TestObjcProtocolOptional;
begin
StartInterface('','',False,True);