paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 14:10:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow use of multiple, comma separated attributes as Delphi allows that as well

Browse Source 
+ added test

git-svn-id: trunk@42409 -
This commit is contained in:
svenbarth 2019-07-12 22:08:14 +00:00
parent 6d0c470a40
commit 87458a065c
3 changed files with 112 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13215,6 +13215,7 @@ tests/test/tcustomattr15.pp svneol=native#text/pascal
tests/test/tcustomattr16.pp svneol=native#text/pascal tests/test/tcustomattr16.pp svneol=native#text/pascal
tests/test/tcustomattr17.pp svneol=native#text/pascal tests/test/tcustomattr17.pp svneol=native#text/pascal
tests/test/tcustomattr18.pp svneol=native#text/pascal tests/test/tcustomattr18.pp svneol=native#text/pascal
tests/test/tcustomattr19.pp svneol=native#text/pascal
tests/test/tcustomattr2.pp svneol=native#text/pascal tests/test/tcustomattr2.pp svneol=native#text/pascal
tests/test/tcustomattr3.pp svneol=native#text/pascal tests/test/tcustomattr3.pp svneol=native#text/pascal
tests/test/tcustomattr4.pp svneol=native#text/pascal tests/test/tcustomattr4.pp svneol=native#text/pascal

139
compiler/pdecl.pas
View File

@ -436,85 +436,88 @@ implementation
begin begin
consume(_LECKKLAMMER); consume(_LECKKLAMMER);
{ Parse attribute type } repeat
p:=factor(false,[ef_type_only,ef_check_attr_suffix]); { Parse attribute type }
if p.nodetype=typen then p:=factor(false,[ef_type_only,ef_check_attr_suffix]);
begin if p.nodetype=typen then
typesym:=ttypesym(ttypenode(p).typesym); begin
od:=tobjectdef(ttypenode(p).typedef); typesym:=ttypesym(ttypenode(p).typesym);
od:=tobjectdef(ttypenode(p).typedef);
{ Check if the attribute class is related to TCustomAttribute } { Check if the attribute class is related to TCustomAttribute }
if not is_system_custom_attribute_descendant(od) then if not is_system_custom_attribute_descendant(od) then
incompatibletypes(od,class_tcustomattribute); incompatibletypes(od,class_tcustomattribute);
paran:=read_attr_paras; paran:=read_attr_paras;
{ Search the tprocdef of the constructor which has to be called. } { Search the tprocdef of the constructor which has to be called. }
constrsym:=find_create_constructor(od); constrsym:=find_create_constructor(od);
if constrsym.typ<>procsym then if constrsym.typ<>procsym then
internalerror(2018102301); internalerror(2018102301);
pcalln:=ccallnode.create(paran,tprocsym(constrsym),od.symtable,cloadvmtaddrnode.create(p),[],nil); pcalln:=ccallnode.create(paran,tprocsym(constrsym),od.symtable,cloadvmtaddrnode.create(p),[],nil);
p:=nil; p:=nil;
typecheckpass(pcalln); typecheckpass(pcalln);
if (pcalln.nodetype=calln) and assigned(tcallnode(pcalln).procdefinition) and not codegenerror then if (pcalln.nodetype=calln) and assigned(tcallnode(pcalln).procdefinition) and not codegenerror then
begin begin
{ TODO: once extended RTTI for methods is supported, reject a { TODO: once extended RTTI for methods is supported, reject a
constructor if it doesn't have extended RTTI enabled } constructor if it doesn't have extended RTTI enabled }
{ collect the parameters of the call node as there might be { collect the parameters of the call node as there might be
compile time type conversions (e.g. a Byte parameter being compile time type conversions (e.g. a Byte parameter being
passed a value > 255) } passed a value > 255) }
paran:=tcallnode(pcalln).left; paran:=tcallnode(pcalln).left;
{ only count visible parameters (thankfully open arrays are not { only count visible parameters (thankfully open arrays are not
supported, otherwise we'd need to handle those as well) } supported, otherwise we'd need to handle those as well) }
paras:=nil; paras:=nil;
if assigned(paran) then if assigned(paran) then
begin begin
ptmp:=paran; ptmp:=paran;
pcount:=0; pcount:=0;
while assigned(ptmp) do while assigned(ptmp) do
begin begin
if not (vo_is_hidden_para in tcallparanode(ptmp).parasym.varoptions) then if not (vo_is_hidden_para in tcallparanode(ptmp).parasym.varoptions) then
inc(pcount);
ptmp:=tcallparanode(ptmp).right;
end;
setlength(paras,pcount);
ptmp:=paran;
pcount:=0;
while assigned(ptmp) do
begin
if not (vo_is_hidden_para in tcallparanode(ptmp).parasym.varoptions) then
begin
if not is_constnode(tcallparanode(ptmp).left) then
internalerror(2019070601);
paras[high(paras)-pcount]:=tcallparanode(ptmp).left.getcopy;
inc(pcount); inc(pcount);
end; ptmp:=tcallparanode(ptmp).right;
ptmp:=tcallparanode(ptmp).right; end;
end; setlength(paras,pcount);
end; ptmp:=paran;
pcount:=0;
while assigned(ptmp) do
begin
if not (vo_is_hidden_para in tcallparanode(ptmp).parasym.varoptions) then
begin
if not is_constnode(tcallparanode(ptmp).left) then
internalerror(2019070601);
paras[high(paras)-pcount]:=tcallparanode(ptmp).left.getcopy;
inc(pcount);
end;
ptmp:=tcallparanode(ptmp).right;
end;
end;
{ Add attribute to attribute list which will be added { Add attribute to attribute list which will be added
to the property which is defined next. } to the property which is defined next. }
if not assigned(rtti_attrs_def) then if not assigned(rtti_attrs_def) then
rtti_attrs_def:=trtti_attribute_list.create; rtti_attrs_def:=trtti_attribute_list.create;
rtti_attrs_def.addattribute(typesym,tcallnode(pcalln).procdefinition,pcalln,paras); rtti_attrs_def.addattribute(typesym,tcallnode(pcalln).procdefinition,pcalln,paras);
end end
else else
pcalln.free; pcalln.free;
end end
else else
begin begin
Message(type_e_type_id_expected); Message(type_e_type_id_expected);
{ try to recover by nevertheless reading the parameters (if any) } { try to recover by nevertheless reading the parameters (if any) }
read_attr_paras.free; read_attr_paras.free;
end; end;
p.free;
until not try_to_consume(_COMMA);
p.free;
consume(_RECKKLAMMER); consume(_RECKKLAMMER);
end; end;

40
tests/test/tcustomattr19.pp Normal file
View File

@ -0,0 +1,40 @@
program tcustomattr19;
{$mode objfpc}
{$modeswitch prefixedattributes}
uses
TypInfo;
type
TTestAttribute = class(TCustomAttribute)
constructor Create;
constructor Create(aArg: LongInt);
end;
[TTestAttribute(42), TTest]
TMyTest = class
end;
var
at: PAttributeTable;
constructor TTestAttribute.Create;
begin
end;
constructor TTestAttribute.Create(aArg: LongInt);
begin
end;
begin
at := GetAttributeTable(TMyTest.ClassInfo);
if not Assigned(at) then
Halt(1);
if at^.AttributeCount <> 2 then
Halt(2);
Writeln('ok');
end.