Sfoglia il codice sorgente

fcl-passrc: resolver: fixed error when accessing element of forward class

mattias 3 anni fa
parent
commit
653303274f

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

@@ -21396,6 +21396,9 @@ begin
             and not IsFullySpecialized(TPasGenericType(CurScopeEl)) then
             and not IsFullySpecialized(TPasGenericType(CurScopeEl)) then
           RaiseMsg(20200217131215,nGenericsWithoutSpecializationAsType,
           RaiseMsg(20200217131215,nGenericsWithoutSpecializationAsType,
             sGenericsWithoutSpecializationAsType,['reference'],ErrorEl);
             sGenericsWithoutSpecializationAsType,['reference'],ErrorEl);
+        if (CurScopeEl is TPasClassType) and TPasClassType(CurScopeEl).IsForward then
+          RaiseMsg(20220527113900,nIdentifierNotFound,
+            sIdentifierNotFound,[CurName],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,

+ 18 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -562,6 +562,7 @@ type
     Procedure TestClassForwardDelphiFail;
     Procedure TestClassForwardDelphiFail;
     Procedure TestClassForwardObjFPCProgram;
     Procedure TestClassForwardObjFPCProgram;
     Procedure TestClassForwardObjFPCUnit;
     Procedure TestClassForwardObjFPCUnit;
+    Procedure TestClassForwardNestedTypeFail;
     Procedure TestClass_Method;
     Procedure TestClass_Method;
     Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_MethodImplDuplicateFail;
     Procedure TestClass_MethodImplDuplicateFail;
@@ -9519,6 +9520,23 @@ begin
   ParseUnit;
   ParseUnit;
 end;
 end;
 
 
+procedure TTestResolver.TestClassForwardNestedTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class;',
+  '  TProc = procedure(a: TBird.TEnum);',
+  '  TBird = class',
+  '  type TEnum = (red,blue);',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "TEnum"',nIdentifierNotFound);
+end;
+
 procedure TTestResolver.TestClass_Method;
 procedure TTestResolver.TestClass_Method;
 begin
 begin
   StartProgram(false);
   StartProgram(false);