fcl-passrc: resolver: class-of constant

git-svn-id: trunk@37404 -

packages/fcl-passrc/src/pasresolver.pp

@@ -11178,6 +11178,8 @@ var
 begin
   if (LeftResolved.TypeEl<>nil) and (LeftResolved.TypeEl.ClassType=TPasArrayType) then
     exit; // arrays are checked by element, not by the whole value
+  if ResolveAliasType(LeftResolved.TypeEl) is TPasClassOfType then
+    exit; // class-of are checked only by type, not by value
   RValue:=Eval(RHS,[refAutoConst]);
   if RValue=nil then
     exit; // not a const expression

packages/fcl-passrc/tests/tcresolver.pas

@@ -484,6 +484,7 @@ type
     Procedure TestClass_TypeCast;
     Procedure TestClassOf_AlwaysForward;
     Procedure TestClassOf_ClassOfBeforeClass_FuncResult;
+    Procedure TestClassOf_Const;
 
     // property
     Procedure TestProperty1;
@@ -7898,6 +7899,27 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClassOf_Const;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = TObject;',
+  '  TBirds = class of TBird;',
+  '  TEagles = TBirds;',
+  '  THawk = class(TBird);',
+  'const',
+  '  Hawk: TEagles = THawk;',
+  '  DefaultBirdClasses : Array [1..2] of TEagles = (',
+  '    TBird,',
+  '    THawk',
+  '  );',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProperty1;
 begin
   StartProgram(false);

packages/pastojs/tests/tcmodules.pas

@@ -400,6 +400,7 @@ type
     Procedure TestClassOf_ClassMethodSelf;
     Procedure TestClassOf_TypeCast;
     Procedure TestClassOf_ImplicitFunctionCall;
+    Procedure TestClassOf_Const;
 
     // nested class
     Procedure TestNestedClass_Fail;
@@ -9506,6 +9507,42 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassOf_Const;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = TObject;',
+  '  TBirds = class of TBird;',
+  '  TEagles = TBirds;',
+  '  THawk = class(TBird);',
+  'const',
+  '  Hawk: TEagles = THawk;',
+  '  DefaultBirdClasses : Array [1..2] of TEagles = (',
+  '    TBird,',
+  '    THawk',
+  '  );',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestClassOf_Const',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "THawk", $mod.TObject, function () {',
+    '});',
+    'this.Hawk = $mod.THawk;',
+    'this.DefaultBirdClasses = [$mod.TObject, $mod.THawk];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestNestedClass_Fail;
 begin
   StartProgram(false);