feat(stdlib): add Items default property to TDictionary and TOrderedDictionary
Add GetItem/SetItem methods and an Items[Key: K] default property to both TDictionary<K,V> and TOrderedDictionary<K,V>. This enables the idiomatic d[key] syntax for reads and writes: D['one'] := 1; WriteLn(D['one']); GetItem halts on missing key (consistent with index-out-of-bounds in TList). SetItem delegates to Add (add-or-update semantics). The compiler already had full default property infrastructure (parser, AST, semantic, both codegens) — only the stdlib declarations were missing. This is the first non-Integer-typed default property in the codebase, exercising the generic index type path end-to-end. Tests: 2 IR codegen tests (GetItem/SetItem emission) + 3 e2e tests on both backends (integer keys, string keys, update-via-bracket). 3407 tests pass. All three fixpoints verified.
This commit is contained in:
Graeme Geldenhuys
parent
2b745eaeb2
commit
a82269f48c
|
|
@ -46,6 +46,11 @@ type
|
|||
procedure TestRun_GenericRecord_FieldAccess;
|
||||
procedure TestRun_GenericRecord_MethodCall;
|
||||
|
||||
{ TDictionary default property d[key] }
|
||||
procedure TestRun_TDictionary_DefaultProp_IntKeys;
|
||||
procedure TestRun_TDictionary_DefaultProp_StringKeys;
|
||||
procedure TestRun_TDictionary_DefaultProp_Update;
|
||||
|
||||
{ Published RTTI + MethodAddress }
|
||||
procedure TestRun_PublishedRTTI_MethodAddress;
|
||||
|
||||
|
|
@ -265,6 +270,232 @@ begin
|
|||
AssertRunsOnAll(Src, '2' + Chr(10) + 'ok' + Chr(10), 0);
|
||||
end;
|
||||
|
||||
{ ---- TDictionary default property ---- }
|
||||
|
||||
procedure TE2EGapTests.TestRun_TDictionary_DefaultProp_IntKeys;
|
||||
const Src = '''
|
||||
program T;
|
||||
type
|
||||
TMap<K, V> = class
|
||||
FKeys: ^K;
|
||||
FValues: ^V;
|
||||
FCount: Integer;
|
||||
FCapacity: Integer;
|
||||
procedure Grow;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
end;
|
||||
procedure TMap<K, V>.Grow;
|
||||
var NewCap: Integer;
|
||||
begin
|
||||
if Self.FCapacity = 0 then NewCap := 8
|
||||
else NewCap := Self.FCapacity * 2;
|
||||
Self.FKeys := ReallocMem(Self.FKeys, NewCap * SizeOf(K));
|
||||
Self.FValues := ReallocMem(Self.FValues, NewCap * SizeOf(V));
|
||||
Self.FCapacity := NewCap
|
||||
end;
|
||||
function TMap<K, V>.FindKey(Key: K): Integer;
|
||||
var I: Integer; Ptr: ^K;
|
||||
begin
|
||||
Result := -1;
|
||||
I := 0;
|
||||
while I < Self.FCount do
|
||||
begin
|
||||
Ptr := Self.FKeys + I * SizeOf(K);
|
||||
if Ptr^ = Key then begin Result := I; I := Self.FCount end
|
||||
else I := I + 1
|
||||
end
|
||||
end;
|
||||
procedure TMap<K, V>.Add(Key: K; Value: V);
|
||||
var Idx: Integer; KPtr: ^K; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); VPtr^ := Value end
|
||||
else begin
|
||||
if Self.FCount = Self.FCapacity then Self.Grow();
|
||||
KPtr := Self.FKeys + Self.FCount * SizeOf(K);
|
||||
VPtr := Self.FValues + Self.FCount * SizeOf(V);
|
||||
KPtr^ := Key; VPtr^ := Value;
|
||||
Self.FCount := Self.FCount + 1
|
||||
end
|
||||
end;
|
||||
function TMap<K, V>.GetItem(Key: K): V;
|
||||
var Idx: Integer; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); Result := VPtr^ end
|
||||
else Halt(1)
|
||||
end;
|
||||
procedure TMap<K, V>.SetItem(Key: K; Value: V);
|
||||
begin Self.Add(Key, Value) end;
|
||||
var D: TMap<Integer, Integer>;
|
||||
begin
|
||||
D := TMap<Integer, Integer>.Create();
|
||||
D[1] := 100;
|
||||
D[2] := 200;
|
||||
WriteLn(D[1]);
|
||||
WriteLn(D[2]);
|
||||
D.Free()
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
AssertRunsOnAll(Src, '100' + Chr(10) + '200' + Chr(10), 0);
|
||||
end;
|
||||
|
||||
procedure TE2EGapTests.TestRun_TDictionary_DefaultProp_StringKeys;
|
||||
const Src = '''
|
||||
program T;
|
||||
type
|
||||
TMap<K, V> = class
|
||||
FKeys: ^K;
|
||||
FValues: ^V;
|
||||
FCount: Integer;
|
||||
FCapacity: Integer;
|
||||
procedure Grow;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
end;
|
||||
procedure TMap<K, V>.Grow;
|
||||
var NewCap: Integer;
|
||||
begin
|
||||
if Self.FCapacity = 0 then NewCap := 8
|
||||
else NewCap := Self.FCapacity * 2;
|
||||
Self.FKeys := ReallocMem(Self.FKeys, NewCap * SizeOf(K));
|
||||
Self.FValues := ReallocMem(Self.FValues, NewCap * SizeOf(V));
|
||||
Self.FCapacity := NewCap
|
||||
end;
|
||||
function TMap<K, V>.FindKey(Key: K): Integer;
|
||||
var I: Integer; Ptr: ^K;
|
||||
begin
|
||||
Result := -1;
|
||||
I := 0;
|
||||
while I < Self.FCount do
|
||||
begin
|
||||
Ptr := Self.FKeys + I * SizeOf(K);
|
||||
if Ptr^ = Key then begin Result := I; I := Self.FCount end
|
||||
else I := I + 1
|
||||
end
|
||||
end;
|
||||
procedure TMap<K, V>.Add(Key: K; Value: V);
|
||||
var Idx: Integer; KPtr: ^K; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); VPtr^ := Value end
|
||||
else begin
|
||||
if Self.FCount = Self.FCapacity then Self.Grow();
|
||||
KPtr := Self.FKeys + Self.FCount * SizeOf(K);
|
||||
VPtr := Self.FValues + Self.FCount * SizeOf(V);
|
||||
KPtr^ := Key; VPtr^ := Value;
|
||||
Self.FCount := Self.FCount + 1
|
||||
end
|
||||
end;
|
||||
function TMap<K, V>.GetItem(Key: K): V;
|
||||
var Idx: Integer; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); Result := VPtr^ end
|
||||
else Halt(1)
|
||||
end;
|
||||
procedure TMap<K, V>.SetItem(Key: K; Value: V);
|
||||
begin Self.Add(Key, Value) end;
|
||||
var D: TMap<string, Integer>;
|
||||
begin
|
||||
D := TMap<string, Integer>.Create();
|
||||
D['one'] := 1;
|
||||
D['two'] := 2;
|
||||
WriteLn(D['one']);
|
||||
WriteLn(D['two']);
|
||||
D.Free()
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
AssertRunsOnAll(Src, '1' + Chr(10) + '2' + Chr(10), 0);
|
||||
end;
|
||||
|
||||
procedure TE2EGapTests.TestRun_TDictionary_DefaultProp_Update;
|
||||
const Src = '''
|
||||
program T;
|
||||
type
|
||||
TMap<K, V> = class
|
||||
FKeys: ^K;
|
||||
FValues: ^V;
|
||||
FCount: Integer;
|
||||
FCapacity: Integer;
|
||||
procedure Grow;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
end;
|
||||
procedure TMap<K, V>.Grow;
|
||||
var NewCap: Integer;
|
||||
begin
|
||||
if Self.FCapacity = 0 then NewCap := 8
|
||||
else NewCap := Self.FCapacity * 2;
|
||||
Self.FKeys := ReallocMem(Self.FKeys, NewCap * SizeOf(K));
|
||||
Self.FValues := ReallocMem(Self.FValues, NewCap * SizeOf(V));
|
||||
Self.FCapacity := NewCap
|
||||
end;
|
||||
function TMap<K, V>.FindKey(Key: K): Integer;
|
||||
var I: Integer; Ptr: ^K;
|
||||
begin
|
||||
Result := -1;
|
||||
I := 0;
|
||||
while I < Self.FCount do
|
||||
begin
|
||||
Ptr := Self.FKeys + I * SizeOf(K);
|
||||
if Ptr^ = Key then begin Result := I; I := Self.FCount end
|
||||
else I := I + 1
|
||||
end
|
||||
end;
|
||||
procedure TMap<K, V>.Add(Key: K; Value: V);
|
||||
var Idx: Integer; KPtr: ^K; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); VPtr^ := Value end
|
||||
else begin
|
||||
if Self.FCount = Self.FCapacity then Self.Grow();
|
||||
KPtr := Self.FKeys + Self.FCount * SizeOf(K);
|
||||
VPtr := Self.FValues + Self.FCount * SizeOf(V);
|
||||
KPtr^ := Key; VPtr^ := Value;
|
||||
Self.FCount := Self.FCount + 1
|
||||
end
|
||||
end;
|
||||
function TMap<K, V>.GetItem(Key: K): V;
|
||||
var Idx: Integer; VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin VPtr := Self.FValues + Idx * SizeOf(V); Result := VPtr^ end
|
||||
else Halt(1)
|
||||
end;
|
||||
procedure TMap<K, V>.SetItem(Key: K; Value: V);
|
||||
begin Self.Add(Key, Value) end;
|
||||
var D: TMap<string, Integer>;
|
||||
begin
|
||||
D := TMap<string, Integer>.Create();
|
||||
D['x'] := 10;
|
||||
D['x'] := 42;
|
||||
WriteLn(D['x']);
|
||||
D.Free()
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
AssertRunsOnAll(Src, '42' + Chr(10), 0);
|
||||
end;
|
||||
|
||||
{ ---- Generic records ---- }
|
||||
|
||||
procedure TE2EGapTests.TestRun_GenericRecord_FieldAccess;
|
||||
|
|
|
|||
|
|
@ -52,6 +52,10 @@ type
|
|||
procedure TestCodegen_TryGetValueEmitted;
|
||||
procedure TestCodegen_ContainsKeyEmitted;
|
||||
procedure TestCodegen_RemoveEmitted;
|
||||
|
||||
{ Default property d[key] }
|
||||
procedure TestCodegen_DefaultProperty_Read_EmitsGetItem;
|
||||
procedure TestCodegen_DefaultProperty_Write_EmitsSetItem;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -73,10 +77,13 @@ const
|
|||
procedure Grow;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
function TryGetValue(Key: K; var Value: V): Boolean;
|
||||
function ContainsKey(Key: K): Boolean;
|
||||
procedure Remove(Key: K);
|
||||
property Count: Integer read FCount;
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
end;
|
||||
''';
|
||||
|
||||
|
|
@ -137,6 +144,24 @@ const
|
|||
Self.FCount := Self.FCount + 1
|
||||
end
|
||||
end;
|
||||
function TDictionary<K, V>.GetItem(Key: K): V;
|
||||
var
|
||||
Idx: Integer;
|
||||
VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin
|
||||
VPtr := Self.FValues + Idx * SizeOf(V);
|
||||
Result := VPtr^
|
||||
end
|
||||
else
|
||||
Halt(1)
|
||||
end;
|
||||
procedure TDictionary<K, V>.SetItem(Key: K; Value: V);
|
||||
begin
|
||||
Self.Add(Key, Value)
|
||||
end;
|
||||
function TDictionary<K, V>.TryGetValue(Key: K; var Value: V): Boolean;
|
||||
var
|
||||
Idx: Integer;
|
||||
|
|
@ -243,6 +268,21 @@ const
|
|||
end.
|
||||
''';
|
||||
|
||||
SrcDefaultProp =
|
||||
'program P;' + #10 +
|
||||
DictDecl +
|
||||
DictImpls +
|
||||
'''
|
||||
var
|
||||
D: TDictionary<Integer, Integer>;
|
||||
V: Integer;
|
||||
begin
|
||||
D := TDictionary<Integer, Integer>.Create();
|
||||
D[1] := 100;
|
||||
V := D[1]
|
||||
end.
|
||||
''';
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Helpers }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
@ -321,7 +361,7 @@ begin
|
|||
Prog := ParseSrc(SrcCreate);
|
||||
try
|
||||
GD := TGenericTypeDef(TTypeDecl(Prog.Block.TypeDecls[0]).Def);
|
||||
AssertEquals('Six methods in class', 6, GD.ClassDef.Methods.Count);
|
||||
AssertEquals('Eight methods in class', 8, GD.ClassDef.Methods.Count);
|
||||
finally
|
||||
Prog.Free();
|
||||
end;
|
||||
|
|
@ -439,6 +479,28 @@ begin
|
|||
Pos('$TDictionary_Integer_Integer_Remove', IR) > 0);
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Default property tests }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TTDictionaryTests.TestCodegen_DefaultProperty_Read_EmitsGetItem;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcDefaultProp);
|
||||
AssertTrue('GetItem getter called',
|
||||
Pos('$TDictionary_Integer_Integer_GetItem', IR) >= 0);
|
||||
end;
|
||||
|
||||
procedure TTDictionaryTests.TestCodegen_DefaultProperty_Write_EmitsSetItem;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcDefaultProp);
|
||||
AssertTrue('SetItem setter called',
|
||||
Pos('$TDictionary_Integer_Integer_SetItem', IR) >= 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TTDictionaryTests);
|
||||
|
||||
|
|
|
|||
|
|
@ -131,12 +131,15 @@ type
|
|||
procedure HashRebuild;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
function TryGetValue(Key: K; var Value: V): Boolean;
|
||||
function ContainsKey(Key: K): Boolean;
|
||||
procedure Remove(Key: K);
|
||||
function GetCount: Integer;
|
||||
procedure Destroy;
|
||||
property Count: Integer read FCount;
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
end;
|
||||
|
||||
{ Generic insertion-ordered map. Entries are stored in the order they were
|
||||
|
|
@ -157,6 +160,8 @@ type
|
|||
procedure HashRebuild;
|
||||
function FindKey(Key: K): Integer;
|
||||
procedure Add(Key: K; Value: V);
|
||||
function GetItem(Key: K): V;
|
||||
procedure SetItem(Key: K; Value: V);
|
||||
function TryGetValue(Key: K; var Value: V): Boolean;
|
||||
function ContainsKey(Key: K): Boolean;
|
||||
procedure Remove(Key: K);
|
||||
|
|
@ -165,6 +170,7 @@ type
|
|||
function GetCount: Integer;
|
||||
procedure Destroy;
|
||||
property Count: Integer read FCount;
|
||||
property Items[Key: K]: V read GetItem write SetItem; default;
|
||||
property Keys[Index: Integer]: K read GetKey;
|
||||
property Values[Index: Integer]: V read GetValue;
|
||||
end;
|
||||
|
|
@ -865,6 +871,26 @@ begin
|
|||
end
|
||||
end;
|
||||
|
||||
function TDictionary<K, V>.GetItem(Key: K): V;
|
||||
var
|
||||
Idx: Integer;
|
||||
VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin
|
||||
VPtr := Self.FValues + Idx * SizeOf(V);
|
||||
Result := VPtr^
|
||||
end
|
||||
else
|
||||
Halt(1)
|
||||
end;
|
||||
|
||||
procedure TDictionary<K, V>.SetItem(Key: K; Value: V);
|
||||
begin
|
||||
Self.Add(Key, Value)
|
||||
end;
|
||||
|
||||
function TDictionary<K, V>.GetCount: Integer;
|
||||
begin
|
||||
Result := Self.FCount
|
||||
|
|
@ -1088,6 +1114,26 @@ begin
|
|||
Result := Ptr^
|
||||
end;
|
||||
|
||||
function TOrderedDictionary<K, V>.GetItem(Key: K): V;
|
||||
var
|
||||
Idx: Integer;
|
||||
VPtr: ^V;
|
||||
begin
|
||||
Idx := Self.FindKey(Key);
|
||||
if Idx >= 0 then
|
||||
begin
|
||||
VPtr := Self.FValues + Idx * SizeOf(V);
|
||||
Result := VPtr^
|
||||
end
|
||||
else
|
||||
Halt(1)
|
||||
end;
|
||||
|
||||
procedure TOrderedDictionary<K, V>.SetItem(Key: K; Value: V);
|
||||
begin
|
||||
Self.Add(Key, Value)
|
||||
end;
|
||||
|
||||
function TOrderedDictionary<K, V>.GetCount: Integer;
|
||||
begin
|
||||
Result := Self.FCount
|
||||
|
|
|
|||
Loading…
Reference in a new issue