浏览代码

fcl-passrc: resolver: typecast record to record

git-svn-id: trunk@36458 -
Mattias Gaertner 8 年之前
父节点
当前提交
1133e115c3
共有 2 个文件被更改,包括 35 次插入0 次删除
  1. 13 0
      packages/fcl-passrc/src/pasresolver.pp
  2. 22 0
      packages/fcl-passrc/tests/tcresolver.pas

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

@@ -2781,6 +2781,7 @@ begin
       end
     else if (C=TPasClassType)
         or (C=TPasClassOfType)
+        or (C=TPasRecordType)
         or (C=TPasEnumType)
         or (C=TPasProcedureType)
         or (C=TPasFunctionType)
@@ -5460,6 +5461,7 @@ begin
       C:=TypeEl.ClassType;
       if (C=TPasClassType)
           or (C=TPasClassOfType)
+          or (C=TPasRecordType)
           or (C=TPasEnumType)
           or (C=TPasSetType)
           or (C=TPasPointerType)
@@ -11958,6 +11960,17 @@ begin
           Result:=cExact; // untyped pointer to class-of
         end;
       end
+    else if C=TPasRecordType then
+      begin
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasRecordType then
+          begin
+          // typecast record to record
+          Result:=cExact;
+          end;
+        end;
+      end
     else if C=TPasEnumType then
       begin
       if CheckIsOrdinal(FromResolved,ErrorEl,true) then

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

@@ -353,6 +353,7 @@ type
     Procedure TestRecord_WriteConstParam_WithFail;
     Procedure TestRecord_WriteNestedConstParamFail;
     Procedure TestRecord_WriteNestedConstParamWithFail;
+    Procedure TestRecord_TypeCast;
 
     // class
     Procedure TestClass;
@@ -5063,6 +5064,27 @@ begin
   CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
+procedure TTestResolver.TestRecord_TypeCast;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TAnimal = record',
+  '    Size: longint;',
+  '  end;',
+  '  TBird = record',
+  '    Length: longint;',
+  '  end;',
+  'var',
+  '  a: TAnimal;',
+  '  b: TBird;',
+  'begin',
+  '  b:=TBird(a);',
+  '  TAnimal(b).Size:=TBird(a).Length;',
+  '  ']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 begin
   StartProgram(false);