diff --git a/Source/DelphiAST.Classes.pas b/Source/DelphiAST.Classes.pas index 10b785b..58c5f18 100644 --- a/Source/DelphiAST.Classes.pas +++ b/Source/DelphiAST.Classes.pas @@ -419,32 +419,42 @@ 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); //no-op when the key is absent + Exit; + end; + //locate the entry, whether it already exists or has to be appended. Assigning the pointer + //only on the append path left it uninitialised when overwriting an attribute that was + //already set, and the write below then dereferenced it. + 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, j: Integer; +begin + if not HasAttribute(Key) then + Exit; + for i := 0 to High(FAttributes) do + if FAttributes[i].Key = Key then + begin + //shift the tail down over the entry, then shrink. Assignment rather than Move: an entry + //holds a managed string, and moving those raw corrupts their reference counts. + for j := i to High(FAttributes) - 1 do + FAttributes[j] := FAttributes[j + 1]; + SetLength(FAttributes, Length(FAttributes) - 1); + Exclude(FAttributesInUse, Key); + Exit; + end; end; function SameText(const Needle: string; const HayStack: array of string): boolean; overload; diff --git a/Test/UnitTests/DelphiAST.Tests.pas b/Test/UnitTests/DelphiAST.Tests.pas index 6d15948..b2785b1 100644 --- a/Test/UnitTests/DelphiAST.Tests.pas +++ b/Test/UnitTests/DelphiAST.Tests.pas @@ -177,6 +177,25 @@ procedure TestSourcePositions; end; end; +procedure TestSetAttributeTwice; +var + Node: TSyntaxNode; +begin + Node := TSyntaxNode.Create(ntMethod); + try + Node.Attribute[anName] := 'first'; + AssertEquals('first', Node.Attribute[anName], 'First write'); + Node.Attribute[anName] := 'second'; + AssertEquals('second', Node.Attribute[anName], 'Overwriting an attribute'); + Node.Attribute[anName] := ''; + AssertEquals('', Node.Attribute[anName], 'Clearing an attribute'); + Node.Attribute[anName] := 'again'; + AssertEquals('again', Node.Attribute[anName], 'Setting it again after clearing'); + finally + Node.Free; + end; +end; + procedure TestInvalidSyntax; var Root: TSyntaxNode; @@ -229,6 +248,7 @@ procedure RunAllTests; RunTest('AST.GenericRecordAndProperty', TestGenericRecordAndProperty); RunTest('Writer.LiteralsUnicodeAndXmlEscaping', TestLiteralsAndUnicode); RunTest('AST.SourcePositions', TestSourcePositions); + RunTest('AST.SetAttributeTwice', TestSetAttributeTwice); RunTest('Parser.InvalidSyntax', TestInvalidSyntax); {$IFNDEF FPC} RunTest('Serialization.BinaryRoundTrip', TestBinarySerializationRoundTrip);