mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 01:30:28 +02:00
71068ae7eb
of the jdk15 unit in that case)
* adjusted testall.sh script so it can also be used to test class
files compiled for Android (still with the JVM though)
git-svn-id: branches/jvmbackend@19835 -
310 lines
6.8 KiB
ObjectPascal
310 lines
6.8 KiB
ObjectPascal
{ Part of System unit testsuit }
|
|
{ Carl Eric Codere Copyright (c) 2002 }
|
|
program tabs;
|
|
|
|
{$ifdef cpujvm}
|
|
uses
|
|
{$ifdef java}jdk15{$else}androidr14{$endif};
|
|
|
|
{$macro on}
|
|
{$define writeln:=jlsystem.fout.println}
|
|
{$define write:=jlsystem.fout.println}
|
|
{$endif}
|
|
|
|
|
|
{$ifdef VER1_0}
|
|
{$define SKIP_CURRENCY_TEST}
|
|
{$endif }
|
|
|
|
{$ifndef MACOS}
|
|
{$APPTYPE CONSOLE}
|
|
{$else}
|
|
{$APPTYPE TOOL}
|
|
{$endif}
|
|
|
|
{$R-}
|
|
{$Q-}
|
|
|
|
const
|
|
RESULT_ONE_INT = 65536;
|
|
VALUE_ONE_INT = -65536;
|
|
RESULT_CONST_ONE_INT = abs(VALUE_ONE_INT);
|
|
RESULT_TWO_INT = 12345;
|
|
VALUE_TWO_INT = 12345;
|
|
RESULT_CONST_TWO_INT = abs(VALUE_TWO_INT);
|
|
|
|
RESULT_THREE_INT = 2147483647;
|
|
VALUE_THREE_INT = -2147483647;
|
|
RESULT_CONST_THREE_INT = abs(VALUE_THREE_INT);
|
|
RESULT_FOUR_INT = 2147483647;
|
|
VALUE_FOUR_INT = 2147483647;
|
|
RESULT_CONST_FOUR_INT = abs(VALUE_FOUR_INT);
|
|
|
|
|
|
RESULT_ONE_REAL = 12345.6789;
|
|
VALUE_ONE_REAL = -12345.6789;
|
|
RESULT_CONST_ONE_REAL = abs(VALUE_ONE_REAL);
|
|
RESULT_TWO_REAL = 54321.6789E+02;
|
|
VALUE_TWO_REAL = 54321.6789E+02;
|
|
RESULT_CONST_TWO_REAL = abs(VALUE_TWO_REAL);
|
|
|
|
RESULT_THREE_REAL = 0.0;
|
|
VALUE_THREE_REAL = 0.0;
|
|
RESULT_CONST_THREE_REAL = abs(VALUE_THREE_REAL);
|
|
RESULT_FOUR_REAL = 12.0;
|
|
VALUE_FOUR_REAL = -12.0;
|
|
RESULT_CONST_FOUR_REAL = abs(VALUE_FOUR_REAL);
|
|
|
|
|
|
procedure fail;
|
|
begin
|
|
WriteLn('Failure!');
|
|
halt(1);
|
|
end;
|
|
|
|
|
|
{$ifndef SKIP_CURRENCY_TEST}
|
|
procedure test_abs_currency;
|
|
var
|
|
_result : boolean;
|
|
value : currency;
|
|
value1: currency;
|
|
begin
|
|
Write('Abs() test with currency type...');
|
|
_result := true;
|
|
|
|
value := VALUE_ONE_REAL;
|
|
if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL)) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_ONE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_TWO_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_THREE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
|
|
_result := false;
|
|
|
|
|
|
if not _result then
|
|
fail
|
|
else
|
|
WriteLn('Success!');
|
|
end;
|
|
{$endif SKIP_CURRENCY_TEST}
|
|
|
|
|
|
|
|
procedure test_abs_int64;
|
|
var
|
|
_result : boolean;
|
|
value : int64;
|
|
value1: int64;
|
|
begin
|
|
Write('Abs() test with int64 type...');
|
|
_result := true;
|
|
|
|
value := VALUE_ONE_INT;
|
|
if (abs(value) <> (RESULT_CONST_ONE_INT)) then
|
|
_result := false;
|
|
|
|
|
|
value := VALUE_TWO_INT;
|
|
if abs(value) <> (RESULT_CONST_TWO_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_INT;
|
|
if abs(value) <> (RESULT_CONST_THREE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_INT;
|
|
if abs(value) <> (RESULT_CONST_FOUR_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_ONE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_TWO_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_THREE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_FOUR_INT) then
|
|
_result := false;
|
|
|
|
if not _result then
|
|
fail
|
|
else
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
|
|
procedure test_abs_longint;
|
|
var
|
|
_result : boolean;
|
|
value : longint;
|
|
value1: longint;
|
|
vsingle : single;
|
|
vdouble : double;
|
|
vextended : extended;
|
|
begin
|
|
Write('Abs() test with longint type...');
|
|
_result := true;
|
|
|
|
value := VALUE_ONE_INT;
|
|
if (abs(value) <> (RESULT_CONST_ONE_INT)) then
|
|
_result := false;
|
|
|
|
|
|
value := VALUE_TWO_INT;
|
|
if abs(value) <> (RESULT_CONST_TWO_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_INT;
|
|
if abs(value) <> (RESULT_CONST_THREE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_INT;
|
|
if abs(value) <> (RESULT_CONST_FOUR_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_ONE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_TWO_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_THREE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_INT;
|
|
value1 := abs(value);
|
|
if value1 <> (RESULT_FOUR_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_INT;
|
|
vsingle := abs(value);
|
|
if (round(vsingle) <> RESULT_ONE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_INT;
|
|
vdouble := abs(value);
|
|
if (round(vdouble) <> RESULT_ONE_INT) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_INT;
|
|
vextended := abs(value);
|
|
if (round(vextended) <> RESULT_ONE_INT) then
|
|
_result := false;
|
|
|
|
if not _result then
|
|
fail
|
|
else
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
procedure test_abs_real;
|
|
var
|
|
_result : boolean;
|
|
value : real;
|
|
value1: real;
|
|
begin
|
|
_result := true;
|
|
Write('Abs() test with real type...');
|
|
|
|
value := VALUE_ONE_REAL;
|
|
if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL)) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_REAL;
|
|
if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_ONE_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_ONE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_TWO_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_TWO_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_THREE_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_THREE_REAL) then
|
|
_result := false;
|
|
|
|
value := VALUE_FOUR_REAL;
|
|
value1 := abs(value);
|
|
if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
|
|
_result := false;
|
|
|
|
if not _result then
|
|
fail
|
|
else
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
var
|
|
r: longint;
|
|
_success : boolean;
|
|
l: boolean;
|
|
Begin
|
|
{$ifdef SKIP_CURRENCY_TEST}
|
|
Writeln('Skipping currency test because its not supported by theis compiler');
|
|
{$else SKIP_CURRENCY_TEST}
|
|
test_abs_currency;
|
|
{$endif SKIP_CURRENCY_TEST}
|
|
test_abs_real;
|
|
test_abs_longint;
|
|
test_abs_int64;
|
|
end.
|