Forráskód Böngészése

* 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

Sven/Sarah Barth 2 éve
szülő
commit
a20e8b9a3d
2 módosított fájl, 69 hozzáadás és 1 törlés
  1. 1 1
      compiler/pdecl.pas
  2. 68 0
      tests/webtbf/tw40095.pp

+ 1 - 1
compiler/pdecl.pas

@@ -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 - 0
tests/webtbf/tw40095.pp

@@ -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.
+