Browse Source

fcl-passrc: resolver: error on VarOfTClass:=TClass

git-svn-id: trunk@38545 -
Mattias Gaertner 7 years ago
parent
commit
35a034ea8b
2 changed files with 32 additions and 7 deletions
  1. 17 7
      packages/fcl-passrc/src/pasresolver.pp
  2. 15 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 17 - 7
packages/fcl-passrc/src/pasresolver.pp

@@ -14605,7 +14605,7 @@ begin
     RaiseInternalError(20160922163648);
   LTypeEl:=ResolveAliasType(LHS.TypeEl);
   RTypeEl:=ResolveAliasType(RHS.TypeEl);
-  if LTypeEl=RTypeEl then
+  if (LTypeEl=RTypeEl) and not (RTypeEl is TPasClassOfType) then
     exit(cExact);
 
   {$IFDEF VerbosePasResolver}
@@ -14632,12 +14632,22 @@ begin
       Result:=cExact
     else if (RTypeEl.ClassType=TPasClassOfType) then
       begin
-      // e.g. ImageClass:=AnotherImageClass;
-      Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
-        TPasClassOfType(LTypeEl).DestType,ErrorEl);
-      if (Result=cIncompatible) and RaiseOnIncompatible then
-        RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
-          ['class of '+TPasClassOfType(RTypeEl).DestType.FullName,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
+      if not (RHS.IdentEl is TPasClassOfType) then
+        begin
+        // e.g. ImageClass:=AnotherImageClass;
+        Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
+          TPasClassOfType(LTypeEl).DestType,ErrorEl);
+        if (Result=cIncompatible) and RaiseOnIncompatible then
+          RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+            ['class of '+TPasClassOfType(RTypeEl).DestType.FullName,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
+        end
+      else
+        begin
+        Result:=cIncompatible;
+        if (Result=cIncompatible) and RaiseOnIncompatible then
+          RaiseMsg(20180317103206,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+            ['type class-of','class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
+        end;
       end
     else if (RHS.IdentEl is TPasClassType)
         or ((RHS.IdentEl is TPasAliasType)

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

@@ -531,6 +531,7 @@ type
     Procedure TestClassOf;
     Procedure TestClassOfAlias;
     Procedure TestClassOfNonClassFail;
+    Procedure TestClassOfAssignClassOfFail;
     Procedure TestClassOfIsOperatorFail;
     Procedure TestClassOfAsOperatorFail;
     Procedure TestClassOfIsOperator;
@@ -8829,6 +8830,20 @@ begin
     nIncompatibleTypesGotExpected);
 end;
 
+procedure TTestResolver.TestClassOfAssignClassOfFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TClass = class of TObject;',
+  'var c: TClass;',
+  'begin',
+  '  c:=TClass;']);
+  CheckResolverException('Incompatible types: got "type class-of" expected "class of TObject"',
+    nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestClassOfIsOperatorFail;
 begin
   StartProgram(false);