2
0
Эх сурвалжийг харах

fcl-passrc: fixed checking direct class-ancestor cycle

git-svn-id: trunk@36320 -
Mattias Gaertner 8 жил өмнө
parent
commit
ae5492af44

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

@@ -4289,6 +4289,8 @@ begin
     end
   else if AncestorType.ClassType<>TPasClassType then
     RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
+  else if aClass=AncestorType then
+    RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
   else
     begin
     AncestorEl:=TPasClassType(AncestorType);

+ 1 - 1
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -51,7 +51,7 @@ interface
 uses
   Classes, SysUtils, AVL_Tree, PasTree, PScanner,
   {$IFDEF VerbosePasAnalyzer}
-  PasResolveEval
+  PasResolveEval,
   {$ENDIF}
   PasResolver;
 

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

@@ -349,6 +349,7 @@ type
     Procedure TestClass;
     Procedure TestClassDefaultInheritance;
     Procedure TestClassTripleInheritance;
+    Procedure TestClassInheritanceCycleFail;
     Procedure TestClassForward;
     Procedure TestClassForwardAsAncestorFail;
     Procedure TestClassForwardNotResolved;
@@ -4975,6 +4976,15 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClassInheritanceCycleFail;
+begin
+  StartProgram(false);
+  Add([
+  'type A = class(A)',
+  'begin']);
+  CheckResolverException('Ancestor cycle detected',nAncestorCycleDetected);
+end;
+
 procedure TTestResolver.TestClassForward;
 begin
   StartProgram(false);