mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 05:09:30 +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 -
237 lines
4.6 KiB
ObjectPascal
237 lines
4.6 KiB
ObjectPascal
{ this tests the int routine }
|
|
{ Contrary to TP, int can be used in the constant section,
|
|
just like in Delphi }
|
|
program tint;
|
|
|
|
{$modeswitch exceptions}
|
|
|
|
uses
|
|
{$ifdef java}jdk15{$else}androidr14{$endif};
|
|
|
|
{$ifdef VER1_0}
|
|
{$define SKIP_CURRENCY_TEST}
|
|
{$endif }
|
|
|
|
{$macro on}
|
|
{$define writeln:=JLSystem.fout.println}
|
|
{$define write:=JLSystem.fout.print}
|
|
|
|
const
|
|
INT_RESULT_ONE = 1234;
|
|
INT_VALUE_ONE = 1234.5678;
|
|
INT_RESULT_CONST_ONE = Int(INT_VALUE_ONE);
|
|
INT_RESULT_TWO = -1234;
|
|
INT_VALUE_TWO = -1234.5678;
|
|
INT_RESULT_CONST_TWO = Int(INT_VALUE_TWO);
|
|
|
|
|
|
procedure fail;
|
|
begin
|
|
WriteLn('Failed!');
|
|
// halt(1);
|
|
raise JLException.create('boo!');
|
|
end;
|
|
|
|
procedure test_int_real;
|
|
var
|
|
r: real;
|
|
_success : boolean;
|
|
Begin
|
|
Write('Int() real testing...');
|
|
_success := true;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_CONST_ONE then
|
|
_success := false;
|
|
r:=INT_VALUE_ONE;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_ONE);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
|
|
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_CONST_TWO then
|
|
_success := false;
|
|
r:=INT_VALUE_TWO;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_TWO);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
|
|
|
|
if not _success then
|
|
fail;
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
procedure test_int_single;
|
|
var
|
|
r: single;
|
|
_success : boolean;
|
|
Begin
|
|
Write('Int() single testing...');
|
|
_success := true;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_CONST_ONE then
|
|
_success := false;
|
|
r:=INT_VALUE_ONE;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_ONE);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
|
|
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_CONST_TWO then
|
|
_success := false;
|
|
r:=INT_VALUE_TWO;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_TWO);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
|
|
|
|
if not _success then
|
|
fail;
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
procedure test_int_double;
|
|
var
|
|
r: double;
|
|
_success : boolean;
|
|
Begin
|
|
Write('Int() double testing...');
|
|
_success := true;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_CONST_ONE then
|
|
_success := false;
|
|
r:=INT_VALUE_ONE;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_ONE);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
|
|
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_CONST_TWO then
|
|
_success := false;
|
|
r:=INT_VALUE_TWO;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_TWO);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
|
|
|
|
if not _success then
|
|
fail;
|
|
WriteLn('Success!');
|
|
end;
|
|
|
|
{$ifndef SKIP_CURRENCY_TEST}
|
|
procedure test_int_currency;
|
|
var
|
|
r: currency;
|
|
_success : boolean;
|
|
Begin
|
|
Write('Int() currency testing...');
|
|
_success := true;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
|
|
if not _success then
|
|
fail;
|
|
|
|
if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=INT_VALUE_ONE;
|
|
if Int(r)<>INT_RESULT_CONST_ONE then
|
|
_success := false;
|
|
r:=INT_VALUE_ONE;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_ONE);
|
|
if r<>INT_RESULT_ONE then
|
|
_success:=false;
|
|
|
|
if not _success then
|
|
fail;
|
|
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=INT_VALUE_TWO;
|
|
if Int(r)<>INT_RESULT_CONST_TWO then
|
|
_success := false;
|
|
r:=INT_VALUE_TWO;
|
|
r:=Int(r);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
r:=Int(INT_VALUE_TWO);
|
|
if r<>INT_RESULT_TWO then
|
|
_success:=false;
|
|
|
|
|
|
if not _success then
|
|
fail;
|
|
WriteLn('Success!');
|
|
end;
|
|
{$endif SKIP_CURRENCY_TEST}
|
|
|
|
Begin
|
|
test_int_real;
|
|
test_int_double;
|
|
test_int_single;
|
|
{$ifdef SKIP_CURRENCY_TEST}
|
|
Writeln('Skipping currency test because its not supported by theis compiler');
|
|
{$else SKIP_CURRENCY_TEST}
|
|
test_int_currency;
|
|
{$endif SKIP_CURRENCY_TEST}
|
|
end.
|