paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 18:49:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: forbid type reference to TGeneric.Something

Browse Source 
git-svn-id: trunk@44203 -
This commit is contained in:
Mattias Gaertner 2020-02-17 12:15:56 +00:00
parent 40a975b803
commit f05b51d7d8
2 changed files with 24 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -20560,6 +20560,10 @@ begin
NeedPop:=true; NeedPop:=true;
if CurScopeEl is TPasType then if CurScopeEl is TPasType then
begin begin
if (CurScopeEl is TPasGenericType)
and not IsFullySpecialized(TPasGenericType(CurScopeEl)) then
RaiseMsg(20200217131215,nGenericsWithoutSpecializationAsType,
sGenericsWithoutSpecializationAsType,['reference'],ErrorEl);
CurScope:=PushDotScope(TPasType(CurScopeEl)); CurScope:=PushDotScope(TPasType(CurScopeEl));
if CurScope=nil then if CurScope=nil then
RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter, RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter,

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

@ -88,6 +88,7 @@ type
procedure TestGen_Class_Self; procedure TestGen_Class_Self;
procedure TestGen_Class_MemberTypeConstructor; procedure TestGen_Class_MemberTypeConstructor;
procedure TestGen_Class_AliasMemberType; procedure TestGen_Class_AliasMemberType;
procedure TestGen_Class_AccessGenericMemberTypeFail;
procedure TestGen_Class_ReferenceTo; // ToDo procedure TestGen_Class_ReferenceTo; // ToDo
procedure TestGen_Class_List; procedure TestGen_Class_List;
// ToDo: different modeswitches at parse time and specialize time // ToDo: different modeswitches at parse time and specialize time
@ -1416,6 +1417,25 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolveGenerics.TestGen_Class_AccessGenericMemberTypeFail;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class end;',
'',
' generic TBird<T> = class',
' public type',
' TRun = reference to function (aValue : T) : T;',
' end;',
' TBirdRun = TBird.TRun;',
'begin',
'']);
CheckResolverException('Generics without specialization cannot be used as a type for a reference',
nGenericsWithoutSpecializationAsType);
end;
procedure TTestResolveGenerics.TestGen_Class_ReferenceTo; procedure TTestResolveGenerics.TestGen_Class_ReferenceTo;
begin begin
exit; exit;