From 2496946c237b1ff45fde873243212f7f882586cf Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Thu, 14 Jun 2007 16:50:08 +0000
Subject: [PATCH]   * put tests in procedure so that an unbalanced stack will
 cause a crash     when exiting it

git-svn-id: trunk@7662 -
---
 tests/test/cg/tcalext.pp  | 6 ++++++
 tests/test/cg/tcalext2.pp | 6 +++++-
 tests/test/cg/tcalext3.pp | 5 +++++
 tests/test/cg/tcalext4.pp | 5 +++++
 tests/test/cg/tcalext5.pp | 6 +++++-
 5 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/tests/test/cg/tcalext.pp b/tests/test/cg/tcalext.pp
index 744c87cd38..b0f0e97b00 100644
--- a/tests/test/cg/tcalext.pp
+++ b/tests/test/cg/tcalext.pp
@@ -212,6 +212,8 @@ var
     value_long_double := 0.0;
   end;
 
+{ in sub procedure to detect stack corruption when exiting }
+procedure dotest;
 const
   has_errors : boolean = false;
 
@@ -788,4 +790,8 @@ begin
 
   if has_errors then
     Halt(1);
+end;
+
+begin
+  dotest;
 end.
diff --git a/tests/test/cg/tcalext2.pp b/tests/test/cg/tcalext2.pp
index 51a4a85266..ef8ded3d26 100644
--- a/tests/test/cg/tcalext2.pp
+++ b/tests/test/cg/tcalext2.pp
@@ -151,7 +151,6 @@ function test_function_struct : _7byte_; cdecl; external;
 
 
 
-
 var
  global_u8bit : byte; cvar; external;
  global_u16bit : word; cvar; external;
@@ -222,6 +221,7 @@ const
    end;
 
 
+procedure dotest;
 var failed : boolean;
     tinystruct : _1BYTE_;
     smallstruct : _3BYTE_;
@@ -259,4 +259,8 @@ begin
 
   if has_errors then
     Halt(1);
+end;
+
+begin
+  dotest;
 end.
diff --git a/tests/test/cg/tcalext3.pp b/tests/test/cg/tcalext3.pp
index 0df14c0f4c..89d77a9d34 100644
--- a/tests/test/cg/tcalext3.pp
+++ b/tests/test/cg/tcalext3.pp
@@ -497,6 +497,7 @@ function pass_arr32(s : struct_arr32) : int64_t; cdecl; external;
 function pass_arr33(s : struct_arr33) : int64_t; cdecl; external;
 
 
+procedure dotest;
 var
   sa1 : struct_arr1;
   sa2 : struct_arr2;
@@ -614,4 +615,8 @@ begin
 
   if (not success) then
     halt(1);
+end;
+
+begin
+  dotest;
 end.
diff --git a/tests/test/cg/tcalext4.pp b/tests/test/cg/tcalext4.pp
index 1c981a5aa3..9a105821a2 100644
--- a/tests/test/cg/tcalext4.pp
+++ b/tests/test/cg/tcalext4.pp
@@ -75,6 +75,7 @@ function pass31(s : arr31) : int64; cdecl; external;
 function pass32(s : arr32) : int64; cdecl; external;
 function pass33(s : arr33) : int64; cdecl; external;
 
+procedure dotest;
 var
   s1 : arr1;
   s2 : arr2;
@@ -130,4 +131,8 @@ begin
 
   if (not success) then
     halt(1);
+end;
+
+begin
+  dotest;
 end.
diff --git a/tests/test/cg/tcalext5.pp b/tests/test/cg/tcalext5.pp
index c395ee972b..2add0f6086 100644
--- a/tests/test/cg/tcalext5.pp
+++ b/tests/test/cg/tcalext5.pp
@@ -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_arr33(s : struct_arr33; b: byte) : int64_t; cdecl; external;
 
-
+procedure dotest;
 var
   sa1 : struct_arr1;
   sa2 : struct_arr2;
@@ -629,4 +629,8 @@ begin
 
   if (not success) then
     halt(1);
+end;
+
+begin
+  dotest;
 end.