浏览代码

* extend TOrdType by entries for 64-bit values
* have tkInt64 and tkQWord entries also contain the OrdType field (basically the compiler can now use the same function to generate them only with different type kinds)

+ added test

git-svn-id: trunk@35135 -

svenbarth 8 年之前
父节点
当前提交
a9d14fe30b
共有 5 个文件被更改,包括 84 次插入35 次删除
  1. 1 0
      .gitattributes
  2. 19 32
      compiler/ncgrtti.pas
  3. 2 2
      compiler/symconst.pas
  4. 12 1
      rtl/objpas/typinfo.pp
  5. 50 0
      tests/test/trtti13.pp

+ 1 - 0
.gitattributes

@@ -13009,6 +13009,7 @@ tests/test/trtti1.pp svneol=native#text/plain
 tests/test/trtti10.pp svneol=native#text/pascal
 tests/test/trtti11.pp svneol=native#text/pascal
 tests/test/trtti12.pp svneol=native#text/pascal
+tests/test/trtti13.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain

+ 19 - 32
compiler/ncgrtti.pas

@@ -626,8 +626,8 @@ implementation
           const
             trans : array[tordtype] of byte =
               (otUByte{otNone},
-               otUByte,otUWord,otULong,otUByte{otNone},otUByte{otNone},
-               otSByte,otSWord,otSLong,otUByte{otNone},otUByte{otNone},
+               otUByte,otUWord,otULong,otUQWord{otNone},otUByte{otNone},
+               otSByte,otSWord,otSLong,otSQWord{otNone},otUByte{otNone},
                otUByte,otUWord,otULong,otUByte,
                otSByte,otSWord,otSLong,otSByte,
                otUByte,otUWord,otUByte);
@@ -645,8 +645,21 @@ implementation
               targetinfos[target_info.system]^.alignment.recordalignmin,
               targetinfos[target_info.system]^.alignment.maxCrecordalign);
             {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
-            tcb.emit_ord_const(longint(def.low.svalue),s32inttype);
-            tcb.emit_ord_const(longint(def.high.svalue),s32inttype);
+            case trans[def.ordtype] of
+              otUQWord:
+                begin
+                  tcb.emit_ord_const(def.low.uvalue,u64inttype);
+                  tcb.emit_ord_const(def.high.uvalue,u64inttype);
+                end;
+              otSQWord:
+                begin
+                  tcb.emit_ord_const(def.low.svalue,s64inttype);
+                  tcb.emit_ord_const(def.high.svalue,s64inttype);
+                end;
+              else
+                tcb.emit_ord_const(longint(def.low.svalue),s32inttype);
+                tcb.emit_ord_const(longint(def.high.svalue),s32inttype);
+            end;
             tcb.end_anonymous_record;
             tcb.end_anonymous_record;
           end;
@@ -654,35 +667,9 @@ implementation
         begin
           case def.ordtype of
             s64bit :
-              begin
-                write_header(tcb,def,tkInt64);
-                tcb.begin_anonymous_record(
-                  internaltypeprefixName[itp_rtti_ord_64bit],
-                  defaultpacking,reqalign,
-                  targetinfos[target_info.system]^.alignment.recordalignmin,
-                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
-                { low }
-                tcb.emit_ord_const(def.low.svalue,s64inttype);
-                { high }
-                tcb.emit_ord_const(def.high.svalue,s64inttype);
-                tcb.end_anonymous_record;
-              end;
+                dointeger(tkInt64);
             u64bit :
-              begin
-                write_header(tcb,def,tkQWord);
-                tcb.begin_anonymous_record(
-                  internaltypeprefixName[itp_rtti_ord_64bit],
-                  defaultpacking,reqalign,
-                  targetinfos[target_info.system]^.alignment.recordalignmin,
-                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
-                { use svalue because emit_ord_const accepts int64, prevents
-                  range check errors }
-                { low }
-                tcb.emit_ord_const(def.low.svalue,s64inttype);
-                { high }
-                tcb.emit_ord_const(def.high.svalue,s64inttype);
-                tcb.end_anonymous_record;
-              end;
+                dointeger(tkQWord);
             pasbool8:
                 dointeger(tkBool);
             uchar:

+ 2 - 2
compiler/symconst.pas

@@ -75,8 +75,8 @@ const
   otUWord     = 3;
   otSLong     = 4;
   otULong     = 5;
-  otSLongLong = 6;
-  otULongLong = 7;
+  otSQWord    = 6;
+  otUQWord    = 7;
 
   ftSingle   = 0;
   ftDouble   = 1;

+ 12 - 1
rtl/objpas/typinfo.pp

@@ -47,7 +47,7 @@ unit typinfo;
                    tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
                    tkHelper,tkFile,tkClassRef,tkPointer);
 
-       TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
+       TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong,otSQWord,otUQWord);
 
 {$ifndef FPUNONE}
        TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
@@ -261,6 +261,9 @@ unit typinfo;
               ();
             tkAString:
               (CodePage: Word);
+{$ifndef VER3_0}
+            tkInt64,tkQWord,
+{$endif VER3_0}
             tkInteger,tkChar,tkEnumeration,tkBool,tkWChar,tkSet:
               (OrdType : TOrdType;
                case TTypeKind of
@@ -273,6 +276,12 @@ unit typinfo;
                         NameList : ShortString;
                         {EnumUnitName: ShortString;})
                     );
+{$ifndef VER3_0}
+                  tkInt64:
+                    (MinInt64Value, MaxInt64Value: Int64);
+                  tkQWord:
+                    (MinQWordValue, MaxQWordValue: QWord);
+{$endif VER3_0}
                   tkSet:
                     (CompTypeRef : TypeInfoPtr)
               );
@@ -323,10 +332,12 @@ unit typinfo;
               );
             tkProcVar:
               (ProcSig: TProcedureSignature);
+{$ifdef VER3_0}
             tkInt64:
               (MinInt64Value, MaxInt64Value: Int64);
             tkQWord:
               (MinQWordValue, MaxQWordValue: QWord);
+{$endif VER3_0}
             tkInterface:
               (
                IntfParentRef: TypeInfoPtr;

+ 50 - 0
tests/test/trtti13.pp

@@ -0,0 +1,50 @@
+program trtti13;
+
+uses
+  TypInfo;
+
+var
+  error: LongInt = 0;
+
+procedure TestOrdTypeInfo(aTI: PTypeInfo; aTypeKind: TTypeKind; aOrdType: TOrdType);
+var
+  td: PTypeData;
+begin
+  Inc(error);
+  if aTI^.Kind <> aTypeKind then
+    Halt(error);
+
+  td := GetTypeData(aTI);
+
+  Inc(error);
+  if td^.OrdType <> aOrdType then
+    Halt(error);
+end;
+
+begin
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(Int8)), tkInteger, otSByte);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(Int16)), tkInteger, otSWord);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(Int32)), tkInteger, otSLong);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(Int64)), tkInt64, otSQWord);
+
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(UInt8)), tkInteger, otUByte);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(UInt16)), tkInteger, otUWord);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(UInt32)), tkInteger, otULong);
+  TestOrdTypeInfo(PTypeInfo(TypeInfo(UInt64)), tkQWord, otUQWord);
+
+  Inc(error);
+  if GetTypeData(PTypeInfo(TypeInfo(Int64)))^.MinInt64Value <> Low(Int64) then
+    Halt(error);
+
+  Inc(error);
+  if GetTypeData(PTypeInfo(TypeInfo(Int64)))^.MaxInt64Value <> High(Int64) then
+    Halt(error);
+
+  Inc(error);
+  if GetTypeData(PTypeInfo(TypeInfo(UInt64)))^.MinQWordValue <> Low(QWord) then
+    Halt(error);
+
+  Inc(error);
+  if GetTypeData(PTypeInfo(TypeInfo(UInt64)))^.MaxQWordValue <> High(QWord) then
+    Halt(error);
+end.