From e9b87792acd58d9480685da4d2aa604380769fd8 Mon Sep 17 00:00:00 2001
From: Vincent Snijders <vincents@freepascal.org>
Date: Fri, 13 Jul 2007 21:21:39 +0000
Subject: [PATCH] + added test for bug #9141

git-svn-id: trunk@8041 -
---
 .gitattributes         |  1 +
 tests/webtbs/tw9141.pp | 60 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 61 insertions(+)
 create mode 100644 tests/webtbs/tw9141.pp

diff --git a/.gitattributes b/.gitattributes
index ae0abd181b..4996e5efdc 100644
--- a/.gitattributes
+++ b/.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
diff --git a/tests/webtbs/tw9141.pp b/tests/webtbs/tw9141.pp
new file mode 100644
index 0000000000..919bf38bb6
--- /dev/null
+++ b/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.
+