safecall calling convention is broken
Original Reporter info from Mantis: dmitry@dimastr.com
-
Reporter name: Dmitry Streblechenko
Original Reporter info from Mantis: dmitry@dimastr.com
- Reporter name: Dmitry Streblechenko
Description:
Raising an exception in a safecall method produces an access violation when compiled to 64 bit.
See the following sample app
Steps to reproduce:
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, ComObj
{ you can add units after this };
type
{ TSafecallBugApplication }
TSafecallBugApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
procedure RaiseOleException;safecall;
procedure RaiseException;safecall;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
{ TSafecallBugApplication }
procedure TSafecallBugApplication.DoRun;
procedure LogException(E : Exception);
var ErrorMsg: String;
begin
ErrorMsg := E.ClassName + ': '+E.Message;
if E is EOleSysError then ErrorMsg := ErrorMsg + ', COM error code: 0x' + IntToHex(EOleSysError(E).ErrorCode, 8);
writeln(ErrorMsg);
end;
begin
{ add your program here }
try
RaiseOleException;
except
on E:Exception do LogException(E);
end;
try
RaiseException;
except
on E:Exception do LogException(E);
end;
readln;
// stop program loop
Terminate;
end;
procedure TSafecallBugApplication.RaiseOleException; safecall;
begin
raise EOleException.Create('Test Ole Exception', E_NOTIMPL{0x$80004001}, '', '', 0);
end;
procedure TSafecallBugApplication.RaiseException; safecall;
begin
raise Exception.Create('Test Regular Exception');
end;
constructor TSafecallBugApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
end;
destructor TSafecallBugApplication.Destroy;
begin
inherited Destroy;
end;
var
Application: TSafecallBugApplication;
{$R project1.res}
begin
Application:=TSafecallBugApplication.Create(nil);
Application.Title:='safecall bug';
Application.Run;
Application.Free;
end.
Mantis conversion info:
- Mantis ID: 15768
- OS: Windows
- OS Build: Windows 7
- Platform: x64
- Version: 2.5.1
- Fixed in revision: 14940 (#cf0a1b1a),14949 (#b884d568)
- Monitored by: » dmitry@dimastr.com (Dmitry Streblechenko)