소스 검색

+ test from mantis #14155

git-svn-id: trunk@13401 -
Jonas Maebe 16 년 전
부모
커밋
e8088fd4ec
2개의 변경된 파일65개의 추가작업 그리고 0개의 파일을 삭제
  1. 1 0
      .gitattributes
  2. 64 0
      tests/webtbs/tw14155.pp

+ 1 - 0
.gitattributes

@@ -9193,6 +9193,7 @@ tests/webtbs/tw1412.pp svneol=native#text/plain
 tests/webtbs/tw14134.pp svneol=native#text/plain
 tests/webtbs/tw1414.pp svneol=native#text/plain
 tests/webtbs/tw14143.pp svneol=native#text/plain
+tests/webtbs/tw14155.pp svneol=native#text/plain
 tests/webtbs/tw1416.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain

+ 64 - 0
tests/webtbs/tw14155.pp

@@ -0,0 +1,64 @@
+program project1;
+
+{$mode objfpc}
+
+type
+  TSomeEvent = procedure(Sender: TObject; X, Y, Line: integer; mark: Integer) of object;
+
+type
+  TSubObject = class(TObject)
+  public
+    SomeEvent: TSomeEvent;
+  end;
+
+  TMyObject = class(TObject)
+  private
+    fSub : TSubObject;
+  protected
+    procedure DoSomeEvent(Sender: TObject; X, Y, Line: integer; mark: Integer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function GetSomeEvent: TSomeEvent;
+  end;
+
+constructor TMyObject.Create;
+begin
+  fSub := TSubObject.Create;
+  fSub.SomeEvent := @Self.DoSomeEvent;
+end;
+
+destructor TMyObject.Destroy;
+begin
+  fSub.Free;
+end;
+
+function TMyObject.GetSomeEvent: TSomeEvent;
+begin
+  Result := fSub.SomeEvent;
+end;
+
+procedure TMyObject.DoSomeEvent(Sender: TObject; X, Y, Line: integer; mark: Integer);
+begin
+  writeln('do some event');
+end;
+
+var
+  my : TMyObject;
+  mtd : TMethod;
+type
+  TGetProc = function (): TMethod of object;
+
+begin
+  my := TMyObject.Create;
+
+  mtd := TGetProc(@my.GetSomeEvent)();
+
+  writeln('mtd.Data = ', PtrInt(mtd.Data));
+  writeln('mtd.Code = ', PtrInt(mtd.Code));
+
+  if Assigned(TSomeEvent(mtd)) then
+   TSomeEvent(mtd)(nil,0,0,0,0);
+
+  my.Free;
+end.