Browse Source

# revisions: 43901

git-svn-id: branches/fixes_3_2@43940 -
marco 5 years ago
parent
commit
73d3bed3d1
5 changed files with 60 additions and 0 deletions
  1. 3 0
      .gitattributes
  2. 13 0
      rtl/win/syswin.inc
  3. 17 0
      tests/webtbs/tw36544a.pp
  4. 18 0
      tests/webtbs/tw36544b.pp
  5. 9 0
      tests/webtbs/uw36544.pp

+ 3 - 0
.gitattributes

@@ -16486,6 +16486,8 @@ tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
 tests/webtbs/tw3650.pp svneol=native#text/plain
 tests/webtbs/tw3650.pp svneol=native#text/plain
 tests/webtbs/tw3653.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/tw3661.pp svneol=native#text/plain
 tests/webtbs/tw3666.pp svneol=native#text/plain
 tests/webtbs/tw3666.pp svneol=native#text/plain
 tests/webtbs/tw3669.pp svneol=native#text/plain
 tests/webtbs/tw3669.pp svneol=native#text/plain
@@ -17049,6 +17051,7 @@ tests/webtbs/uw34287b.pp svneol=native#text/pascal
 tests/webtbs/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain
+tests/webtbs/uw36544.pp svneol=native#text/pascal
 tests/webtbs/uw3968.pp svneol=native#text/plain
 tests/webtbs/uw3968.pp svneol=native#text/plain
 tests/webtbs/uw4056.pp svneol=native#text/plain
 tests/webtbs/uw4056.pp svneol=native#text/plain
 tests/webtbs/uw4140.pp svneol=native#text/plain
 tests/webtbs/uw4140.pp svneol=native#text/plain

+ 13 - 0
rtl/win/syswin.inc

@@ -371,6 +371,10 @@ Var
   DLLInitState : Longint = -1;
   DLLInitState : Longint = -1;
   DLLBuf : Jmp_buf;
   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'];
 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
   begin
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 {$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
            If SetJmp(DLLBuf) = 0 then
              begin
              begin
+{$ifdef FPC_USE_SEH}
+               try
+{$endif}
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
                EntryInformation.PascalMain();
                EntryInformation.PascalMain();
 {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
                PascalMain;
                PascalMain;
 {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
 {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
                Dll_entry:=true;
                Dll_entry:=true;
+{$ifdef FPC_USE_SEH}
+               except
+                 DoUnHandledException;
+                 Dll_entry:=false;
+               end;
+{$endif}
              end
              end
            else
            else
              Dll_entry:=(ExitCode=0);
              Dll_entry:=(ExitCode=0);

+ 17 - 0
tests/webtbs/tw36544a.pp

@@ -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 - 0
tests/webtbs/tw36544b.pp

@@ -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 - 0
tests/webtbs/uw36544.pp

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