mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-24 13:49:37 +02:00
compiler, rtl: write CodePage for AnsiString RTTI (Delphi compatible), change TTypeData appropriately + test
git-svn-id: trunk@24444 -
This commit is contained in:
parent
a020440d48
commit
da35b3c601
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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,4 +1,4 @@
|
||||
program ptr_classref_test;
|
||||
program trtti6;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
|
31
tests/test/trtti7.pp
Normal file
31
tests/test/trtti7.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user