ソースを参照

compiler, rtl: write CodePage for AnsiString RTTI (Delphi compatible), change TTypeData appropriately + test

git-svn-id: trunk@24444 -
paul 12 年 前
コミット
da35b3c601
5 ファイル変更42 行追加5 行削除
  1. 1 0
      .gitattributes
  2. 5 1
      compiler/ncgrtti.pas
  3. 4 3
      rtl/objpas/typinfo.pp
  4. 1 1
      tests/test/trtti6.pp
  5. 31 0
      tests/test/trtti7.pp

+ 1 - 0
.gitattributes

@@ -11690,6 +11690,7 @@ tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
 tests/test/trtti6.pp svneol=native#text/pascal
+tests/test/trtti7.pp svneol=native#text/pascal
 tests/test/tsafecall1.pp svneol=native#text/plain
 tests/test/tsafecall2.pp svneol=native#text/pascal
 tests/test/tsafecall3.pp svneol=native#text/pascal

+ 5 - 1
compiler/ncgrtti.pas

@@ -416,7 +416,11 @@ implementation
         begin
           case def.stringtype of
             st_ansistring:
-              write_header(def,tkAString);
+              begin
+                write_header(def,tkAString);
+                maybe_write_align;
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.encoding));
+              end;
 
             st_widestring:
               write_header(def,tkWString);

+ 4 - 3
rtl/objpas/typinfo.pp

@@ -74,8 +74,6 @@ unit typinfo;
       ptVirtual = 2;
       ptConst = 3;
 
-      tkString = tkSString;
-
    type
       TTypeKinds = set of TTypeKind;
       ShortStringBase = string[255];
@@ -122,8 +120,10 @@ unit typinfo;
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
          case TTypeKind of
-            tkUnKnown,tkLString,tkWString,tkAString,tkVariant,tkUString:
+            tkUnKnown,tkLString,tkWString,tkVariant,tkUString:
               ();
+            tkAString:
+              (CodePage: Word);
             tkInteger,tkChar,tkEnumeration,tkWChar,tkSet:
               (OrdType : TOrdType;
                case TTypeKind of
@@ -263,6 +263,7 @@ unit typinfo;
       TPropList = array[0..65535] of PPropInfo;
 
    const
+      tkString = tkSString;
       tkProcedure = tkProcVar; // for compatibility with Delphi
       tkAny = [Low(TTypeKind)..High(TTypeKind)];
       tkMethods = [tkMethod];

+ 1 - 1
tests/test/trtti6.pp

@@ -1,4 +1,4 @@
-program ptr_classref_test;
+program trtti6;
 
 {$mode objfpc}{$H+}
 

+ 31 - 0
tests/test/trtti7.pp

@@ -0,0 +1,31 @@
+program trtti7;
+
+{$mode delphi}
+
+uses
+  typinfo;
+
+type
+  // RTTI for this type will have 1251 codepage
+  T1251String = type AnsiString(1251);
+
+var
+  S: T1251String = 'Test';
+  Info: PTypeInfo;
+  Data: PTypeData;
+begin
+  // change runtime string codepage to make it different from RTTI value
+  SetCodePage(RawByteString(S), 866, False);
+  // check if runtime codepage is 866
+  if StringCodePage(S) <> 866 then
+    halt(1);
+  // check that it is an ansistring in RTTI
+  Info := TypeInfo(S);
+  WriteLn(Info^.Kind);
+  if Info^.Kind <> tkAString then
+    halt(2);
+  // check that compiletime RTTI is 1251
+  Data := GetTypeData(Info);
+  if Data^.CodePage <> 1251 then
+    halt(3);
+end.