View Issue Details

IDProjectCategoryView StatusLast Update
0015768FPCRTLpublic2010-11-13 21:19
ReporterDmitry StreblechenkoAssigned ToPaul Ishenin 
PrioritynormalSeveritymajorReproducibilityalways
Status closedResolutionfixed 
Platformx64OSWindowsOS VersionWindows 7
Product Version2.5.1Product Build 
Target VersionFixed in Version 
Summary0015768: safecall calling convention is broken
DescriptionRaising an exception in a safecall method produces an access violation when compiled to 64 bit.
See the following sample app
Steps To Reproduceprogram 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.
Tags64bit, com, win64
Fixed in Revision14940,14949
FPCOldBugId
FPCTarget
Attached Files

Relationships

related to 0014807 closedPaul Ishenin SafeCall still does not work ... AccessViolation when exception is raised (Com interop) 

Activities

Dmitry Streblechenko

2010-02-15 18:13

reporter   ~0034506

Please note that this bug renders creation of COM libraries in FPC impossible.
Raising an error in a COM method with the safecall calling convetion propages an exception (access violation) to the caller instead of returning an appopriate HRESULT and providing the error details through CreateErrorInfo/GetErrorInfo.

Dmitry Streblechenko

2010-02-17 18:05

reporter   ~0034564

Marco (or somebody else),
can this bug be prioritized? I am porting a large COM library with about 3000 safecall methods to 64 bit, and there is nothing I can do until this bug is fixed short of changing all 3000 methods to return HResult and handle all exceptions explicitly in my code.

I would not mind paying for the fix.

Thank you!

Jonas Maebe

2010-02-19 15:16

manager   ~0034598

You can try posting a bounty at http://wiki.freepascal.org/Bounties

Dmitry Streblechenko

2010-02-24 07:40

reporter   ~0034721

Looks like fpc_DestroyException in except.inc raises an exception when safecall convention is used.
It looks like it is trying to free a bogus exception object.
This only happens in 64 bit if the safecall calling convention is used.

I don't think I understand what is going on. Can somebody more familiar with the compiler and RTL take a look at this?
The sample project above produces the access violation 100% of the time.

Thanks!

Dmitry Streblechenko

2010-02-24 07:51

reporter   ~0034722

Last edited: 2010-02-24 07:51

I posted a $300 bounty for fixing the bug:
http://wiki.freepascal.org/Bounties#bug_15768

Paul Ishenin

2010-02-26 14:10

developer   ~0034798

Last edited: 2010-02-26 14:10

Does it work properly after 14940? I changed the codegeneration a bit.

Paul Ishenin

2010-02-27 17:15

developer   ~0034836

Please test.

Issue History

Date Modified Username Field Change
2010-02-15 07:45 Dmitry Streblechenko New Issue
2010-02-15 10:36 Jonas Maebe Relationship added related to 0014807
2010-02-15 13:49 Marco van de Voort Tag Attached: com
2010-02-15 18:13 Dmitry Streblechenko Note Added: 0034506
2010-02-17 18:05 Dmitry Streblechenko Note Added: 0034564
2010-02-18 17:40 Dmitry Streblechenko Tag Attached: 64bit
2010-02-18 17:41 Dmitry Streblechenko Tag Attached: win64
2010-02-19 15:16 Jonas Maebe Note Added: 0034598
2010-02-24 07:40 Dmitry Streblechenko Note Added: 0034721
2010-02-24 07:51 Dmitry Streblechenko Note Added: 0034722
2010-02-24 07:51 Dmitry Streblechenko Note Edited: 0034722
2010-02-26 14:10 Paul Ishenin Note Added: 0034798
2010-02-26 14:10 Paul Ishenin Status new => feedback
2010-02-26 14:10 Paul Ishenin Note Edited: 0034798
2010-02-27 17:15 Paul Ishenin Fixed in Revision => 14940,14949
2010-02-27 17:15 Paul Ishenin Status feedback => resolved
2010-02-27 17:15 Paul Ishenin Resolution open => fixed
2010-02-27 17:15 Paul Ishenin Assigned To => Paul Ishenin
2010-02-27 17:15 Paul Ishenin Note Added: 0034836
2010-11-13 21:19 Jonas Maebe Status resolved => closed