paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 02:59:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* make test compiling on avr

Browse Source
This commit is contained in:
florian 2022-04-29 22:34:08 +02:00
parent ab1a31d9ac
commit 9540dc8989
1 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
tests/test/tint642.pp
View File

@ -1,11 +1,19 @@
{$Q-} { this is necessary to avoid an overflow error below } {$Q-} { this is necessary to avoid an overflow error below }
{$mode objfpc} {$mode objfpc}
{$ifdef CPUAVR}
{$else CPUAVR}
{$define HASSYSUTILS}
{$define HASFLOATS}
{$endif CPUAVR}
{$ifdef HASSYSUTILS}
uses uses
sysutils sysutils
{$ifdef go32v2} {$ifdef go32v2}
,dpmiexcp ,dpmiexcp
{$endif go32v2} {$endif go32v2}
; ;
{$endif HASSYSUTILS}
type type
tqwordrec = packed record tqwordrec = packed record
{$ifndef ENDIAN_BIG} {$ifndef ENDIAN_BIG}
@ -16,7 +24,7 @@ type
end; end;
const const
{$ifdef CPUI8086} {$if defined(CPUI8086) or defined(CPUAVR)}
NumIterations = 100; NumIterations = 100;
{$else not CPUI8086} {$else not CPUI8086}
{$ifdef CPU68K} {$ifdef CPU68K}
@ -592,7 +600,9 @@ procedure testtypecastqword;
l1,l2 : longint; l1,l2 : longint;
d1,d2 : dword; d1,d2 : dword;
q1,q2 : qword; q1,q2 : qword;
{$ifdef HASFLOATS}
r1,r2 : double; r1,r2 : double;
{$endif HASFLOATS}
begin begin
{ shortint } { shortint }
@ -685,6 +695,7 @@ procedure testtypecastqword;
if d1<>d2 then if d1<>d2 then
do_error(2013); do_error(2013);
{$ifdef HASFLOATS}
// a constant which can't be loaded with fild // a constant which can't be loaded with fild
q1:=$80000000; q1:=$80000000;
q1:=q1 shl 32; q1:=q1 shl 32;
@ -695,6 +706,7 @@ procedure testtypecastqword;
q1:=q1+1; q1:=q1+1;
if q1<>double(d2)*d2*2.0+1 then if q1<>double(d2)*d2*2.0+1 then
do_error(2014); do_error(2014);
{$endif HASFLOATS}
end; end;
procedure testioqword; procedure testioqword;
@ -776,6 +788,7 @@ procedure teststringqword;
if s<>'1234000054321' then if s<>'1234000054321' then
do_error(2204); do_error(2204);
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
{ testing str: ansistring } { testing str: ansistring }
// more complex tests // more complex tests
q1:=4321; q1:=4321;
@ -810,6 +823,7 @@ procedure teststringqword;
do_error(2210); do_error(2210);
if q1<>q2 then if q1<>q2 then
do_error(2211); do_error(2211);
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
s:='18446744073709551616'; s:='18446744073709551616';
val(s,q2,code); val(s,q2,code);
if code=0 then if code=0 then
@ -934,6 +948,7 @@ procedure testreqword;
q0,q1,q2,q3 : qword; q0,q1,q2,q3 : qword;
begin begin
{$ifdef HASSYSUTILS}
q0:=0; q0:=0;
assignqword($ffffffff,$ffffffff,q1); assignqword($ffffffff,$ffffffff,q1);
q2:=1; q2:=1;
@ -1019,7 +1034,7 @@ procedure testreqword;
except except
do_error(2512); do_error(2512);
end; end;
{$endif HASSYSUTILS}
end; end;
procedure testintqword; procedure testintqword;
@ -1068,7 +1083,9 @@ procedure testcritical;
var var
a : array[0..10,0..10,0..10] of qword; a : array[0..10,0..10,0..10] of qword;
i,j,k : longint; i,j,k : longint;
{$ifdef HASFLOATS}
d1,d2 : extended; d1,d2 : extended;
{$endif HASFLOATS}
q1,q2 : qword; q1,q2 : qword;
i1,i2 : int64; i1,i2 : int64;
@ -1088,6 +1105,7 @@ procedure testcritical;
do_error(2702); do_error(2702);
if (a[i,j,k] shl (i-i))<>a[i,j,k] then if (a[i,j,k] shl (i-i))<>a[i,j,k] then
do_error(2703); do_error(2703);
{$ifdef HASFLOATS}
q1:=10; q1:=10;
q2:=100; q2:=100;
i1:=1000; i1:=1000;
@ -1096,6 +1114,7 @@ procedure testcritical;
d2:=i1/i2; d2:=i1/i2;
if (d1<>d2) then if (d1<>d2) then
do_error(2704); do_error(2704);
{$endif HASFLOATS}
end; end;
var var