Browse Source

fcl-passrc: forbid type reference to TGeneric.Something

git-svn-id: trunk@44203 -
Mattias Gaertner 5 years ago
parent
commit
f05b51d7d8

+ 4 - 0
packages/fcl-passrc/src/pasresolver.pp

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

+ 20 - 0
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -88,6 +88,7 @@ type
     procedure TestGen_Class_Self;
     procedure TestGen_Class_MemberTypeConstructor;
     procedure TestGen_Class_AliasMemberType;
+    procedure TestGen_Class_AccessGenericMemberTypeFail;
     procedure TestGen_Class_ReferenceTo; // ToDo
     procedure TestGen_Class_List;
     // ToDo: different modeswitches at parse time and specialize time
@@ -1416,6 +1417,25 @@ begin
   ParseProgram;
 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;
 begin
   exit;