paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 17:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Improved safecall test. Added code to test parameter-values

Browse Source 
git-svn-id: trunk@16120 -
This commit is contained in:
joost 2010-10-10 10:52:54 +00:00
parent d5bc1c972f
commit 1844ff4c01
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
tests/test/tsafecall3.pp
View File

@ -10,6 +10,8 @@ function SafecallProcedureAlias(AParam1,AParam2: integer):HRESULT; {$IFDEF windo
procedure SafecallProcedure(AParam1,AParam2: integer); safecall; [public, alias: '_SAFECALLPROCEDURE'];
var i,j: double;
begin
if (AParam1<>$123456) or (AParam2<>$654321) then
halt(1);
i := 1;
j := 0;
// division by zero, but no exception should be raised. Instead the function
@ -20,6 +22,8 @@ end;
function SafecallFunctionAlias(AParam1,AParam2: integer; out _result: string):HRESULT; {$IFDEF windows}stdcall{$ELSE}cdecl{$ENDIF}; [external name '_SAFECALLFUNCTION'];
function SafecallFunction(AParam1,AParam2: integer): string; safecall; [public, alias: '_SAFECALLFUNCTION'];
begin
if (AParam1<>$123456) or (AParam2<>$654321) then
halt(2);
raise exception.create('Ignore and return non-zero');
end;
@ -28,8 +32,8 @@ var
begin
if SafecallProcedureAlias($123456,$654321) = 0 then
halt(1);
halt(11);
if SafecallFunctionAlias($123456,$654321,s) = 0 then
halt(2);
halt(12);
end.