Skip to content

Commit

Permalink
RomanYankovsky#250 record constants are not recorded correctly
Browse files Browse the repository at this point in the history
This is esp. evident in the following example:
const
  OperatorsInfo: array [0..2] of TOperatorInfo =
    ((Typ: ntAddr;         AssocType: atRight),
     (Typ: ntDeref;        AssocType: atLeft),
     (Typ: ntGeneric;      AssocType: atRight));

All constants are incorrectly listed as one long list, instead of as separate records.
  • Loading branch information
jbontes committed Oct 15, 2017
1 parent 8ae51f0 commit 6d60707
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 4 deletions.
1 change: 1 addition & 0 deletions Source/DelphiAST.Consts.pas
Original file line number Diff line number Diff line change
Expand Up @@ -116,6 +116,7 @@ interface
ntProperty,
ntRaise,
ntRead,
ntRecordConstant,
ntRecordConstraint,
ntRecordVariant,
ntRepeat,
Expand Down
26 changes: 22 additions & 4 deletions Source/DelphiAST.pas
Original file line number Diff line number Diff line change
Expand Up @@ -216,6 +216,7 @@ TPasSyntaxTreeBuilder = class(TmwSimplePasPar)
procedure PropertyParameterList; override;
procedure RaiseStatement; override;
procedure RecordConstraint; override;
procedure RecordConstant; override;
procedure RecordFieldConstant; override;
procedure RecordType; override;
procedure RecordVariant; override;
Expand Down Expand Up @@ -333,7 +334,7 @@ TStringStreamHelper = class helper for TStringStream
// do not use const strings here to prevent allocating new strings every time

type
TAttributeValue = (atAsm, atTrue, atFunction, atProcedure, atOperator, atClassOf, atClass,
TAttributeValue = (atAsm, atTrue, atFunction, atProcedure, atOperator, atClass_Of, atClass,
atConst, atConstructor, atDestructor, atEnum, atInterface, atNil, atNumeric,
atOut, atPointer, atName, atString, atSubRange, atVar, atType{ExplicitType},
atObject, atSealed, atAbstract, atBegin, atOf_Object{procedure of object},
Expand Down Expand Up @@ -984,7 +985,7 @@ procedure TPasSyntaxTreeBuilder.ClassProperty;

procedure TPasSyntaxTreeBuilder.ClassReferenceType;
begin
FStack.Push(ntType).Attribute[anType]:= AttributeValues[atClassof];
FStack.Push(ntType).Attribute[anType]:= AttributeValues[atClass_of];
try
inherited;
finally
Expand Down Expand Up @@ -1143,6 +1144,15 @@ procedure TPasSyntaxTreeBuilder.ConstructorConstraint;
end;
end;

procedure TPasSyntaxTreeBuilder.RecordConstant;
begin
FStack.Push(ntRecordConstant);
try
inherited;
finally
FStack.Pop;
end;
end;
procedure TPasSyntaxTreeBuilder.RecordConstraint;
begin
FStack.Push(ntRecordConstraint);
Expand Down Expand Up @@ -2190,9 +2200,17 @@ procedure TPasSyntaxTreeBuilder.RecordFieldConstant;
var
Node: TSyntaxNode;
begin
Node := FStack.PushValuedNode(ntField, Lexer.Token);
//A field in a record constant should have exactly the same layout
//as a field in a class.
//ntField (class)
//+-- ntName (anName = name)
//+-- ntType
//Recordconstant
//ntField (recordconstant)
//+-- ntName
//+-- ntExpression.
FStack.Push(ntField).AddChild(ntName).Attribute[anName]:= Lexer.Token;
try
Node.Attribute[anType]:= AttributeValues[atName];
inherited;
finally
FStack.Pop;
Expand Down

0 comments on commit 6d60707

Please sign in to comment.