paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 19:29: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; function TPasParser.DoParseClassExternalHeader(AObjKind: TPasObjKind; out AExternalNameSpace, AExternalName: string): Boolean;
begin begin
Result:=False; Result:=False;
if ((aObjKind in [okObjcCategory,okObjcClass]) or if ((aObjKind in [okObjcCategory,okObjcClass,okObjcProtocol]) or
((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches))) ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)))
and CurTokenIsIdentifier('external') then and CurTokenIsIdentifier('external') then
begin 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 StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass);
Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String ); Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject'); 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 StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
Procedure StartVisibility(A : TPasMemberVisibility); Procedure StartVisibility(A : TPasMemberVisibility);
Procedure EndClass(AEnd : String = 'end'); Procedure EndClass(AEnd : String = 'end');
@ -170,6 +170,7 @@ type
procedure TestClassHelperOneMethod; procedure TestClassHelperOneMethod;
procedure TestInterfaceEmpty; procedure TestInterfaceEmpty;
procedure TestObjcProtocolEmpty; procedure TestObjcProtocolEmpty;
procedure TestObjcProtocolEmptyExternal;
procedure TestObjcProtocolOptional; procedure TestObjcProtocolOptional;
procedure TestObjcProtocolRequired; procedure TestObjcProtocolRequired;
procedure TestInterfaceDisp; procedure TestInterfaceDisp;
@ -322,7 +323,7 @@ begin
end; end;
procedure TTestClassType.StartInterface(AParent: String; UUID: String; procedure TTestClassType.StartInterface(AParent: String; UUID: String;
Disp: Boolean = False; UseObjcClass : Boolean = False); Disp: Boolean = False; UseObjcClass : Boolean = False; UseExternal : Boolean = False);
Var Var
S : String; S : String;
begin begin
@ -330,7 +331,9 @@ begin
if UseObjCClass then if UseObjCClass then
begin begin
FDecl.Add('{$modeswitch objectivec1}'); FDecl.Add('{$modeswitch objectivec1}');
S:='TMyClass = objcprotocol' S:='TMyClass = objcprotocol';
if UseExternal then
S:=S+' external name ''abc'' ';
end end
else if Disp then else if Disp then
S:='TMyClass = DispInterface' S:='TMyClass = DispInterface'
@ -1931,6 +1934,17 @@ begin
AssertNull('No UUID',TheClass.GUIDExpr); AssertNull('No UUID',TheClass.GUIDExpr);
end; 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; procedure TTestClassType.TestObjcProtocolOptional;
begin begin
StartInterface('','',False,True); StartInterface('','',False,True);