mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 17:47:56 +02:00
* the RTTI of an attribute not only consists of the creation function, but also of the attribute's type, a pointer to the constructor and a data blob containing the constant parameters
+ added test git-svn-id: trunk@42390 -
This commit is contained in:
svenbarth
parent
55d5bdc98d
commit
71fa4d1fe2
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -13209,6 +13209,7 @@ tests/test/tcustomattr1.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr10.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr11.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr12.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr13.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr2.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr3.pp svneol=native#text/pascal
|
||||
tests/test/tcustomattr4.pp svneol=native#text/pascal
|
||||
|
||||
@ -88,6 +88,7 @@ implementation
|
||||
uses
|
||||
cutils,
|
||||
globals,verbose,systems,
|
||||
node,ncal,ncon,
|
||||
fmodule, procinfo,
|
||||
symtable,
|
||||
aasmtai,aasmdata,
|
||||
@ -1773,8 +1774,64 @@ implementation
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.write_attribute_data(tcb:ttai_typedconstbuilder;attr_list:trtti_attribute_list);
|
||||
|
||||
procedure write_args(tbltcb:ttai_typedconstbuilder;attr:trtti_attribute);
|
||||
var
|
||||
argtcb : ttai_typedconstbuilder;
|
||||
arglab : tasmlabel;
|
||||
argdef : tdef;
|
||||
i : sizeint;
|
||||
arglen : word;
|
||||
begin
|
||||
if length(attr.paras)=0 then
|
||||
begin
|
||||
tbltcb.emit_tai(tai_const.Create_16bit(0),u16inttype);
|
||||
tbltcb.emit_tai(tai_const.Create_nil_dataptr,voidpointertype);
|
||||
end
|
||||
else
|
||||
begin
|
||||
current_asmdata.getglobaldatalabel(arglab);
|
||||
|
||||
argtcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
|
||||
|
||||
argtcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
|
||||
arglen:=0;
|
||||
for i:=0 to High(attr.paras) do
|
||||
begin
|
||||
case attr.paras[i].nodetype of
|
||||
niln,
|
||||
ordconstn,
|
||||
realconstn,
|
||||
stringconstn,
|
||||
pointerconstn,
|
||||
guidconstn:
|
||||
inc(arglen,tconstnode(attr.paras[i]).emit_data(argtcb));
|
||||
setconstn:
|
||||
inc(arglen,tsetconstnode(attr.paras[i]).emit_data(argtcb));
|
||||
else
|
||||
internalerror(2019070803);
|
||||
end;
|
||||
end;
|
||||
|
||||
argdef:=argtcb.end_anonymous_record;
|
||||
|
||||
current_asmdata.asmlists[al_rtti].concatlist(
|
||||
argtcb.get_final_asmlist(arglab,argdef,sec_rodata,arglab.name,const_align(sizeof(pint)))
|
||||
);
|
||||
|
||||
argtcb.free;
|
||||
|
||||
{ write argument size and the reference to the argument entry }
|
||||
tbltcb.emit_ord_const(arglen,u16inttype);
|
||||
tbltcb.emit_tai(Tai_const.Create_sym(arglab),voidpointertype);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
count, i: word;
|
||||
count,i,len: word;
|
||||
attr : trtti_attribute;
|
||||
tbltcb : ttai_typedconstbuilder;
|
||||
tbllab : tasmlabel;
|
||||
@ -1797,19 +1854,27 @@ implementation
|
||||
|
||||
tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
|
||||
|
||||
tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
tbltcb.begin_anonymous_record(
|
||||
internaltypeprefixName[itp_rtti_attr_list]+tostr(count),
|
||||
defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
tbltcb.emit_ord_const(count,u16inttype);
|
||||
for i:=0 to count-1 do
|
||||
begin
|
||||
tbltcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
tbltcb.begin_anonymous_record(internaltypeprefixName[itp_rtti_attr_entry],defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin,
|
||||
targetinfos[target_info.system]^.alignment.maxCrecordalign);
|
||||
attr:=trtti_attribute(attr_list.rtti_attributes[i]);
|
||||
|
||||
write_rtti_reference(tbltcb,ttypesym(attr.typesym).typedef,fullrtti);
|
||||
|
||||
tbltcb.emit_procdef_const(tprocdef(tcallnode(attr.constructorcall).procdefinition));
|
||||
|
||||
tbltcb.emit_tai(tai_const.Createname(attr.symbolname,AT_DATA_FORCEINDIRECT,0),cpointerdef.getreusable(ttypesym(attr.typesym).typedef));
|
||||
|
||||
write_args(tbltcb,attr);
|
||||
|
||||
tbltcb.end_anonymous_record;
|
||||
end;
|
||||
tbldef:=tbltcb.end_anonymous_record;
|
||||
@ -1824,6 +1889,7 @@ implementation
|
||||
tcb.emit_tai(Tai_const.Create_sym(tbllab),voidpointertype);
|
||||
end;
|
||||
|
||||
|
||||
function enumsym_compare_name(item1, item2: pointer): Integer;
|
||||
var
|
||||
enum1: tenumsym absolute item1;
|
||||
|
||||
@ -733,6 +733,8 @@ type
|
||||
itp_rtti_common_data,
|
||||
itp_rtti_prop,
|
||||
itp_rtti_ansistr,
|
||||
itp_rtti_attr_list,
|
||||
itp_rtti_attr_entry,
|
||||
itp_rtti_ord_outer,
|
||||
itp_rtti_ord_inner,
|
||||
itp_rtti_ord_64bit,
|
||||
@ -874,6 +876,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
|
||||
'$rtti_common_data$',
|
||||
'$rtti_prop$',
|
||||
'$rtti_ansistr$',
|
||||
'$rtti_attr_list$',
|
||||
'$rtti_attr_entry$',
|
||||
'$rtti_ord_outer$',
|
||||
'$rtti_ord_inner$',
|
||||
'$rtti_ord_64bit$',
|
||||
|
||||
@ -254,8 +254,20 @@ unit TypInfo;
|
||||
{$endif}
|
||||
|
||||
TAttributeProc = function : TCustomAttribute;
|
||||
PAttributeProcList = ^TAttributeProcList;
|
||||
TAttributeProcList = array[0..$ffff] of TAttributeProc;
|
||||
|
||||
TAttributeEntry =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$endif}
|
||||
record
|
||||
AttrType: PPTypeInfo;
|
||||
AttrCtor: CodePointer;
|
||||
AttrProc: TAttributeProc;
|
||||
ArgLen: Word;
|
||||
ArgData: Pointer;
|
||||
end;
|
||||
|
||||
TAttributeEntryList = array[0..$ffff] of TAttributeEntry;
|
||||
|
||||
TAttributeTable =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
@ -263,7 +275,7 @@ unit TypInfo;
|
||||
{$endif}
|
||||
record
|
||||
AttributeCount: word;
|
||||
AttributesList: TAttributeProcList;
|
||||
AttributesList: TAttributeEntryList;
|
||||
end;
|
||||
PAttributeTable = ^TAttributeTable;
|
||||
|
||||
@ -1022,7 +1034,7 @@ begin
|
||||
result := nil
|
||||
else
|
||||
begin
|
||||
result := AttributeTable^.AttributesList[AttributeNr]();
|
||||
result := AttributeTable^.AttributesList[AttributeNr].AttrProc();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
182
tests/test/tcustomattr13.pp
Normal file
182
tests/test/tcustomattr13.pp
Normal file
@ -0,0 +1,182 @@
|
||||
program tcustomattr13;
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch prefixedattributes}
|
||||
|
||||
uses
|
||||
TypInfo, Classes, SysUtils;
|
||||
|
||||
type
|
||||
TString8 = String[8];
|
||||
TSet = set of (One, Two, Three);
|
||||
|
||||
const
|
||||
StrHelloWorld = 'Hello World';
|
||||
StrFoobar = 'Foobar';
|
||||
StrBlubb = 'Blubb';
|
||||
|
||||
ByteVal = $5a;
|
||||
CurrVal = 33.51;
|
||||
CompVal = 1234;
|
||||
SingleVal = 3.14156;
|
||||
SetVal = [One, Three];
|
||||
|
||||
type
|
||||
TMyAttr = class(TCustomAttribute)
|
||||
constructor Create(aByte: Byte; aStr: TString8; aFlt: Single);
|
||||
constructor Create(aStr: AnsiString; aSet: TSet; aPtr: Pointer);
|
||||
constructor Create(aComp: Comp; aCurr: Currency; aGuid: TGUID; aStr: UnicodeString);
|
||||
end;
|
||||
|
||||
[TMyAttr(ByteVal, StrHelloWorld, SingleVal)]
|
||||
[TMyAttr(StrFoobar, SetVal, Nil)]
|
||||
[TMyAttr(CompVal, CurrVal, IInterface, StrBlubb)]
|
||||
TMyClass = class
|
||||
end;
|
||||
|
||||
constructor TMyAttr.CReate(aByte: Byte; aStr: TString8; aFlt: Single);
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TMyAttr.Create(aStr: AnsiString; aSet: TSet; aPtr: Pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TMyAttr.Create(aComp: Comp; aCurr: Currency; aGuid: TGUID; aStr: UnicodeString);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure DumpData(aData: Pointer; aSize: SizeInt);
|
||||
var
|
||||
i: SizeInt;
|
||||
chars: String[16];
|
||||
begin
|
||||
chars := ' ';
|
||||
for i := 0 to aSize - 1 do begin
|
||||
if i mod 16 = 0 then begin
|
||||
if i > 0 then begin
|
||||
Writeln(' ', chars);
|
||||
chars := ' ';
|
||||
end;
|
||||
Write(HexStr(PtrUInt(aData) + i, SizeOF(PtrUInt) * 2), ' ');
|
||||
end;
|
||||
Write(HexStr((PByte(aData) + i)^, 2), ' ');
|
||||
if (PByte(aData)[i] >= $20) and (PByte(aData)[i] < $7F) then
|
||||
chars[(i mod 16) + 1] := Chr(PByte(aData)[i])
|
||||
else
|
||||
chars[(i mod 16) + 1] := '.';
|
||||
end;
|
||||
while aSize mod 16 <> 0 do begin
|
||||
Write(' ');
|
||||
Inc(aSize);
|
||||
end;
|
||||
Writeln(' ', chars);
|
||||
end;
|
||||
|
||||
procedure CheckAttr1(aStrm: TStream);
|
||||
var
|
||||
b: Byte;
|
||||
ss: ShortString;
|
||||
s: Single;
|
||||
begin
|
||||
if aStrm.Read(b, SizeOf(b)) <> SizeOf(b) then
|
||||
Halt(20);
|
||||
if b <> ByteVal then
|
||||
Halt(21);
|
||||
if aStrm.Read(b, SizeOf(b)) <> SizeOf(b) then
|
||||
Halt(22);
|
||||
if b <> Length(StrHelloWorld) then
|
||||
Halt(23);
|
||||
SetLength(ss, b);
|
||||
if aStrm.Read(ss[1], b) <> b then
|
||||
Halt(24);
|
||||
if ss <> StrHelloWorld then
|
||||
Halt(25);
|
||||
if aStrm.Read(s, SizeOf(Single)) <> SizeOf(Single) then
|
||||
Halt(26);
|
||||
if s <> Single(SingleVal) then
|
||||
Halt(27);
|
||||
end;
|
||||
|
||||
procedure CheckAttr2(aStrm: TStream);
|
||||
var
|
||||
p: Pointer;
|
||||
s: TSet;
|
||||
begin
|
||||
if aStrm.Read(p, SizeOf(p)) <> SizeOf(p) then
|
||||
Halt(40);
|
||||
if AnsiString(p) <> StrFoobar then
|
||||
Halt(41);
|
||||
if aStrm.Read(s, SizeOf(s)) <> SizeOf(s) then
|
||||
Halt(42);
|
||||
if s <> SetVal then
|
||||
Halt(43);
|
||||
if aStrm.Read(p, SizeOf(p)) <> SizeOf(p) then
|
||||
Halt(44);
|
||||
if Assigned(p) then
|
||||
Halt(45);
|
||||
end;
|
||||
|
||||
procedure CheckAttr3(aStrm: TStream);
|
||||
var
|
||||
co: Comp;
|
||||
cu: Currency;
|
||||
p: Pointer;
|
||||
g: TGUID;
|
||||
begin
|
||||
if aStrm.Read(co, SizeOf(co)) <> SizeOf(co) then
|
||||
Halt(60);
|
||||
if co <> CompVal then
|
||||
Halt(61);
|
||||
if aStrm.Read(cu, SizeOf(cu)) <> SizeOf(cu) then
|
||||
Halt(62);
|
||||
if cu <> CurrVal then
|
||||
Halt(63);
|
||||
if aStrm.Read(g, SizeOf(g)) <> SizeOf(g) then
|
||||
Halt(64);
|
||||
if not IsEqualGUID(g,TGuid(IInterface)) then
|
||||
Halt(65);
|
||||
if aStrm.Read(p, SizeOf(p)) <> SizeOf(p) then
|
||||
Halt(66);
|
||||
if UnicodeString(p) <> StrBlubb then
|
||||
Halt(67);
|
||||
end;
|
||||
|
||||
type
|
||||
TCheckProc = procedure(aStrm: TStream);
|
||||
|
||||
const
|
||||
CheckProcs: array[0..2] of TCheckProc = (
|
||||
@CheckAttr1,
|
||||
@CheckAttr2,
|
||||
@CheckAttr3
|
||||
);
|
||||
|
||||
var
|
||||
at: PAttributeTable;
|
||||
ae: TAttributeEntry;
|
||||
i: SizeInt;
|
||||
strm: TMemoryStream;
|
||||
begin
|
||||
at := GetAttributeTable(TypeInfo(TMyClass));
|
||||
if at^.AttributeCount = 0 then
|
||||
Halt(1);
|
||||
if at^.AttributeCount > Length(CheckProcs) then
|
||||
Halt(2);
|
||||
|
||||
for i := 0 to at^.AttributeCount - 1 do begin
|
||||
ae := at^.AttributesList[i];
|
||||
if ae.AttrType^ <> TMyAttr.ClassInfo then
|
||||
Halt(3);
|
||||
if not Assigned(ae.AttrCtor) then
|
||||
Halt(4);
|
||||
if not Assigned(ae.AttrProc) then
|
||||
Halt(5);
|
||||
strm:=TMemoryStream.Create;
|
||||
strm.SetSize(ae.ArgLen);
|
||||
Move(ae.ArgData^, strm.Memory^, ae.ArgLen);
|
||||
CheckProcs[i](strm);
|
||||
end;
|
||||
Writeln('ok');
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user