Browse Source

+ extend test to test overflow checking

florian 1 year ago
parent
commit
367beaaef4
1 changed files with 58 additions and 5 deletions
  1. 58 5
      tests/test/units/system/tabs.pp

+ 58 - 5
tests/test/units/system/tabs.pp

@@ -1,10 +1,9 @@
 { Part of System unit testsuit        }
 { Part of System unit testsuit        }
 { Carl Eric Codere Copyright (c) 2002 }
 { Carl Eric Codere Copyright (c) 2002 }
-program tabs;
 
 
-{$ifdef VER1_0}
-  {$define SKIP_CURRENCY_TEST}
-{$endif }
+{ exceptions are needed for testing overflow checking }
+{$MODE OBJFPC}
+program tabs;
 
 
 {$ifndef MACOS}
 {$ifndef MACOS}
 {$APPTYPE CONSOLE}
 {$APPTYPE CONSOLE}
@@ -12,6 +11,9 @@ program tabs;
 {$APPTYPE TOOL}
 {$APPTYPE TOOL}
 {$endif}
 {$endif}
 
 
+uses
+  Sysutils;
+
 {$R+}
 {$R+}
 {$Q+}
 {$Q+}
 
 
@@ -118,7 +120,7 @@ procedure fail;
     Write('Abs() test with int64 type...');
     Write('Abs() test with int64 type...');
     _result := true;
     _result := true;
 
 
-   value := VALUE_ONE_INT;
+    value := VALUE_ONE_INT;
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
        _result := false;
        _result := false;
 
 
@@ -155,6 +157,31 @@ procedure fail;
     if value1 <> (RESULT_FOUR_INT) then
     if value1 <> (RESULT_FOUR_INT) then
        _result := false;
        _result := false;
 
 
+    { test overflow checking }
+{$PUSH}
+{$Q+}
+    value := Int64.MinValue+Random(0);
+    try
+      value := Abs(value);
+      _result := false;
+    except
+      on EIntOverflow do
+        ; // no error, result is -2147483648
+      on ERangeError do
+        ; // no error, result is -2147483648
+      on Exception do
+        _result := false;
+    end;
+
+    value := -Int64.MaxValue+Random(0);
+    try
+      value := Abs(value);
+    except
+      on Exception do
+        _result := false;
+    end;
+{$POP}
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else
@@ -226,6 +253,32 @@ procedure fail;
     if (round(vextended) <> RESULT_ONE_INT) then
     if (round(vextended) <> RESULT_ONE_INT) then
       _result := false;
       _result := false;
 
 
+   { test overflow checking }
+{$PUSH}
+{$Q+}
+{ allow also range check errors as 64 bit CPUs might have only an abs(<int64>) }
+{$R+}
+    value := Longint.MinValue+Random(0);
+    try
+      value := Abs(value);
+      _result := false;
+    except
+      on EIntOverflow do
+        ; // no error, result is -2147483648
+      on ERangeError do
+        ; // no error, result is -2147483648
+      on Exception do
+        _result := false;
+    end;
+    value := -Longint.MaxValue+Random(0);
+    try
+      value := Abs(value);
+    except
+      on Exception do
+        _result := false;
+    end;
+{$POP}
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else