* 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

@@ -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.

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.

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.

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.

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.