tests: add SafeCallException test

git-svn-id: trunk@14941 -

.gitattributes

@@ -9261,6 +9261,7 @@ tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain
 tests/test/trtti5.pp svneol=native#text/plain
+tests/test/tsafecall1.pp svneol=native#text/plain
 tests/test/tsealed1.pp svneol=native#text/pascal
 tests/test/tsealed2.pp svneol=native#text/pascal
 tests/test/tsealed3.pp svneol=native#text/pascal

tests/test/tsafecall1.pp

@@ -0,0 +1,33 @@
+{ %TARGET=win32,win64,wince}
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+uses
+  SysUtils;
+type
+  TTest = class
+  public
+    procedure SomeError; safecall;
+    function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
+  end;
+
+var
+  Handled: Boolean;
+
+procedure TTest.SomeError; safecall;
+begin
+  raise Exception.Create('SomeException');
+end;
+
+function TTest.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
+begin
+  Handled := True;
+  Result := 0;
+end;
+
+begin
+  Handled := False;
+  TTest.Create.SomeError;
+  if not Handled then
+    halt(1);
+end.