* fix for Mantis #36544: provide an overall exception handler for the library startup code in case of unhandled exceptions (the loading of the library is considered failed in that case) when SEH is active

+ added test

git-svn-id: trunk@43901 -
This commit is contained in:
svenbarth 2020-01-10 15:39:20 +00:00
parent 8700f1d090
commit 7a0a1d9f36
5 changed files with 60 additions and 0 deletions

3
.gitattributes vendored
View File

@ -17917,6 +17917,8 @@ tests/webtbs/tw36496a.pp svneol=native#text/pascal
tests/webtbs/tw36496b.pp svneol=native#text/pascal
tests/webtbs/tw3650.pp svneol=native#text/plain
tests/webtbs/tw3653.pp svneol=native#text/plain
tests/webtbs/tw36544a.pp svneol=native#text/pascal
tests/webtbs/tw36544b.pp svneol=native#text/pascal
tests/webtbs/tw3661.pp svneol=native#text/plain
tests/webtbs/tw3666.pp svneol=native#text/plain
tests/webtbs/tw3669.pp svneol=native#text/plain
@ -18483,6 +18485,7 @@ tests/webtbs/uw3474b.pp svneol=native#text/plain
tests/webtbs/uw35918a.pp svneol=native#text/pascal
tests/webtbs/uw35918b.pp svneol=native#text/pascal
tests/webtbs/uw35918c.pp svneol=native#text/pascal
tests/webtbs/uw36544.pp svneol=native#text/pascal
tests/webtbs/uw3968.pp svneol=native#text/plain
tests/webtbs/uw4056.pp svneol=native#text/plain
tests/webtbs/uw4140.pp svneol=native#text/plain

View File

@ -371,6 +371,10 @@ Var
DLLInitState : Longint = -1;
DLLBuf : Jmp_buf;
{$if defined(FPC_USE_WIN32_SEH) or defined(FPC_USE_WIN64_SEH)}
{$define FPC_USE_SEH}
{$endif}
function Dll_entry{$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}(constref info : TEntryInformation){$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry'];
begin
{$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
@ -386,12 +390,21 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}(constref info : TE
If SetJmp(DLLBuf) = 0 then
begin
{$ifdef FPC_USE_SEH}
try
{$endif}
{$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
EntryInformation.PascalMain();
{$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
PascalMain;
{$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
Dll_entry:=true;
{$ifdef FPC_USE_SEH}
except
DoUnHandledException;
Dll_entry:=false;
end;
{$endif}
end
else
Dll_entry:=(ExitCode=0);

17
tests/webtbs/tw36544a.pp Normal file
View File

@ -0,0 +1,17 @@
{ %target=win32,win64,wince,darwin,linux,freebsd,solaris,beos,aix,android,haiku }
{ %needlibrary }
{$mode objfpc}
library tw36544a;
uses
uw36544;
procedure library_procedure;
begin
writeln('Not ok');
end;
exports library_procedure;
begin
end.

18
tests/webtbs/tw36544b.pp Normal file
View File

@ -0,0 +1,18 @@
{ %target=win32,win64,wince }
{ %needlibrary }
{ %result=-1073741502 }
{ ToDo: check whether the exit code is the same for the following targets: darwin,linux,freebsd,solaris,beos,aix,android,haiku }
{$mode objfpc}
uses
sysutils;
{$ifndef windows}
{$linklib tw36544a}
{$endif}
procedure library_procedure; external {$ifdef windows}'tw36544a'{$endif};
begin
library_procedure;
end.

9
tests/webtbs/uw36544.pp Normal file
View File

@ -0,0 +1,9 @@
{$mode objfpc}
unit uw36544;
interface
uses
sysutils;
implementation
initialization
raise Exception.Create('One should see this exception.');
end.