codetools: sealed and abstract classes

git-svn-id: trunk@22300 -

components/codetools/codetree.pas

@@ -85,23 +85,24 @@ const
   ctnObject             = 32;
   ctnObjCClass          = 33;
   ctnObjCProtocol       = 34;
-  ctnClassInheritance   = 35;
-  ctnClassGUID          = 36;
-  ctnClassTypePrivate   = 37;
-  ctnClassTypeProtected = 38;
-  ctnClassTypePublic    = 39;
-  ctnClassTypePublished = 40;
-  ctnClassVarPrivate    = 41;
-  ctnClassVarProtected  = 42;
-  ctnClassVarPublic     = 43;
-  ctnClassVarPublished  = 44;
-  ctnClassPrivate       = 45;
-  ctnClassProtected     = 46;
-  ctnClassPublic        = 47;
-  ctnClassPublished     = 48;
-
-  ctnProperty           = 50;
-  ctnMethodMap          = 51;
+  ctnClassAbstract      = 35;
+  ctnClassSealed        = 36;
+  ctnClassInheritance   = 37;
+  ctnClassGUID          = 38;
+  ctnClassTypePrivate   = 39;
+  ctnClassTypeProtected = 40;
+  ctnClassTypePublic    = 41;
+  ctnClassTypePublished = 42;
+  ctnClassVarPrivate    = 43;
+  ctnClassVarProtected  = 44;
+  ctnClassVarPublic     = 45;
+  ctnClassVarPublished  = 46;
+  ctnClassPrivate       = 47;
+  ctnClassProtected     = 48;
+  ctnClassPublic        = 49;
+  ctnClassPublished     = 50;
+  ctnProperty           = 51;
+  ctnMethodMap          = 52;
   
   ctnProcedure          = 60;  // childs: ctnProcedureHead, sections, ctnBeginBlock/ctnAsmBlock
   ctnProcedureHead      = 61;  // childs: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnResultType
@@ -143,9 +144,6 @@ const
   ctnOnIdentifier       =113;// e.g. on E: Exception
   ctnOnStatement        =114;
 
-  ctnClassAbstract      =120;
-  ctnClassSealed        =121;
-
   // combined values
   AllSourceTypes =
      [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];

components/codetools/finddeclarationtool.pas

@@ -4635,6 +4635,7 @@ var
   AncestorNode, ClassIdentNode: TCodeTreeNode;
   SearchBaseClass: boolean;
   AncestorContext: TFindContext;
+  InheritanceNode: TCodeTreeNode;
 begin
   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
   if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses))
@@ -4647,11 +4648,11 @@ begin
 
   // search the ancestor name
   BuildSubTreeForClass(ClassNode);
-  if (ClassNode.FirstChild<>nil)
-  and (ClassNode.FirstChild.Desc=ctnClassInheritance)
-  and (ClassNode.FirstChild.FirstChild<>nil) then begin
-    Result:=FindAncestorOfClassInheritance(ClassNode.FirstChild.FirstChild,
-               Params,FindClassContext);
+  InheritanceNode:=FindInheritanceNode(ClassNode);
+  if (InheritanceNode<>nil)
+  and (InheritanceNode.FirstChild<>nil) then begin
+    Result:=FindAncestorOfClassInheritance(InheritanceNode.FirstChild,
+                                           Params,FindClassContext);
     exit;
   end;
 
@@ -4827,13 +4828,13 @@ function TFindDeclarationTool.FindAncestorsOfClass(ClassNode: TCodeTreeNode;
 var
   Node: TCodeTreeNode;
   Context: TFindContext;
+  InheritanceNode: TCodeTreeNode;
 begin
   Result:=false;
-  if (ClassNode.FirstChild=nil)
-  or (ClassNode.FirstChild.Desc<>ctnClassInheritance)
-  or (ClassNode.FirstChild.FirstChild=nil) then
+  InheritanceNode:=FindInheritanceNode(ClassNode);
+  if (InheritanceNode=nil) then
     exit(true);
-  Node:=ClassNode.FirstChild.FirstChild;
+  Node:=InheritanceNode.FirstChild;
   if Node=nil then begin
     try
       if not FindAncestorOfClass(ClassNode,Params,FindClassContext) then begin

components/codetools/pascalparsertool.pas

@@ -153,7 +153,6 @@ type
     function KeyWordFuncProc: boolean;
     function KeyWordFuncBeginEnd: boolean;
     // class/object elements
-    function KeyWordFuncClassModifier: boolean;
     function KeyWordFuncClassSection: boolean;
     function KeyWordFuncClassTypeSection: boolean;
     function KeyWordFuncClassVarSection: boolean;
@@ -416,8 +415,6 @@ begin
   if StartPos>SrcLen then exit(false);
   p:=@Src[StartPos];
   case UpChars[p^] of
-  'A':
-    if CompareSrcIdentifiers(p,'ABSTRACT') then exit(KeyWordFuncClassModifier);
   'C':
     case UpChars[p[1]] of
     'L': if CompareSrcIdentifiers(p,'CLASS') then exit(KeyWordFuncClassMethod);
@@ -450,8 +447,7 @@ begin
     end;
   'S':
     if CompareSrcIdentifiers(p,'STATIC') then exit(KeyWordFuncClassMethod)
-    else if CompareSrcIdentifiers(p,'STRICT') then exit(KeyWordFuncClassSection)
-    else if CompareSrcIdentifiers(p,'SEALED') then exit(KeyWordFuncClassModifier);
+    else if CompareSrcIdentifiers(p,'STRICT') then exit(KeyWordFuncClassSection);
   'T':
     if CompareSrcIdentifiers(p,'TYPE') then exit(KeyWordFuncClassTypeSection);
   'V':
@@ -693,11 +689,11 @@ begin
     // set CursorPos after class head
     MoveCursorToNodeStart(ClassNode);
     // parse
+    //   - sealed, abstract
     //   - inheritage
     //   - class sections (GUID, type, var, public, published, private, protected)
     //   - methods (procedures, functions, constructors, destructors)
 
-    // first parse the inheritage
     // read the "class"/"object" keyword
     ReadNextAtom;
     if UpAtomIs('PACKED') or (UpAtomIs('BITPACKED')) then ReadNextAtom;
@@ -706,6 +702,27 @@ begin
     then
       RaiseClassKeyWordExpected;
     ReadNextAtom;
+    // parse modifiers
+    if CurPos.Flag=cafWord then begin
+      if UpAtomIs('SEALED') then begin
+        while UpAtomIs('SEALED') do begin
+          CreateChildNode;
+          CurNode.Desc:=ctnClassSealed;
+          CurNode.EndPos:=CurPos.EndPos;
+          EndChildNode;
+          ReadNextAtom;
+        end;
+      end else if UpAtomIs('ABSTRACT') then begin
+        while UpAtomIs('ABSTRACT') do begin
+          CreateChildNode;
+          CurNode.Desc:=ctnClassAbstract;
+          CurNode.EndPos:=CurPos.EndPos;
+          EndChildNode;
+          ReadNextAtom;
+        end;
+      end;
+    end;
+    // parse the inheritage
     if CurPos.Flag=cafRoundBracketOpen then
       ReadClassInheritance(true)
     else
@@ -2853,23 +2870,6 @@ begin
   Result:=true;
 end;
 
-function TPascalParserTool.KeyWordFuncClassModifier: boolean;
-// change class modifier (abstract, sealed)
-begin
-  // end last section
-  CurNode.EndPos:=CurPos.StartPos;
-  EndChildNode;
-  // start modifier
-  CreateChildNode;
-  if UpAtomIs('ABSTRACT') then
-    CurNode.Desc:=ctnClassAbstract
-  else if UpAtomIs('SEALED') then
-    CurNode.Desc:=ctnClassSealed
-  else
-    RaiseStringExpectedButAtomFound('abstract/sealed');
-  Result:=true;
-end;
-
 function TPascalParserTool.KeyWordFuncType: boolean;
 { The 'type' keyword is the start of a type section.
   examples:
@@ -3406,11 +3406,21 @@ begin
   end else if not (ContextDesc in [ctnTypeDefinition,ctnGenericType]) then begin
     MoveCursorToNodeStart(CurNode);
     SaveRaiseExceptionFmt(ctsAnonymDefinitionsAreNotAllowed,['class']);
-  end else if (CurPos.Flag=cafRoundBracketOpen) then begin
-    // read inheritage brackets
-    IsForward:=false;
-    ReadTilBracketClose(true);
-    ReadNextAtom;
+  end else begin
+    if UpAtomIs('SEALED') then begin
+      while UpAtomIs('SEALED') do
+        ReadNextAtom;
+    end else if UpAtomIs('ABSTRACT') then begin
+      IsForward:=false;
+      while UpAtomIs('ABSTRACT') do
+        ReadNextAtom;
+    end;
+    if (CurPos.Flag=cafRoundBracketOpen) then begin
+      // read inheritage brackets
+      IsForward:=false;
+      ReadTilBracketClose(true);
+      ReadNextAtom;
+    end;
   end;
   if CurPos.Flag=cafSemicolon then begin
     if ChildCreated and (ClassDesc in [ctnClass,ctnObject,ctnObjCClass]) then
@@ -3456,7 +3466,8 @@ begin
             and (BracketLvl=0) then
               SaveRaiseException(ctsEndForClassNotFound);
           'I':
-            if CompareSrcIdentifiers(p,'IMPLEMENTATION') then
+            if CompareSrcIdentifiers(p,'INTERFACE')
+            or CompareSrcIdentifiers(p,'IMPLEMENTATION') then
               SaveRaiseException(ctsEndForClassNotFound);
           'R':
             if CompareSrcIdentifiers(p,'RESOURCESTRING') then

components/codetools/pascalreadertool.pas

@@ -142,6 +142,7 @@ type
     function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
     function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
     function IsClassNode(Node: TCodeTreeNode): boolean; // class, not object
+    function FindInheritanceNode(ClassNode: TCodeTreeNode): TCodeTreeNode;
 
     // records
     function ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode): string;
@@ -1474,6 +1475,16 @@ begin
   Result:=(Node<>nil) and (Node.Desc=ctnClass);
 end;
 
+function TPascalReaderTool.FindInheritanceNode(ClassNode: TCodeTreeNode
+  ): TCodeTreeNode;
+begin
+  Result:=ClassNode.FirstChild;
+  while (Result<>nil) and (Result.Desc in [ctnClassSealed,ctnClassAbstract]) do
+    Result:=Result.NextBrother;
+  if (Result<>nil) and (Result.Desc<>ctnClassInheritance) then
+    Result:=nil;
+end;
+
 function TPascalReaderTool.ExtractRecordCaseType(RecordCaseNode: TCodeTreeNode
   ): string;
 begin