Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 20 additions & 14 deletions Source/DelphiAST.Classes.pas
Original file line number Diff line number Diff line change
Expand Up @@ -421,32 +421,38 @@ procedure TSyntaxNode.SetAttribute(const Key: TAttributeName; const Value: strin
AttributeEntry: PAttributeEntry;
len: Integer;
begin
if not HasAttribute(Key) then
if (Value = '') then
begin
RemoveAttribute(Key);
Exit;
end;
if not TryGetAttributeEntry(Key, AttributeEntry) then
begin
if (Value = '') then Exit; //no action needed
len := Length(FAttributes);
SetLength(FAttributes, len + 1);
AttributeEntry := @FAttributes[len];
AttributeEntry^.Key := Key;
Include(FAttributesInUse, Key);
end;
if (Value = '') then RemoveAttribute(Key);
AttributeEntry^.Value := Value;
end;

procedure TSyntaxNode.RemoveAttribute(const Key: TAttributeName);
const
Size = SizeOf(TAttributeEntry);
var
Entry: PAttributeEntry;
Index: integer;
begin
if HasAttribute(Key) then begin
TryGetAttributeEntry(Key, Entry);
Index:= (NativeUInt(Entry) - NativeUInt(@FAttributes[0])) + Size;
Move(Entry^, Pointer(NativeUInt(Entry)+Size)^, (High(FAttributes) * Size) - Index);
Exclude(FAttributesInUse, Key);
end;
i, Kept: Integer;
begin
if not HasAttribute(Key) then
Exit;
Kept := 0;
for i := 0 to High(FAttributes) do
if FAttributes[i].Key <> Key then
begin
if Kept <> i then
FAttributes[Kept] := FAttributes[i];
Inc(Kept);
end;
SetLength(FAttributes, Kept);
Exclude(FAttributesInUse, Key);
end;

function SameText(const Needle: string; const HayStack: array of string): boolean; overload;
Expand Down
62 changes: 62 additions & 0 deletions Test/UnitTests/DelphiAST.Tests.pas
Original file line number Diff line number Diff line change
Expand Up @@ -241,6 +241,65 @@ procedure TestVariableEndPosition;
end;
end;

procedure TestAttributeOverwrite;
var
Node: TSyntaxNode;
begin
Node := TSyntaxNode.Create(ntMethod);
try
Node.SetAttribute(anName, 'First');
Node.SetAttribute(anType, 'Kept');
Node.SetAttribute(anName, 'Second');
AssertEquals('Second', Node.GetAttribute(anName), 'Overwritten attribute.');
AssertEquals('Kept', Node.GetAttribute(anType), 'Other attribute.');
AssertEquals(2, Length(Node.Attributes), 'Overwriting must not add an entry.');
finally
Node.Free;
end;
end;

procedure TestAttributeRemove;
var
Node: TSyntaxNode;
begin
Node := TSyntaxNode.Create(ntMethod);
try
Node.SetAttribute(anName, 'Name');
Node.SetAttribute(anType, 'Type');
Node.SetAttribute(anKind, 'Kind');
Node.SetAttribute(anName, '');
AssertFalse(Node.HasAttribute(anName), 'An empty value removes the attribute.');
AssertEquals(2, Length(Node.Attributes), 'Removing must drop the entry.');
AssertEquals('Type', Node.GetAttribute(anType), 'First remaining attribute.');
AssertEquals('Kind', Node.GetAttribute(anKind), 'Second remaining attribute.');
Node.SetAttribute(anName, 'Again');
AssertEquals('Again', Node.GetAttribute(anName), 'A removed attribute can be set again.');
AssertEquals(3, Length(Node.Attributes), 'Setting it again adds one entry.');
finally
Node.Free;
end;
end;

procedure TestRepeatedCallingConvention;
var
Root, IntfNode: TSyntaxNode;
begin
Root := ParseSource('unit Example; interface ' +
'procedure Same(A: Integer); stdcall; stdcall; external ''a.dll'' index 93; ' +
'procedure Other; stdcall; cdecl; external ''a.dll''; implementation end.');
try
IntfNode := FindDescendant(Root, ntInterface);
AssertNotNil(IntfNode, 'Missing interface');
AssertEquals(2, CountDescendants(IntfNode, ntMethod), 'Method count.');
AssertEquals('stdcall', IntfNode.ChildNodes[0].GetAttribute(anCallingConvention),
'A repeated calling convention.');
AssertEquals('cdecl', IntfNode.ChildNodes[1].GetAttribute(anCallingConvention),
'The last of two calling conventions.');
finally
Root.Free;
end;
end;

procedure TestInvalidSyntax;
var
Root: TSyntaxNode;
Expand Down Expand Up @@ -295,6 +354,9 @@ procedure RunAllTests;
RunTest('AST.SourcePositions', TestSourcePositions);
RunTest('AST.ConstantEndPosition', TestConstantEndPosition);
RunTest('AST.VariableEndPosition', TestVariableEndPosition);
RunTest('Node.AttributeOverwrite', TestAttributeOverwrite);
RunTest('Node.AttributeRemove', TestAttributeRemove);
RunTest('AST.RepeatedCallingConvention', TestRepeatedCallingConvention);
RunTest('Parser.InvalidSyntax', TestInvalidSyntax);
{$IFNDEF FPC}
RunTest('Serialization.BinaryRoundTrip', TestBinarySerializationRoundTrip);
Expand Down
Loading