* Parse Reference To Procedure|function

git-svn-id: trunk@35829 -

packages/fcl-passrc/src/pastree.pp

@@ -103,7 +103,7 @@ type
 
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
                         ccOldFPCCall,ccSafeCall,ccSysCall);
-  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -654,8 +654,10 @@ type
   private
     function GetIsNested: Boolean;
     function GetIsOfObject: Boolean;
+    function GetIsReference: Boolean;
     procedure SetIsNested(const AValue: Boolean);
     procedure SetIsOfObject(const AValue: Boolean);
+    procedure SetIsReference(AValue: Boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -672,6 +674,7 @@ type
     Modifiers: TProcTypeModifiers;
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsNested : Boolean read GetIsNested write SetIsNested;
+    property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
   end;
 
   { TPasResultElement }
@@ -1420,7 +1423,7 @@ const
   cCallingConventions : Array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs');
+      ('of Object', 'is nested','static','varargs','reference to');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
@@ -2468,6 +2471,11 @@ begin
   Result:=ptmOfObject in Modifiers;
 end;
 
+function TPasProcedureType.GetIsReference: Boolean;
+begin
+  Result:=ptmReferenceTo in Modifiers;
+end;
+
 procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
 begin
   if AValue then
@@ -2484,6 +2492,14 @@ begin
     Exclude(Modifiers,ptmOfObject);
 end;
 
+procedure TPasProcedureType.SetIsReference(AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmReferenceTo)
+  else
+    Exclude(Modifiers,ptmReferenceTo);
+end;
+
 constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);

packages/fcl-passrc/src/pparser.pp

@@ -336,6 +336,7 @@ type
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
     function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs: TFPList = nil): TPasType;
+    function ParseReferenceToProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasProcedureType;
     function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
     function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
     function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
@@ -1331,7 +1332,16 @@ begin
           Result:=ParseAliasType(Parent,NamePos,TypeName);
         end;
       // Always allowed
-      tkIdentifier: Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
+      tkIdentifier:
+        begin
+        if CurTokenIsIdentifier('reference') then
+          begin
+          CH:=False;
+          Result:=ParseReferencetoProcedureType(Parent,NamePos,TypeName)
+          end
+        else
+          Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
+        end;
       tkCaret: Result:=ParsePointerType(Parent,NamePos,TypeName);
       tkFile: Result:=ParseFileType(Parent,NamePos,TypeName);
       tkArray: Result:=ParseArrayType(Parent,NamePos,TypeName,pm);
@@ -1371,6 +1381,22 @@ begin
   end;
 end;
 
+function TPasParser.ParseReferenceToProcedureType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String
+  ): TPasProcedureType;
+begin
+  if not CurTokenIsIdentifier('reference') then
+    ParseExcTokenError('reference');
+  ExpectToken(tkTo);
+  NextToken;
+  Case CurToken of
+   tkprocedure : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
+   tkfunction : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
+  else
+    ParseExcTokenError('procedure or function');
+  end;
+  Result.IsReferenceTo:=True;
+end;
+
 function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType;
 begin
   NextToken;

packages/fcl-passrc/tests/tctypeparser.pas

@@ -410,6 +410,7 @@ type
     Procedure TestProcedureOutOpenArray;
     Procedure TestProcedureVarOpenArray;
     Procedure TestProcedureArrayOfConst;
+    Procedure TestProcedureReference;
     Procedure TestProcedureOfObject;
     Procedure TestProcedureOfObjectOneArg;
     Procedure TestProcedureIsNested;
@@ -1086,6 +1087,13 @@ begin
   TestCallingConventions(@DoTestProcedureArrayOfConst);
 end;
 
+procedure TTestProcedureTypeParser.TestProcedureReference;
+begin
+  ParseType('reference to procedure',ccDefault,TPasProcedureType);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is Reference to',True,Proc.IsReferenceTo);
+end;
+
 Procedure TTestProcedureTypeParser.TestProcedureOfObject;
 begin
   TestCallingConventions(@DoTestProcedureOfObject);