paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 00:59:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

* put tests in procedure so that an unbalanced stack will cause a crash

Browse Source 
when exiting it

git-svn-id: trunk@7662 -
This commit is contained in:
Jonas Maebe 2007-06-14 16:50:08 +00:00
parent 3e97c6b324
commit 2496946c23
5 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
tests/test/cg/tcalext.pp
View File

@ -212,6 +212,8 @@ var
value_long_double := 0.0; value_long_double := 0.0;
end; end;
{ in sub procedure to detect stack corruption when exiting }
procedure dotest;
const const
has_errors : boolean = false; has_errors : boolean = false;
@ -788,4 +790,8 @@ begin
if has_errors then if has_errors then
Halt(1); Halt(1);
end;
begin
dotest;
end. end.

6
tests/test/cg/tcalext2.pp
View File

@ -151,7 +151,6 @@ function test_function_struct : _7byte_; cdecl; external;
var var
global_u8bit : byte; cvar; external; global_u8bit : byte; cvar; external;
global_u16bit : word; cvar; external; global_u16bit : word; cvar; external;
@ -222,6 +221,7 @@ const
end; end;
procedure dotest;
var failed : boolean; var failed : boolean;
tinystruct : _1BYTE_; tinystruct : _1BYTE_;
smallstruct : _3BYTE_; smallstruct : _3BYTE_;
@ -259,4 +259,8 @@ begin
if has_errors then if has_errors then
Halt(1); Halt(1);
end;
begin
dotest;
end. end.

5
tests/test/cg/tcalext3.pp
View File

@ -497,6 +497,7 @@ function pass_arr32(s : struct_arr32) : int64_t; cdecl; external;
function pass_arr33(s : struct_arr33) : int64_t; cdecl; external; function pass_arr33(s : struct_arr33) : int64_t; cdecl; external;
procedure dotest;
var var
sa1 : struct_arr1; sa1 : struct_arr1;
sa2 : struct_arr2; sa2 : struct_arr2;
@ -614,4 +615,8 @@ begin
if (not success) then if (not success) then
halt(1); halt(1);
end;
begin
dotest;
end. end.

5
tests/test/cg/tcalext4.pp
View File

@ -75,6 +75,7 @@ function pass31(s : arr31) : int64; cdecl; external;
function pass32(s : arr32) : int64; cdecl; external; function pass32(s : arr32) : int64; cdecl; external;
function pass33(s : arr33) : int64; cdecl; external; function pass33(s : arr33) : int64; cdecl; external;
procedure dotest;
var var
s1 : arr1; s1 : arr1;
s2 : arr2; s2 : arr2;
@ -130,4 +131,8 @@ begin
if (not success) then if (not success) then
halt(1); halt(1);
end;
begin
dotest;
end. end.

6
tests/test/cg/tcalext5.pp
View File

@ -505,7 +505,7 @@ function pass_arr31(s : struct_arr31; b: byte) : int64_t; cdecl; external;
function pass_arr32(s : struct_arr32; b: byte) : int64_t; cdecl; external; function pass_arr32(s : struct_arr32; b: byte) : int64_t; cdecl; external;
function pass_arr33(s : struct_arr33; b: byte) : int64_t; cdecl; external; function pass_arr33(s : struct_arr33; b: byte) : int64_t; cdecl; external;
procedure dotest;
var var
sa1 : struct_arr1; sa1 : struct_arr1;
sa2 : struct_arr2; sa2 : struct_arr2;
@ -629,4 +629,8 @@ begin
if (not success) then if (not success) then
halt(1); halt(1);
end;
begin
dotest;
end. end.