mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 12:19:25 +02:00
* 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:
parent
8700f1d090
commit
7a0a1d9f36
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -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
|
||||
|
@ -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
17
tests/webtbs/tw36544a.pp
Normal 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
18
tests/webtbs/tw36544b.pp
Normal 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
9
tests/webtbs/uw36544.pp
Normal file
@ -0,0 +1,9 @@
|
||||
{$mode objfpc}
|
||||
unit uw36544;
|
||||
interface
|
||||
uses
|
||||
sysutils;
|
||||
implementation
|
||||
initialization
|
||||
raise Exception.Create('One should see this exception.');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user