mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 23:53:42 +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
|
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),[cnf_no_convert_procvar],nil);
|
||||||
p:=nil;
|
p:=nil;
|
||||||
ecnt:=errorcount;
|
ecnt:=errorcount;
|
||||||
typecheckpass(pcalln);
|
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