From b945e66e2807410180709dd0b967e1ebe6cd912a Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 12 Jul 2019 22:07:46 +0000 Subject: [PATCH] * store attribute information in PPU; this is less important for the compiler, but more for e.g. Lazarus when dealing with binary only units * increase ppu version + added test * adjust ppudump to handle attributes as well ToDo: output parameter nodes as well git-svn-id: trunk@42401 - --- .gitattributes | 3 + compiler/ppu.pas | 2 +- compiler/symdef.pas | 156 ++++++++++++++++++++++++++++- compiler/symsym.pas | 17 +++- compiler/utils/ppuutils/ppudump.pp | 81 +++++++++++++++ compiler/utils/ppuutils/ppuout.pp | 20 ++++ tests/test/tcustomattr14.pp | 10 ++ tests/test/ucustomattr14a.pp | 23 +++++ tests/test/ucustomattr14b.pp | 36 +++++++ 9 files changed, 343 insertions(+), 5 deletions(-) create mode 100644 tests/test/tcustomattr14.pp create mode 100644 tests/test/ucustomattr14a.pp create mode 100644 tests/test/ucustomattr14b.pp diff --git a/.gitattributes b/.gitattributes index a20dbba0b1..ff0cf6774e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13210,6 +13210,7 @@ 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/tcustomattr14.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 @@ -14222,6 +14223,8 @@ tests/test/tx64ccnv.pp svneol=native#text/plain tests/test/uabstrcl.pp svneol=native#text/plain tests/test/uchlp12.pp svneol=native#text/pascal tests/test/uchlp18.pp svneol=native#text/pascal +tests/test/ucustomattr14a.pp svneol=native#text/pascal +tests/test/ucustomattr14b.pp svneol=native#text/pascal tests/test/udots.moredots.unit7.pp svneol=native#text/pascal tests/test/udots.moredots.unit8.pp svneol=native#text/pascal tests/test/udots.udots.unit4.pp svneol=native#text/pascal diff --git a/compiler/ppu.pas b/compiler/ppu.pas index d002a51f4d..a8592b1196 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -50,7 +50,7 @@ const CurrentPPUVersion = 207; { for any other changes to the ppu format, increase this version number (it's a cardinal) } - CurrentPPULongVersion = 2; + CurrentPPULongVersion = 3; { unit flags } uf_big_endian = $000004; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index af0c957295..7cf650ff7f 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -62,11 +62,20 @@ interface trtti_attribute = class typesym : tsym; + typesymderef : tderef; typeconstr : tdef; + typeconstrderef : tderef; + { these two are not stored in PPU } constructorcall : tnode; constructorpd : tdef; paras : array of tnode; + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile); + procedure ppuload_subentries(ppufile:tcompilerppufile); + procedure ppuwrite_subentries(ppufile:tcompilerppufile); destructor destroy;override; + procedure buildderef; + procedure deref; end; trtti_attribute_list = class @@ -75,8 +84,16 @@ interface is_bound : Boolean; class procedure bind(var dangling,owned:trtti_attribute_list); procedure addattribute(atypesym:tsym;typeconstr:tdef;constructorcall:tnode;constref paras:array of tnode); + procedure addattribute(attr:trtti_attribute); destructor destroy; override; function get_attribute_count:longint; + procedure buildderef; + procedure deref; + + class function ppuload(ppufile:tcompilerppufile):trtti_attribute_list; + class procedure ppuwrite(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); + class procedure ppuload_subentries(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); + class procedure ppuwrite_subentries(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); end; { tstoreddef } @@ -1965,6 +1982,7 @@ implementation end; if df_specialization in defoptions then ppufile.getderef(genericdefderef); + rtti_attribute_list:=trtti_attribute_list.ppuload(ppufile); end; @@ -2138,18 +2156,19 @@ implementation ppufile.do_crc:=oldintfcrc; if df_specialization in defoptions then ppufile.putderef(genericdefderef); + trtti_attribute_list.ppuwrite(rtti_attribute_list,ppufile); end; procedure tstoreddef.ppuload_subentries(ppufile: tcompilerppufile); begin - { by default: do nothing } + trtti_attribute_list.ppuload_subentries(rtti_attribute_list,ppufile); end; procedure tstoreddef.ppuwrite_subentries(ppufile: tcompilerppufile); begin - { by default: do nothing } + trtti_attribute_list.ppuwrite_subentries(rtti_attribute_list,ppufile); end; @@ -2163,6 +2182,8 @@ implementation register_def; typesymderef.build(typesym); genericdefderef.build(genericdef); + if assigned(rtti_attribute_list) then + rtti_attribute_list.buildderef; if assigned(genconstraintdata) then genconstraintdata.buildderef; if assigned(genericparas) then @@ -2193,6 +2214,8 @@ implementation typesym:=ttypesym(typesymderef.resolve); if df_specialization in defoptions then genericdef:=tstoreddef(genericdefderef.resolve); + if assigned(rtti_attribute_list) then + rtti_attribute_list.deref; if assigned(genconstraintdata) then genconstraintdata.deref; if assigned(genericparas) then @@ -2913,6 +2936,35 @@ implementation TRTTI_ATTRIBUTE_LIST ****************************************************************************} + constructor trtti_attribute.ppuload(ppufile: tcompilerppufile); + begin + ppufile.getderef(typesymderef); + ppufile.getderef(typeconstrderef); + setlength(paras,ppufile.getlongint); + end; + + procedure trtti_attribute.ppuwrite(ppufile: tcompilerppufile); + begin + ppufile.putderef(typesymderef); + ppufile.putderef(typeconstrderef); + ppufile.putlongint(length(paras)); + end; + + procedure trtti_attribute.ppuload_subentries(ppufile: tcompilerppufile); + var + i : sizeint; + begin + for i:=0 to high(paras) do + paras[i]:=ppuloadnodetree(ppufile); + end; + + procedure trtti_attribute.ppuwrite_subentries(ppufile: tcompilerppufile); + var + i : sizeint; + begin + for i:=0 to high(paras) do + ppuwritenodetree(ppufile,paras[i]); + end; destructor trtti_attribute.destroy; var @@ -2924,6 +2976,26 @@ implementation inherited destroy; end; + procedure trtti_attribute.buildderef; + var + i : sizeint; + begin + typesymderef.build(typesym); + typeconstrderef.build(typeconstr); + for i:=0 to high(paras) do + paras[i].buildderefimpl; + end; + + procedure trtti_attribute.deref; + var + i : sizeint; + begin + typesym:=tsym(typesymderef.resolve); + typeconstr:=tdef(typeconstrderef.resolve); + for i:=0 to high(paras) do + paras[i].derefimpl; + end; + class procedure trtti_attribute_list.bind(var dangling,owned:trtti_attribute_list); begin if assigned(owned) then @@ -2955,6 +3027,13 @@ implementation rtti_attributes.Add(newattribute); end; + procedure trtti_attribute_list.addattribute(attr:trtti_attribute); + begin + if not assigned(rtti_attributes) then + rtti_attributes:=TFPObjectList.Create(true); + rtti_attributes.add(attr); + end; + destructor trtti_attribute_list.destroy; var i : longint; @@ -2976,6 +3055,79 @@ implementation result:=0; end; + procedure trtti_attribute_list.buildderef; + var + i : sizeint; + begin + if not assigned(rtti_attributes) then + exit; + for i:=0 to rtti_attributes.count-1 do + trtti_attribute(rtti_attributes[i]).buildderef; + end; + + procedure trtti_attribute_list.deref; + var + i : sizeint; + begin + if not assigned(rtti_attributes) then + exit; + for i:=0 to rtti_attributes.count-1 do + trtti_attribute(rtti_attributes[i]).deref; + end; + + class procedure trtti_attribute_list.ppuload_subentries(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); + var + i : sizeint; + begin + if assigned(attrlist) then + begin + if not assigned(attrlist.rtti_attributes) then + internalerror(2019071101); + for i:=0 to attrlist.rtti_attributes.count-1 do + trtti_attribute(attrlist.rtti_attributes[i]).ppuload_subentries(ppufile); + end; + end; + + class procedure trtti_attribute_list.ppuwrite_subentries(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); + var + i : sizeint; + begin + if assigned(attrlist) and assigned(attrlist.rtti_attributes) then + begin + for i:=0 to attrlist.rtti_attributes.count-1 do + trtti_attribute(attrlist.rtti_attributes[i]).ppuwrite_subentries(ppufile); + end; + end; + + class function trtti_attribute_list.ppuload(ppufile:tcompilerppufile):trtti_attribute_list; + var + cnt,i : longint; + begin + cnt:=ppufile.getlongint; + if cnt>0 then + begin + result:=trtti_attribute_list.create; + for i:=0 to cnt-1 do + result.addattribute(trtti_attribute.ppuload(ppufile)); + end + else + result:=nil; + end; + + class procedure trtti_attribute_list.ppuwrite(attrlist:trtti_attribute_list;ppufile:tcompilerppufile); + var + i : longint; + begin + if assigned(attrlist) and assigned(attrlist.rtti_attributes) then + begin + ppufile.putlongint(attrlist.rtti_attributes.count); + for i:=0 to attrlist.rtti_attributes.count-1 do + trtti_attribute(attrlist.rtti_attributes[i]).ppuwrite(ppufile); + end + else + ppufile.putlongint(0); + end; + {**************************************************************************** TORDDEF diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 2288747d7f..bffa88cc39 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -56,6 +56,7 @@ interface procedure ppuload_subentries(ppufile:tcompilerppufile);virtual; { this is called directly after ppuwrite } procedure ppuwrite_subentries(ppufile:tcompilerppufile);virtual; + procedure deref; override; procedure buildderef; override; procedure register_sym; override; end; @@ -572,6 +573,7 @@ implementation deprecatedmsg:=ppufile.getpshortstring else deprecatedmsg:=nil; + rtti_attribute_list:=trtti_attribute_list.ppuload(ppufile); end; @@ -596,18 +598,27 @@ implementation if sp_has_deprecated_msg in symoptions then ppufile.putstring(deprecatedmsg^); ppufile.do_interface_crc:=oldintfcrc; + trtti_attribute_list.ppuwrite(rtti_attribute_list,ppufile); end; procedure tstoredsym.ppuload_subentries(ppufile: tcompilerppufile); begin - { by default: do nothing } + trtti_attribute_list.ppuload_subentries(rtti_attribute_list,ppufile); end; procedure tstoredsym.ppuwrite_subentries(ppufile: tcompilerppufile); begin - { by default: do nothing } + trtti_attribute_list.ppuwrite_subentries(rtti_attribute_list,ppufile); + end; + + + procedure tstoredsym.deref; + begin + inherited; + if assigned(rtti_attribute_list) then + rtti_attribute_list.deref; end; @@ -616,6 +627,8 @@ implementation inherited; if not registered then register_sym; + if assigned(rtti_attribute_list) then + rtti_attribute_list.buildderef; end; diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 7e323c8c8b..7009bd803e 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -1688,6 +1688,79 @@ begin writeln(Visibility2Str(i)); end; +procedure readattrs(def: TPpuDef); +var + i,cnt,paras: longint; +begin + cnt:=ppufile.getlongint; + if cnt>0 then + begin + writeln([space,' Attributes : ']); + space:=' '+space; + if assigned(def) then + SetLength(def.Attrs,cnt); + for i:=0 to cnt-1 do + begin + writeln([space,'** Custom Attribute ',i,' **']); + write ([space,' Type symbol : ']); + if assigned(def) then + begin + def.Attrs[i].TypeSym:=TPpuRef.Create; + readderef('',def.Attrs[i].TypeSym); + end + else + readderef(''); + write ([space,' Type constructor : ']); + if assigned(def) then + begin + def.Attrs[i].TypeConstr:=TPpuRef.Create; + readderef('',def.Attrs[i].TypeConstr); + end + else + readderef(''); + paras:=ppufile.getlongint; + writeln([space,' Parameters : ',paras]); + if assigned(def) then + def.Attrs[i].ParaCount:=paras; + end; + delete(space,1,4); + end; +end; + +procedure readnodetree; forward; + +procedure readattrparas(def: TPpuDef); +var + attr,para: LongInt; +begin + if Length(def.Attrs) > 0 then + writeln([space,' Attr Paras : ']); + space:=' '+space; + for attr:=0 to High(def.Attrs) do + begin + writeln([space,'** Custom Attribute ',attr,' Arguments **']); + space:=' '+space; + for para:=0 to def.Attrs[attr].ParaCount-1 do + begin + readnodetree; + end; + delete(space,1,4); + end; + delete(space,1,4); +end; + +procedure readdefsubentries(def: TPpuDef); +begin + space:=' '+space; + readattrparas(def); + delete(space,1,4); +end; + +procedure readsymsubentries(def: TPpuDef); +begin + readattrparas(def); +end; + procedure readcommonsym(const s:string; Def: TPpuDef = nil); var i: integer; @@ -1707,6 +1780,7 @@ begin readvisibility(Def); write ([space,' SymOptions : ']); readsymoptions(space+' ',Def); + readattrs(Def); end; @@ -2643,6 +2717,9 @@ begin write ([space,' Orig. GenericDef : ']); readderef(''); end; + space:=space+' '; + readattrs(def); + delete(space,1,4); current_defoptions:=defoptions; end; @@ -3652,6 +3729,8 @@ begin WriteError('!! Skipping unsupported PPU Entry in Symbols: '+IntToStr(b)); end; end; + if assigned(def) then + readsymsubentries(def); if (def <> nil) and (def.Parent = nil) then def.Free; if not EndOfEntry then @@ -4375,6 +4454,8 @@ begin WriteError('!! Skipping unsupported PPU Entry in definitions: '+IntToStr(b)); end; end; + if assigned(def) then + readdefsubentries(def); if (def <> nil) and (def.Parent = nil) then def.Free; if not EndOfEntry then diff --git a/compiler/utils/ppuutils/ppuout.pp b/compiler/utils/ppuutils/ppuout.pp index 3dd14694aa..8860da6a1a 100644 --- a/compiler/utils/ppuutils/ppuout.pp +++ b/compiler/utils/ppuutils/ppuout.pp @@ -97,6 +97,12 @@ type TPpuDefVisibility = (dvPublic, dvPublished, dvProtected, dvPrivate, dvHidden); + TPpuAttr = record + ParaCount: LongInt; + TypeSym: TPpuRef; + TypeConstr: TPpuRef; + end; + { TPpuDef } TPpuDef = class @@ -121,6 +127,7 @@ type // Symbol/definition reference Ref: TPpuRef; Visibility: TPpuDefVisibility; + Attrs: array of TPpuAttr; constructor Create(AParent: TPpuContainerDef); virtual; reintroduce; destructor Destroy; override; @@ -1503,6 +1510,8 @@ begin end; procedure TPpuDef.WriteDef(Output: TPpuOutput); +var + i: SizeInt; begin with Output do begin if FId <> InvalidId then @@ -1523,6 +1532,17 @@ begin end; if Visibility <> dvPublic then WriteStr('Visibility', DefVisibilityNames[Visibility]); + if Length(Attrs) > 0 then begin + WriteArrayStart('Attributes'); + for i:=0 to High(Attrs) do begin + WriteObjectStart(''); + Attrs[i].TypeSym.Write(Output, 'TypeSym'); + Attrs[i].TypeConstr.Write(Output, 'TypeConstr'); + WriteInt('ParaCount', Attrs[i].ParaCount, False); + WriteObjectEnd(''); + end; + WriteArrayEnd('Attributes'); + end; end; end; diff --git a/tests/test/tcustomattr14.pp b/tests/test/tcustomattr14.pp new file mode 100644 index 0000000000..0b877c0123 --- /dev/null +++ b/tests/test/tcustomattr14.pp @@ -0,0 +1,10 @@ +{ %NORUN } +{ %RECOMPILE } + +program tcustomattr14; + +uses + ucustomattr14b; + +begin +end. diff --git a/tests/test/ucustomattr14a.pp b/tests/test/ucustomattr14a.pp new file mode 100644 index 0000000000..7f00a6d930 --- /dev/null +++ b/tests/test/ucustomattr14a.pp @@ -0,0 +1,23 @@ +unit ucustomattr14a; + +{$mode objfpc}{$H+} + +interface + +type + TTestAttribute = class(TCustomAttribute) + end; + + TTest2Attribute = class(TCustomAttribute) + constructor Create(const aStr: String); + end; + +implementation + +constructor TTest2Attribute.Create(const aStr: String); +begin + +end; + +end. + diff --git a/tests/test/ucustomattr14b.pp b/tests/test/ucustomattr14b.pp new file mode 100644 index 0000000000..b1926cb9e1 --- /dev/null +++ b/tests/test/ucustomattr14b.pp @@ -0,0 +1,36 @@ +unit ucustomattr14b; + +{$mode objfpc}{$H+} +{$modeswitch prefixedattributes} + +interface + +uses + ucustomattr14a; + +type + [TTest] + TMyClass = class + + end; + + [TTest2('Hello World')] + TMyClass2 = class + + end; + + {$M+} + TMyClass3 = class + private + fTest: LongInt; + published + [TTest2('Foobar')] + [TTest] + property Test: LongInt read fTest; + end; + {$M-} + +implementation + +end. +