+ added test for bug #9141

git-svn-id: trunk@8041 -

.gitattributes

@@ -8321,6 +8321,7 @@ tests/webtbs/tw9113.pp svneol=native#text/plain
 tests/webtbs/tw9128.pp svneol=native#text/plain
 tests/webtbs/tw9139.pp svneol=native#text/plain
 tests/webtbs/tw9139a.pp svneol=native#text/plain
+tests/webtbs/tw9141.pp svneol=native#text/plain
 tests/webtbs/tw9145.pp svneol=native#text/plain
 tests/webtbs/tw9162.pp svneol=native#text/plain
 tests/webtbs/tw9167.pp svneol=native#text/plain

tests/webtbs/tw9141.pp

@@ -0,0 +1,60 @@
+{$mode objfpc}{$H+}
+
+uses classes,typinfo;
+type
+  TA = class(TPersistent)
+  private
+    FOnTest: TNotifyEvent;
+    procedure SetOnTest(value: TNotifyEvent);
+  public
+    procedure CallTest;
+  published
+    property OnTest: TNotifyEvent read FOnTest Write SetOnTest;
+  end;  
+
+  TB = class
+  public
+    procedure Test(Sender: TObject);
+  end;
+
+procedure TA.SetOnTest(value: TNotifyEvent);
+begin
+  FOnTest := Value
+end;
+
+procedure TA.CallTest;
+begin
+  if Assigned(FOnTest) then 
+    OnTest(self)
+  else
+    WriteLn('OnTest no set');
+end;
+
+procedure TB.Test(Sender: TObject);
+begin
+  WriteLn('Test Called');
+end;
+
+var
+  A: TA;
+  B: TB;
+  PropInfo: PPropInfo;
+  Method: TMethod;
+begin
+  A := TA.Create;
+  B := TB.Create;
+
+  Method:=TMethod(@B.Test);
+
+  PropInfo:=GetPropInfo(A.ClassInfo, 'OnTest');
+  if Assigned(PropInfo) then begin
+    SetMethodProp(A, PropInfo, Method);
+    WriteLn('Testing SetMethodProp method');
+    A.CallTest;
+  end 
+  else begin
+    WriteLn('PropInfo for ''OnTest'' not found');
+    Halt(1);
+  end;
+end.
+