Merge pull request #1 from GDKsoftware/fix/setattribute-existing-key

Overwrite an existing attribute instead of writing through an uninitialised pointer

Author: partouf

Source/DelphiAST.Classes.pas

@@ -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;

Test/UnitTests/DelphiAST.Tests.pas

@@ -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;
@@ -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);