mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 19:08:15 +02:00
* fix #40095: when searching a suitable constructor for the custom attribute don't allow the return of a procvar which can happen in Mac/TP procvar modes (like Delphi)
+ added test
This commit is contained in:
parent
78025d90b3
commit
a20e8b9a3d
@ -493,7 +493,7 @@ implementation
|
||||
if constrsym.typ<>procsym then
|
||||
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),[cnf_no_convert_procvar],nil);
|
||||
p:=nil;
|
||||
ecnt:=errorcount;
|
||||
typecheckpass(pcalln);
|
||||
|
68
tests/webtbf/tw40095.pp
Normal file
68
tests/webtbf/tw40095.pp
Normal file
@ -0,0 +1,68 @@
|
||||
{ %FAIL }
|
||||
|
||||
program DelphiAttrCreate;
|
||||
|
||||
{$mode delphi}
|
||||
{$ModeSwitch prefixedattributes}
|
||||
|
||||
uses
|
||||
Classes, TypInfo;
|
||||
|
||||
type
|
||||
MyAttr = class(TCustomAttribute)
|
||||
public
|
||||
constructor Create(const A: Boolean);
|
||||
end;
|
||||
|
||||
TMyObj = class
|
||||
private
|
||||
fProp1: string;
|
||||
published
|
||||
[MyAttr]
|
||||
property Prop1: string read fProp1 write fProp1;
|
||||
end;
|
||||
|
||||
{ MyAttr }
|
||||
|
||||
constructor MyAttr.Create(const A: Boolean);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
O: TMyObj;
|
||||
TypeData: TTypeData;
|
||||
PropList: PPropList;
|
||||
PropInfo: PPropInfo;
|
||||
I, A: Integer;
|
||||
Attribute: TCustomAttribute;
|
||||
AttrFound: array of TClass;
|
||||
begin
|
||||
AttrFound := nil;
|
||||
O := TMyObj.Create;
|
||||
TypeData := GetTypeData(O.ClassInfo)^;
|
||||
if TypeData.PropCount>0 then
|
||||
begin
|
||||
GetMem(PropList, TypeData.PropCount*SizeOf(Pointer));
|
||||
GetPropInfos(O.ClassInfo, PropList);
|
||||
for I := 0 to TypeData.PropCount-1 do
|
||||
begin
|
||||
PropInfo := PropList^[I];
|
||||
if Assigned(PropInfo.AttributeTable) then
|
||||
begin
|
||||
for A := 0 to PropInfo.AttributeTable^.AttributeCount-1 do
|
||||
begin
|
||||
Attribute := PropInfo.AttributeTable^.AttributesList[I].AttrProc;
|
||||
// Writeln(Attribute.ClassName);
|
||||
AttrFound := AttrFound + [Attribute.ClassType];
|
||||
Attribute.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FreeMem(PropList, TypeData.PropCount*SizeOf(Pointer));
|
||||
end;
|
||||
|
||||
if not((Length(AttrFound)=1) and (AttrFound[0]=MyAttr.ClassType)) then
|
||||
Halt(1);
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user