Browse Source

* "Class of" allowed for fields

Michaël Van Canneyt 3 years ago
parent
commit
4820ec0746
2 changed files with 15 additions and 1 deletions
  1. 5 1
      packages/fcl-passrc/src/pparser.pp
  2. 10 0
      packages/fcl-passrc/tests/tcclasstype.pas

+ 5 - 1
packages/fcl-passrc/src/pparser.pp

@@ -1901,7 +1901,7 @@ Type
 
 
 Const
 Const
   // These types are allowed only when full type declarations
   // These types are allowed only when full type declarations
-  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkObjCClass,tkInterface,tkObjcProtocol,tkDispInterface,tkType];
+  FullTypeTokens = [tkGeneric,{tkSpecialize,tkClass,}tkObjCClass,tkInterface,tkObjcProtocol,tkDispInterface,tkType];
   // Parsing of these types already takes care of hints
   // Parsing of these types already takes care of hints
   NoHintTokens = [tkProcedure,tkFunction];
   NoHintTokens = [tkProcedure,tkFunction];
   InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol);
   InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol);
@@ -1951,6 +1951,10 @@ begin
           begin
           begin
           lClassType:=lctClass;
           lClassType:=lctClass;
           NextToken;
           NextToken;
+          if not (Full or (CurToken=tkOf)) then
+             ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
+           //  Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msClass];
+
           if CurTokenIsIdentifier('Helper') then
           if CurTokenIsIdentifier('Helper') then
             begin
             begin
             // class helper: atype end;
             // class helper: atype end;

+ 10 - 0
packages/fcl-passrc/tests/tcclasstype.pas

@@ -77,6 +77,7 @@ type
     procedure TestOneSpecializedClassInterface;
     procedure TestOneSpecializedClassInterface;
     Procedure TestOneField;
     Procedure TestOneField;
     Procedure TestOneFieldComment;
     Procedure TestOneFieldComment;
+    Procedure TestOneClassOfField;
     procedure TestOneFieldStatic;
     procedure TestOneFieldStatic;
     Procedure TestOneHelperField;
     Procedure TestOneHelperField;
     Procedure TestOneVarField;
     Procedure TestOneVarField;
@@ -675,6 +676,15 @@ begin
   AssertVisibility;
   AssertVisibility;
 end;
 end;
 
 
+procedure TTestClassType.TestOneClassOfField;
+begin
+  AddMember('a : class of MyClass');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('a');
+  AssertVisibility;
+end;
+
 procedure TTestClassType.TestOneVarField;
 procedure TTestClassType.TestOneVarField;
 begin
 begin
   StartVisibility(visPublished);
   StartVisibility(visPublished);