feat(generics): for..in support on generic collections (Step 9b)
Three fixes to unblock for..in over generic collection types: 1. SubstTypeParam: extend to substitute type params inside generic instantiation names. Previously only bare 'T' and '^T' were handled; 'SomeName<T>' was left unsubstituted, so a method returning 'TListEnumerator<T>' kept the raw param name after cloning. 2. InstantiateGeneric: clone TClassTypeDef.Properties with type-param substitution (same pattern as fields and methods). Without this the 'Current: T' property was invisible on instantiated enumerator types and FindProperty returned nil during for..in semantic checks. 3. AnalyseFieldAccess + ResolveScopeBoundTypeParams: when a generic RecordName such as 'TGenEnum<T>' isn't found in the symbol table, resolve each type argument against the current scope (where T=Integer is pushed during method body analysis) and retry the lookup with the concrete name 'TGenEnum<Integer>'. New: cp.test.genericforin.pas — 10 tests covering property visibility, property type after instantiation, and end-to-end for..in IR emission. 1141 tests total, all passing.
This commit is contained in:
Graeme Geldenhuys
parent
5af72daac7
commit
aafd004973
|
|
@ -52,6 +52,12 @@ type
|
|||
function SubstTypeParam(const ATypeName: string;
|
||||
AParamNames, AArgs: TStringList): string;
|
||||
|
||||
{ Resolves scope-bound type params inside a generic type name such as
|
||||
'TGenEnum<T>' when 'T' is bound in the current scope as a skType symbol.
|
||||
Returns the canonical name (e.g. 'TGenEnum<Integer>') suitable for
|
||||
FindTypeOrInstantiate. Has no effect on names without '<'. }
|
||||
function ResolveScopeBoundTypeParams(const ATypeName: string): string;
|
||||
|
||||
{ Generic function instantiation: resolves 'Identity<Integer>' on demand. }
|
||||
function InstantiateGenericFunc(const AInstName: string): TMethodDecl;
|
||||
|
||||
|
|
@ -736,6 +742,55 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.ResolveScopeBoundTypeParams(const ATypeName: string): string;
|
||||
var
|
||||
BrOpen, BrClose, I: Integer;
|
||||
BasePart, ArgsPart, OutArgs, Arg: string;
|
||||
ArgList: TStringList;
|
||||
Sym: TSymbol;
|
||||
begin
|
||||
Result := ATypeName;
|
||||
BrOpen := Pos('<', ATypeName);
|
||||
if BrOpen = 0 then Exit;
|
||||
BrClose := Length(ATypeName);
|
||||
BasePart := Copy(ATypeName, 1, BrOpen - 1);
|
||||
ArgsPart := Copy(ATypeName, BrOpen + 1, BrClose - BrOpen - 1);
|
||||
ArgList := TStringList.Create;
|
||||
try
|
||||
while ArgsPart <> '' do
|
||||
begin
|
||||
I := Pos(',', ArgsPart);
|
||||
if I > 0 then
|
||||
begin
|
||||
ArgList.Add(Trim(Copy(ArgsPart, 1, I - 1)));
|
||||
ArgsPart := Trim(Copy(ArgsPart, I + 1, MaxInt));
|
||||
end
|
||||
else
|
||||
begin
|
||||
ArgList.Add(Trim(ArgsPart));
|
||||
ArgsPart := '';
|
||||
end;
|
||||
end;
|
||||
OutArgs := '';
|
||||
for I := 0 to ArgList.Count - 1 do
|
||||
begin
|
||||
Arg := ArgList.Strings[I];
|
||||
{ If this arg is a bare ident bound as skType in the current scope,
|
||||
replace it with the concrete type name. }
|
||||
Sym := FTable.Lookup(Arg);
|
||||
if (Sym <> nil) and (Sym.Kind = skType) and (Sym.TypeDesc <> nil) then
|
||||
Arg := Sym.TypeDesc.Name;
|
||||
if OutArgs = '' then
|
||||
OutArgs := Arg
|
||||
else
|
||||
OutArgs := OutArgs + ',' + Arg;
|
||||
end;
|
||||
finally
|
||||
ArgList.Free;
|
||||
end;
|
||||
Result := BasePart + '<' + OutArgs + '>';
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.FindTypeOrInstantiate(const AName: string): TTypeDesc;
|
||||
var
|
||||
BaseName: string;
|
||||
|
|
@ -818,7 +873,9 @@ end;
|
|||
function TSemanticAnalyser.SubstTypeParam(const ATypeName: string;
|
||||
AParamNames, AArgs: TStringList): string;
|
||||
var
|
||||
I: Integer;
|
||||
I, BrOpen, BrClose: Integer;
|
||||
BasePart, ArgsPart, OutArgs, Arg: string;
|
||||
ArgList: TStringList;
|
||||
begin
|
||||
Result := ATypeName;
|
||||
{ Direct match: T → Integer }
|
||||
|
|
@ -830,7 +887,47 @@ begin
|
|||
end;
|
||||
{ Prefix caret: ^T → ^Integer, ^^T → ^^Integer, etc. }
|
||||
if (Length(Result) > 0) and (Result[1] = '^') then
|
||||
begin
|
||||
Result := '^' + Self.SubstTypeParam(Copy(Result, 2, MaxInt), AParamNames, AArgs);
|
||||
Exit;
|
||||
end;
|
||||
{ Generic instantiation: SomeName<T,...> — substitute each type argument }
|
||||
BrOpen := Pos('<', Result);
|
||||
if BrOpen > 0 then
|
||||
begin
|
||||
BrClose := Length(Result); { closing '>' is always the last char }
|
||||
BasePart := Copy(Result, 1, BrOpen - 1);
|
||||
ArgsPart := Copy(Result, BrOpen + 1, BrClose - BrOpen - 1);
|
||||
ArgList := TStringList.Create;
|
||||
try
|
||||
while ArgsPart <> '' do
|
||||
begin
|
||||
I := Pos(',', ArgsPart);
|
||||
if I > 0 then
|
||||
begin
|
||||
ArgList.Add(Trim(Copy(ArgsPart, 1, I - 1)));
|
||||
ArgsPart := Trim(Copy(ArgsPart, I + 1, MaxInt));
|
||||
end
|
||||
else
|
||||
begin
|
||||
ArgList.Add(Trim(ArgsPart));
|
||||
ArgsPart := '';
|
||||
end;
|
||||
end;
|
||||
OutArgs := '';
|
||||
for I := 0 to ArgList.Count - 1 do
|
||||
begin
|
||||
Arg := Self.SubstTypeParam(ArgList.Strings[I], AParamNames, AArgs);
|
||||
if OutArgs = '' then
|
||||
OutArgs := Arg
|
||||
else
|
||||
OutArgs := OutArgs + ',' + Arg;
|
||||
end;
|
||||
finally
|
||||
ArgList.Free;
|
||||
end;
|
||||
Result := BasePart + '<' + OutArgs + '>';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.InstantiateGeneric(const ATypeName: string): TRecordTypeDesc;
|
||||
|
|
@ -848,11 +945,15 @@ var
|
|||
NewMDecl: TMethodDecl;
|
||||
Par: TMethodParam;
|
||||
NewPar: TMethodParam;
|
||||
PDecl: TPropertyDecl;
|
||||
NewPDecl: TPropertyDecl;
|
||||
Sym: TSymbol;
|
||||
Key: string;
|
||||
FldType: TTypeDesc;
|
||||
FldName: string;
|
||||
ParType: TTypeDesc;
|
||||
PropType: TTypeDesc;
|
||||
PropInfo: TPropertyInfo;
|
||||
RT: TRecordTypeDesc;
|
||||
GI: TGenericInstance;
|
||||
Subst: string;
|
||||
|
|
@ -947,6 +1048,20 @@ begin
|
|||
ClonedCD.Methods.Add(NewMDecl);
|
||||
end;
|
||||
|
||||
{ Clone property declarations with type-param substitution }
|
||||
for I := 0 to Templ.ClassDef.Properties.Count - 1 do
|
||||
begin
|
||||
PDecl := TPropertyDecl(Templ.ClassDef.Properties.Items[I]);
|
||||
NewPDecl := TPropertyDecl.Create;
|
||||
NewPDecl.Name := PDecl.Name;
|
||||
NewPDecl.TypeName := SubstTypeParam(PDecl.TypeName, Templ.ParamNames, Args);
|
||||
NewPDecl.ReadName := PDecl.ReadName;
|
||||
NewPDecl.WriteName := PDecl.WriteName;
|
||||
NewPDecl.IndexParamName := PDecl.IndexParamName;
|
||||
NewPDecl.IndexTypeName := SubstTypeParam(PDecl.IndexTypeName, Templ.ParamNames, Args);
|
||||
ClonedCD.Properties.Add(NewPDecl);
|
||||
end;
|
||||
|
||||
{ Pre-pass: vtable slots (before fields so vptr is counted in offsets) }
|
||||
for J := 0 to ClonedCD.Methods.Count - 1 do
|
||||
begin
|
||||
|
|
@ -1012,6 +1127,39 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
{ Resolve property declarations — type-param already substituted in clone pass }
|
||||
for J := 0 to ClonedCD.Properties.Count - 1 do
|
||||
begin
|
||||
NewPDecl := TPropertyDecl(ClonedCD.Properties.Items[J]);
|
||||
PropType := FindTypeOrInstantiate(NewPDecl.TypeName);
|
||||
if PropType = nil then
|
||||
SemanticError(
|
||||
Format('Unknown type ''%s'' for property ''%s'' in ''%s''',
|
||||
[NewPDecl.TypeName, NewPDecl.Name, ATypeName]),
|
||||
0, 0);
|
||||
PropInfo := TPropertyInfo.Create;
|
||||
PropInfo.Name := NewPDecl.Name;
|
||||
PropInfo.TypeDesc := PropType;
|
||||
if NewPDecl.ReadName <> '' then
|
||||
begin
|
||||
if RT.FindField(NewPDecl.ReadName) <> nil then
|
||||
PropInfo.ReadField := NewPDecl.ReadName
|
||||
else
|
||||
PropInfo.ReadMethod := NewPDecl.ReadName;
|
||||
end;
|
||||
if NewPDecl.WriteName <> '' then
|
||||
begin
|
||||
if RT.FindField(NewPDecl.WriteName) <> nil then
|
||||
PropInfo.WriteField := NewPDecl.WriteName
|
||||
else
|
||||
PropInfo.WriteMethod := NewPDecl.WriteName;
|
||||
end;
|
||||
PropInfo.IndexParamName := NewPDecl.IndexParamName;
|
||||
if NewPDecl.IndexTypeName <> '' then
|
||||
PropInfo.IndexTypeDesc := FindTypeOrInstantiate(NewPDecl.IndexTypeName);
|
||||
RT.AddProperty(PropInfo);
|
||||
end;
|
||||
|
||||
{ Analyse method bodies with concrete types in scope.
|
||||
Push type-param bindings (T=Integer etc.) so that SizeOf(T) and
|
||||
local var declarations like 'var P: ^T' resolve to concrete types. }
|
||||
|
|
@ -3935,6 +4083,15 @@ begin
|
|||
end;
|
||||
|
||||
RecSym := FTable.Lookup(AAccess.RecordName);
|
||||
{ If the name contains '<' and wasn't found, resolve scope-bound type params
|
||||
(e.g. 'TGenEnum<T>' → 'TGenEnum<Integer>' when T=Integer is in scope)
|
||||
and update AAccess.RecordName so codegen sees the concrete instantiation. }
|
||||
if (RecSym = nil) and (Pos('<', AAccess.RecordName) > 0) then
|
||||
begin
|
||||
AAccess.RecordName := ResolveScopeBoundTypeParams(AAccess.RecordName);
|
||||
FindTypeOrInstantiate(AAccess.RecordName);
|
||||
RecSym := FTable.Lookup(AAccess.RecordName);
|
||||
end;
|
||||
if RecSym = nil then
|
||||
begin
|
||||
{ Implicit Self.RecordName.FieldName — RecordName is a field of current class }
|
||||
|
|
|
|||
|
|
@ -67,7 +67,8 @@ uses
|
|||
cp.test.constants,
|
||||
cp.test.external,
|
||||
cp.test.opdf,
|
||||
cp.test.forin;
|
||||
cp.test.forin,
|
||||
cp.test.genericforin;
|
||||
|
||||
var
|
||||
Application: TTestRunner;
|
||||
|
|
|
|||
414
compiler/src/test/pascal/cp.test.genericforin.pas
Normal file
414
compiler/src/test/pascal/cp.test.genericforin.pas
Normal file
|
|
@ -0,0 +1,414 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: BSD-3-Clause
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
unit cp.test.genericforin;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{ Tests for for..in support on generic collections (Step 9b).
|
||||
|
||||
Two blockers:
|
||||
1. InstantiateGeneric doesn't clone TClassTypeDef.Properties with
|
||||
type-param substitution, so 'Current: T' is invisible on the
|
||||
instantiated enumerator type.
|
||||
2. generics.collections.pas has no TListEnumerator<T> +
|
||||
TList<T>.GetEnumerator; the existing for..in class-enumerator
|
||||
protocol path handles everything once those are added. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
uLexer, uParser, uAST, uSymbolTable, uSemantic, uCodeGenQBE;
|
||||
|
||||
type
|
||||
TGenericForInTests = class(TTestCase)
|
||||
private
|
||||
function ParseSrc(const ASrc: string): TProgram;
|
||||
function AnalyseSrc(const ASrc: string): TProgram;
|
||||
function GenIR(const ASrc: string): string;
|
||||
procedure AnalyseExpectError(const ASrc: string);
|
||||
published
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Blocker 1: property cloning in InstantiateGeneric }
|
||||
{ ------------------------------------------------------------------ }
|
||||
procedure TestSemantic_GenericEnumerator_CurrentPropertyVisible;
|
||||
procedure TestSemantic_GenericEnumerator_CurrentPropertyType;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Blocker 2: TListEnumerator<T> + TList<T>.GetEnumerator in RTL }
|
||||
{ ------------------------------------------------------------------ }
|
||||
procedure TestParse_TListEnumerator_IsGenericTypeDef;
|
||||
procedure TestParse_TList_GetEnumerator_Declared;
|
||||
procedure TestSemantic_TList_Integer_HasGetEnumerator;
|
||||
procedure TestSemantic_TListEnumerator_Integer_HasCurrentProperty;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ End-to-end: for..in on TList<Integer> }
|
||||
{ ------------------------------------------------------------------ }
|
||||
procedure TestSemantic_ForIn_GenericList_OK;
|
||||
procedure TestCodegen_ForIn_GenericList_CallsGetEnumerator;
|
||||
procedure TestCodegen_ForIn_GenericList_CallsMoveNext;
|
||||
procedure TestCodegen_ForIn_GenericList_CallsGetCurrent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Source constants }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
const
|
||||
{ Minimal generic enumerator with a property backed by a getter. }
|
||||
SrcGenericEnumerator =
|
||||
'program P;' + LineEnding +
|
||||
'type' + LineEnding +
|
||||
' TGenEnum<T> = class' + LineEnding +
|
||||
' FData: T;' + LineEnding +
|
||||
' FDone: Boolean;' + LineEnding +
|
||||
' function MoveNext: Boolean;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := not Self.FDone;' + LineEnding +
|
||||
' Self.FDone := True' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' function GetCurrent: T;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := Self.FData' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' property Current: T read GetCurrent;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
'begin end.';
|
||||
|
||||
{ A minimal generic collection that exposes GetEnumerator. }
|
||||
SrcGenericCollection =
|
||||
'program P;' + LineEnding +
|
||||
'type' + LineEnding +
|
||||
' TGenEnum<T> = class' + LineEnding +
|
||||
' FData: T;' + LineEnding +
|
||||
' FDone: Boolean;' + LineEnding +
|
||||
' function MoveNext: Boolean;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := not Self.FDone;' + LineEnding +
|
||||
' Self.FDone := True' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' function GetCurrent: T;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := Self.FData' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' property Current: T read GetCurrent;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' TColl<T> = class' + LineEnding +
|
||||
' FItem: T;' + LineEnding +
|
||||
' function GetEnumerator: TGenEnum<T>;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := TGenEnum<T>.Create' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
'var' + LineEnding +
|
||||
' C: TColl<Integer>;' + LineEnding +
|
||||
' X: Integer;' + LineEnding +
|
||||
'begin' + LineEnding +
|
||||
' C := TColl<Integer>.Create;' + LineEnding +
|
||||
' for X in C do' + LineEnding +
|
||||
' WriteLn(X)' + LineEnding +
|
||||
'end.';
|
||||
|
||||
{ Source that requires TList<T> and TListEnumerator<T> from the RTL.
|
||||
Uses a minimal inline definition so the test is self-contained. }
|
||||
SrcTListEnumeratorDecl =
|
||||
'program P;' + LineEnding +
|
||||
'type' + LineEnding +
|
||||
' TListEnumerator<T> = class' + LineEnding +
|
||||
' FList: ^T;' + LineEnding +
|
||||
' FIndex: Integer;' + LineEnding +
|
||||
' FCount: Integer;' + LineEnding +
|
||||
' function MoveNext: Boolean;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Self.FIndex := Self.FIndex + 1;' + LineEnding +
|
||||
' Result := Self.FIndex < Self.FCount' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' function GetCurrent: T;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := (Self.FList + Self.FIndex)^' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' property Current: T read GetCurrent;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' TMyList<T> = class' + LineEnding +
|
||||
' FData: ^T;' + LineEnding +
|
||||
' FCount: Integer;' + LineEnding +
|
||||
' function GetEnumerator: TListEnumerator<T>;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := TListEnumerator<T>.Create' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
'begin end.';
|
||||
|
||||
SrcForInGenericList =
|
||||
'program P;' + LineEnding +
|
||||
'type' + LineEnding +
|
||||
' TListEnumerator<T> = class' + LineEnding +
|
||||
' FList: ^T;' + LineEnding +
|
||||
' FIndex: Integer;' + LineEnding +
|
||||
' FCount: Integer;' + LineEnding +
|
||||
' function MoveNext: Boolean;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Self.FIndex := Self.FIndex + 1;' + LineEnding +
|
||||
' Result := Self.FIndex < Self.FCount' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' function GetCurrent: T;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := (Self.FList + Self.FIndex)^' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' property Current: T read GetCurrent;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' TMyList<T> = class' + LineEnding +
|
||||
' FData: ^T;' + LineEnding +
|
||||
' FCount: Integer;' + LineEnding +
|
||||
' function GetEnumerator: TListEnumerator<T>;' + LineEnding +
|
||||
' begin' + LineEnding +
|
||||
' Result := TListEnumerator<T>.Create' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
' end;' + LineEnding +
|
||||
'var' + LineEnding +
|
||||
' L: TMyList<Integer>;' + LineEnding +
|
||||
' X: Integer;' + LineEnding +
|
||||
'begin' + LineEnding +
|
||||
' L := TMyList<Integer>.Create;' + LineEnding +
|
||||
' for X in L do' + LineEnding +
|
||||
' WriteLn(X)' + LineEnding +
|
||||
'end.';
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Helpers }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function TGenericForInTests.ParseSrc(const ASrc: string): TProgram;
|
||||
var
|
||||
Lex: TLexer;
|
||||
Par: TParser;
|
||||
begin
|
||||
Lex := TLexer.Create(ASrc);
|
||||
Par := TParser.Create(Lex);
|
||||
try
|
||||
Result := Par.Parse;
|
||||
finally
|
||||
Par.Free;
|
||||
Lex.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGenericForInTests.AnalyseSrc(const ASrc: string): TProgram;
|
||||
var
|
||||
SA: TSemanticAnalyser;
|
||||
begin
|
||||
Result := ParseSrc(ASrc);
|
||||
SA := TSemanticAnalyser.Create;
|
||||
try
|
||||
SA.Analyse(Result);
|
||||
finally
|
||||
SA.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGenericForInTests.GenIR(const ASrc: string): string;
|
||||
var
|
||||
CG: TCodeGenQBE;
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := AnalyseSrc(ASrc);
|
||||
CG := TCodeGenQBE.Create;
|
||||
try
|
||||
CG.Generate(Prog);
|
||||
Result := CG.GetOutput;
|
||||
finally
|
||||
CG.Free;
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.AnalyseExpectError(const ASrc: string);
|
||||
var
|
||||
Prog: TProgram;
|
||||
SA: TSemanticAnalyser;
|
||||
begin
|
||||
Prog := ParseSrc(ASrc);
|
||||
SA := TSemanticAnalyser.Create;
|
||||
try
|
||||
try
|
||||
SA.Analyse(Prog);
|
||||
Fail('Expected ESemanticError but none was raised');
|
||||
except
|
||||
on E: ESemanticError do { expected };
|
||||
end;
|
||||
finally
|
||||
SA.Free;
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Blocker 1: property cloning }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TGenericForInTests.TestSemantic_GenericEnumerator_CurrentPropertyVisible;
|
||||
var
|
||||
Prog: TProgram;
|
||||
RT: TRecordTypeDesc;
|
||||
begin
|
||||
Prog := AnalyseSrc(SrcGenericEnumerator);
|
||||
try
|
||||
{ The instantiated type is not used in a var decl, so trigger instantiation
|
||||
by using the collection source which references TGenEnum<Integer>. }
|
||||
{ Use the generic enumerator source that references no concrete param —
|
||||
check that the template class definition itself still parsed the property. }
|
||||
RT := TRecordTypeDesc(Prog.SymbolTable.FindType('TGenEnum'));
|
||||
{ TGenEnum is generic, not a concrete type; FindType should return nil. }
|
||||
AssertNull('TGenEnum is not a concrete type', RT);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestSemantic_GenericEnumerator_CurrentPropertyType;
|
||||
var
|
||||
Prog: TProgram;
|
||||
RT: TRecordTypeDesc;
|
||||
Prop: TPropertyInfo;
|
||||
begin
|
||||
{ Instantiate TGenEnum<Integer> via the collection source }
|
||||
Prog := AnalyseSrc(SrcGenericCollection);
|
||||
try
|
||||
RT := TRecordTypeDesc(Prog.SymbolTable.FindType('TGenEnum<Integer>'));
|
||||
AssertNotNull('TGenEnum<Integer> was instantiated', RT);
|
||||
Prop := RT.FindProperty('Current');
|
||||
AssertNotNull('Current property present on TGenEnum<Integer>', Prop);
|
||||
AssertEquals('Current property type is tyInteger',
|
||||
Ord(tyInteger), Ord(Prop.TypeDesc.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Blocker 2: TListEnumerator<T> + TList<T>.GetEnumerator }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TGenericForInTests.TestParse_TListEnumerator_IsGenericTypeDef;
|
||||
var
|
||||
Prog: TProgram;
|
||||
TD: TTypeDecl;
|
||||
begin
|
||||
Prog := ParseSrc(SrcTListEnumeratorDecl);
|
||||
try
|
||||
AssertEquals('Two type decls', 2, Prog.Block.TypeDecls.Count);
|
||||
TD := TTypeDecl(Prog.Block.TypeDecls[0]);
|
||||
AssertEquals('Name is TListEnumerator', 'TListEnumerator', TD.Name);
|
||||
AssertTrue('Def is TGenericTypeDef', TD.Def is TGenericTypeDef);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestParse_TList_GetEnumerator_Declared;
|
||||
var
|
||||
Prog: TProgram;
|
||||
TD: TTypeDecl;
|
||||
GD: TGenericTypeDef;
|
||||
MD: TMethodDecl;
|
||||
Found: Boolean;
|
||||
I: Integer;
|
||||
begin
|
||||
Prog := ParseSrc(SrcTListEnumeratorDecl);
|
||||
try
|
||||
TD := TTypeDecl(Prog.Block.TypeDecls[1]); { TMyList }
|
||||
GD := TGenericTypeDef(TD.Def);
|
||||
Found := False;
|
||||
for I := 0 to GD.ClassDef.Methods.Count - 1 do
|
||||
begin
|
||||
MD := TMethodDecl(GD.ClassDef.Methods.Items[I]);
|
||||
if MD.Name = 'GetEnumerator' then
|
||||
Found := True;
|
||||
end;
|
||||
AssertTrue('GetEnumerator method declared on TMyList', Found);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestSemantic_TList_Integer_HasGetEnumerator;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
{ A var of TMyList<Integer> should trigger instantiation; semantic must
|
||||
not raise an error (GetEnumerator return type TListEnumerator<Integer>
|
||||
must instantiate transitively). }
|
||||
Prog := AnalyseSrc(SrcForInGenericList);
|
||||
Prog.Free; { no exception = pass }
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestSemantic_TListEnumerator_Integer_HasCurrentProperty;
|
||||
var
|
||||
Prog: TProgram;
|
||||
RT: TRecordTypeDesc;
|
||||
Prop: TPropertyInfo;
|
||||
begin
|
||||
Prog := AnalyseSrc(SrcForInGenericList);
|
||||
try
|
||||
RT := TRecordTypeDesc(Prog.SymbolTable.FindType('TListEnumerator<Integer>'));
|
||||
AssertNotNull('TListEnumerator<Integer> instantiated', RT);
|
||||
Prop := RT.FindProperty('Current');
|
||||
AssertNotNull('Current property on TListEnumerator<Integer>', Prop);
|
||||
AssertEquals('Current type is tyInteger',
|
||||
Ord(tyInteger), Ord(Prop.TypeDesc.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ End-to-end: for..in on TList<Integer> }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TGenericForInTests.TestSemantic_ForIn_GenericList_OK;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := AnalyseSrc(SrcForInGenericList);
|
||||
Prog.Free; { no exception = semantic check passed }
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestCodegen_ForIn_GenericList_CallsGetEnumerator;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcForInGenericList);
|
||||
AssertTrue('IR calls GetEnumerator',
|
||||
Pos('TMyList_Integer_GetEnumerator', IR) > 0);
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestCodegen_ForIn_GenericList_CallsMoveNext;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcForInGenericList);
|
||||
AssertTrue('IR calls MoveNext',
|
||||
Pos('TListEnumerator_Integer_MoveNext', IR) > 0);
|
||||
end;
|
||||
|
||||
procedure TGenericForInTests.TestCodegen_ForIn_GenericList_CallsGetCurrent;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcForInGenericList);
|
||||
AssertTrue('IR calls GetCurrent (Current getter)',
|
||||
Pos('TListEnumerator_Integer_GetCurrent', IR) > 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TGenericForInTests);
|
||||
|
||||
end.
|
||||
Loading…
Reference in a new issue