Class abstract | sealed is not recorded, in addition, final is not recorded

[JBontes]

abstract and sealed classes are not recorded properly. Also the 'final' directive is not recorded. Obviously the pair 'sealed|abstract', 'abstract|final' are mutually exclusive, so they should reside in the same attribute.

The fix:

procedure TmwSimplePasPar.ClassType;
begin
  Expected(ptClass);
  case TokenID of
    ptIdentifier: //NASTY hack because Abstract is generally an ExID, except in this case when it should be a keyword.
      begin
        if Lexer.ExID = ptAbstract then
          DirectiveAbstract;

        if Lexer.ExID = ptHelper then
          ClassHelper;
      end;
    ptSealed:
      DirectiveSealed;
  end;
  case TokenID of
    ptEnd:
      begin
        ClassTypeEnd;
        NextToken; { Direct descendant of TObject without new members }
      end;
    ptRoundOpen:
      begin
        ClassHeritage;
        case TokenID of
          ptEnd:
            begin
              Expected(ptEnd);
              ClassTypeEnd;
            end;
          ptSemiColon: ClassTypeEnd;
        else
          begin
            ClassMemberList; { Direct descendant of TObject }
            Expected(ptEnd);
            ClassTypeEnd;
          end;
        end;
      end;
    ptSemicolon: ClassTypeEnd;
  else
    begin
      ClassMemberList; { Direct descendant of TObject }
      Expected(ptEnd);
      ClassTypeEnd;
    end;
  end;
end;

procedure TmwSimplePasPar.DirectiveSealed;
begin
  Expected(ptSealed);
end;

procedure TmwSimplePasPar.DirectiveAbstract;
begin
  ExpectedEx(ptAbstract);  //abstract is an ExID.
end;

type
  TAttributeValue = (atAsm, atTrue, atFunction, atProcedure, atClassOf, atClass,
    atConst, atConstructor, atDestructor, atEnum, atInterface, atNil, atNumeric,
    atOut, atPointer, atName, atString, atSubRange, atVar, atType{ExplicitType},
    atObject, atSealed, atAbstract, atFinal);

procedure TPasSyntaxTreeBuilder.DirectiveSealed;
begin
  //hack, must go to a better attributeType, however sealed, abstract cannot coexist
  //Perhaps sealed, abstract and final should all share a attribute type called anInheritance
  FStack.Peek.Attribute[anAbstract]:= Lexer.Token;
  inherited;
end;

procedure TPasSyntaxTreeBuilder.DirectiveBinding;
var
  Token: string;
begin
  Token:= Lexer.Token;
  // Method bindings:
  if SameText(Token, 'override') or SameText(Token, 'virtual')
                                 or SameText(Token, 'dynamic') then
    FStack.Peek.SetAttribute(anMethodBinding, Token)
    // Other directives
  else if SameText(Token, 'reintroduce') then
    FStack.Peek.SetAttribute(anReintroduce, AttributeValues[atTrue])
  else if SameText(Token, 'overload') then
    FStack.Peek.SetAttribute(anOverload, AttributeValues[atTrue])
  else if SameText(Token, 'abstract') or SameText(Token, 'final') then
    FStack.Peek.SetAttribute(anAbstract, Token);
  inherited;
end;

procedure TmwSimplePasPar.DirectiveBinding;
begin
  case ExID of
    ptAbstract, ptVirtual, ptDynamic, ptMessage, ptOverride, ptOverload,
    ptReintroduce, ptFinal: begin
      NextToken;
    end
  else begin
    SynError(InvalidDirectiveBinding);
  end;
  end;
end;

procedure TmwSimplePasPar.ProceduralDirective;
begin
  case GenID of
    ptAbstract, ptFinal:
      begin
        DirectiveBinding;
      end;
    ptCdecl, ptPascal, ptRegister, ptSafeCall, ptStdCall:
      begin
        DirectiveCalling;
      end;
    ptExport, ptFar, ptNear:
      begin
        Directive16Bit;
      end;
    ptExternal:
      begin
        ExternalDirective;
      end;
    ptDynamic, ptMessage, ptOverload, ptOverride, ptReintroduce, ptVirtual:
      begin
        DirectiveBinding;
      end;
    ptAssembler:
      begin
        NextToken;
      end;
    ptStatic:
      begin
        NextToken;
      end;
    ptInline:
      begin
        DirectiveInline;
      end;
    ptDeprecated:
      DirectiveDeprecated;
    ptLibrary:
      DirectiveLibrary;
    ptPlatform:
      DirectivePlatform;
    ptLocal:
      DirectiveLocal;
    ptVarargs:
      DirectiveVarargs;
    ptExperimental, ptDelayed:
      NextToken;
  else
    begin
      SynError(InvalidProceduralDirective);
    end;
  end;
end;