paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 12:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: for-in constrainedgenerictemplate

Browse Source 
git-svn-id: trunk@42950 -
This commit is contained in:
Mattias Gaertner 2019-09-08 15:14:09 +00:00
parent 353fc13257
commit ccc57389cf
2 changed files with 30 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fcl-passrc/src/pasresolver.pp
View File

@ -13843,6 +13843,7 @@ begin
[GetBaseDescription(InResolved)],Loop.StartExpr);
LoTypeEl:=InResolved.LoTypeEl;
writeln('AAA1 TPasResolver.CheckForInClassOrRec ',GetResolverResultDbg(InResolved));
if LoTypeEl=nil then exit;
// check function InVar.GetEnumerator
@ -13851,6 +13852,7 @@ begin
exit;
// find aRecord.GetEnumerator
Getter:=DotScope.FindIdentifier('GetEnumerator');
writeln('AAA2 TPasResolver.CheckForInClassOrRec ',GetObjPath(Getter));
PopScope;
if Getter=nil then
begin
@ -20586,6 +20588,8 @@ begin
Result:=PushRecordDotScope(TPasRecordType(LoType))
else if C=TPasEnumType then
Result:=PushEnumDotScope(HiType,TPasEnumType(LoType))
else if C=TPasGenericTemplateType then
Result:=PushTemplateDotScope(TPasGenericTemplateType(LoType),HiType)
else
Result:=PushHelperDotScope(HiType);
end;

43
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -32,14 +32,15 @@ type
// ToDo: constraint T:Unit2.TBird
// ToDo: constraint T:Unit2.TGen<word>
procedure TestGen_ConstraintSpecialize;
procedure TestGen_ConstraintTSpecializeT;
procedure TestGen_ConstraintTSpecializeWithT;
procedure TestGen_ConstraintTSpecializeAsTFail;
procedure TestGen_TemplNameEqTypeNameFail;
procedure TestGen_ConstraintInheritedMissingRecordFail;
procedure TestGen_ConstraintInheritedMissingClassTypeFail;
procedure TestGen_ConstraintMultiParam;
procedure TestGen_ConstraintMultiParamClassMismatch;
procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
procedure TestGen_ConstraintClassType_ForInT; // ToDo
procedure TestGen_ConstraintClassType_ForInT;
// generic record
procedure TestGen_RecordLocalNameDuplicateFail;
@ -110,7 +111,6 @@ type
procedure TestGen_LocalVar;
procedure TestGen_Statements;
procedure TestGen_InlineSpecializeExpr;
// ToDo: for-in
procedure TestGen_TryExcept;
// ToDo: call
// ToTo: nested proc
@ -328,7 +328,7 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeT;
procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithT;
begin
StartProgram(false);
Add([
@ -358,6 +358,19 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeAsTFail;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' generic TAnt<S> = record v: S; end;',
' generic TBird<T; U: specialize T<word>> = record v: T; end;',
'begin',
'']);
CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
end;
procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
begin
StartProgram(false);
@ -481,7 +494,6 @@ end;
procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
begin
exit; // ToDo
StartProgram(false);
Add([
'{$mode objfpc}',
@ -495,31 +507,28 @@ begin
' generic TAnt<U> = class',
' function GetEnumerator: specialize TEnumerator<U>;',
' end;',
' generic TRedAnt<S> = class(specialize TAnt<S>);',
' generic TBird<S; T: specialize TRedAnt<S>> = class',
' generic TBird<S; T: specialize TAnt<S>> = class',
' m: T;',
' function GetEnumerator: specialize TEnumerator<T>;',
' procedure Fly;',
' end;',
' TFireAnt = class(specialize TRedAnt<word>);',
' generic TEagle<U> = class(specialize TBird<U,TFireAnt>)',
' end;',
' TRedEagle = specialize TEagle<word>;',
'function TEnumerator.MoveNext: boolean;',
'begin',
'end;',
'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
'begin',
'end;',
'function TBird.GetEnumerator: specialize TEnumerator<S>;',
'procedure TBird.Fly;',
'var i: S;',
'begin',
' for i in m do ;',
'end;',
'var',
' r: TRedEagle;',
' a: TAnt<word>;',
' w: word;',
' f: TFireAnt;',
' b: TBird<word,specialize TAnt<word>>;',
'begin',
' for w in r.m do ;',
' for f in r do ;',
' for w in a do ;',
' for w in b.m do ;',
'']);
ParseProgram;
end;