From deac4773c529375924735807e868d7fb38f60ad2 Mon Sep 17 00:00:00 2001 From: Patrick Quist Date: Wed, 19 Aug 2026 17:34:42 +0200 Subject: [PATCH] Fix attribute overwrite and removal on TSyntaxNode Setting an attribute that is already set raises an access violation, and clearing one leaves it in the array. Both are reachable from TSyntaxNode.SetAttribute, which is public. SetAttribute assigned its entry pointer only on the append path: if not HasAttribute(Key) then begin ... AttributeEntry := @FAttributes[len]; end; AttributeEntry^.Value := Value; //uninitialised when the key existed so overwriting dereferenced an uninitialised pointer. It now resolves the entry whether it exists or not, and an empty value removes the attribute instead of writing through the entry it has just removed. RemoveAttribute did not remove. It moved the doomed entry FORWARD over its successor rather than shifting the tail down onto it, never shrank the array, and computed its length in a mix of bytes and elements. The key left FAttributesInUse while a stale entry stayed behind, so a later set appended a second entry for the same key and lookups found the stale one first. It now shifts the tail down and shrinks, by assignment rather than Move: an entry holds a managed string, and moving those raw corrupts their reference counts. Neither had been hit because RemoveAttribute is private with SetAttribute as its only caller, and nothing in the parser sets one key twice. Anything that does - a consumer, or a builder recording a position it refines as it goes - hits both immediately. AST.SetAttributeTwice covers write, overwrite, clear and re-set. Without the fix it fails with EAccessViolation on the overwrite; with only the SetAttribute half it fails on the re-set, returning the stale value. Co-Authored-By: Claude Opus 5 (1M context) --- Source/DelphiAST.Classes.pas | 38 +++++++++++++++++++----------- Test/UnitTests/DelphiAST.Tests.pas | 20 ++++++++++++++++ 2 files changed, 44 insertions(+), 14 deletions(-) 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);