mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-23 10:49:17 +02:00
355 lines
10 KiB
ObjectPascal
355 lines
10 KiB
ObjectPascal
{ %OPT=-Sew }
|
|
{ the -Sew causes the compilation to fail if the target supports only unsigned numbers as count for move/fillchar }
|
|
|
|
{ This unit tests the basic routines }
|
|
{ which are usually coded in assembler }
|
|
{ Mainly used in porting to other processors }
|
|
{********************************************}
|
|
{ Tested against Delphi 6 and Delphi 3 }
|
|
{********************************************}
|
|
program tmem;
|
|
|
|
const
|
|
MAX_TABLE = 69; { this value should not be even ! }
|
|
DEFAULT_VALUE = $55;
|
|
FILL_VALUE = $33;
|
|
|
|
|
|
var
|
|
dst_arraybyte : array[1..MAX_TABLE] of byte;
|
|
src_arraybyte : array[1..MAX_TABLE] of byte;
|
|
dst_arrayword : array[1..MAX_TABLE] of word;
|
|
dst_arraylongword : array[1..MAX_TABLE] of longword;
|
|
i: integer;
|
|
|
|
|
|
procedure test(value, required: longint);
|
|
begin
|
|
if value <> required then
|
|
begin
|
|
writeln('Got ',value,' instead of ',required);
|
|
halt(1);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure test_fillchar;
|
|
var
|
|
i: integer;
|
|
begin
|
|
{ non-aligned count }
|
|
write('testing fillchar (non-aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
fillchar(dst_arraybyte, MAX_TABLE-2, FILL_VALUE);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
test(dst_arraybyte[MAX_TABLE-1], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-2 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ modulo 2 count fill }
|
|
write('testing fillchar (aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
fillchar(dst_arraybyte, MAX_TABLE-1, FILL_VALUE);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-1 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ test zero fillchar count }
|
|
write('testing fillchar (zero count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
fillchar(dst_arraybyte, 0, FILL_VALUE);
|
|
for i := 1 to MAX_TABLE do
|
|
test(dst_arraybyte[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{$ifndef CPUI8086}
|
|
{ i8086 uses word as the count parameter for fillchar }
|
|
{ test negative fillchar count }
|
|
write('testing fillchar (negative count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
fillchar(dst_arraybyte, -1, FILL_VALUE);
|
|
for i := 1 to MAX_TABLE do
|
|
test(dst_arraybyte[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{$endif CPUI8086}
|
|
end;
|
|
|
|
|
|
procedure test_move;
|
|
begin
|
|
{ non-aligned count }
|
|
write('testing move (non-aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
move(src_arraybyte, dst_arraybyte, MAX_TABLE-2);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
test(dst_arraybyte[MAX_TABLE-1], DEFAULT_VALUE);
|
|
for i:= 1 to MAX_TABLE-2 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ modulo 2 count fill }
|
|
{ non-aligned count }
|
|
write('testing move (aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
move(src_arraybyte, dst_arraybyte, MAX_TABLE-1);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
for i:= 1 to MAX_TABLE-1 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ zero move count }
|
|
write('testing move (zero count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
move(src_arraybyte,dst_arraybyte, 0);
|
|
for i:= 1 to MAX_TABLE do
|
|
test(dst_arraybyte[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{$ifndef CPUI8086}
|
|
{ i8086 uses word as the count parameter for fillchar }
|
|
{ negative move count }
|
|
write('testing move (negative count)...');
|
|
move(src_arraybyte,dst_arraybyte,-12);
|
|
writeln('Passed!');
|
|
{$endif CPUI8086}
|
|
end;
|
|
|
|
|
|
procedure test_move_large(size: longint);
|
|
var
|
|
src, dst: PLongInt;
|
|
i: LongInt;
|
|
begin
|
|
GetMem(src, size*sizeof(LongInt));
|
|
GetMem(dst, size*sizeof(LongInt));
|
|
write('testing move of ',size,' dwords ...');
|
|
for i := 0 to size-1 do
|
|
begin
|
|
src[i] := i;
|
|
dst[i] := -1;
|
|
end;
|
|
move(src[0], dst[2], (size-4)*sizeof(LongInt));
|
|
test(dst[0], -1);
|
|
test(dst[1], -1);
|
|
test(dst[size-1], -1);
|
|
test(dst[size-2], -1);
|
|
for i := 2 to size-3 do
|
|
test(dst[i], i-2);
|
|
writeln('Passed!');
|
|
|
|
// repeat with source and dest swapped (maybe move in opposite direction)
|
|
// current implementations detect that regions don't overlap and move forward,
|
|
// so this test is mostly useless. But it won't harm anyway.
|
|
write('testing move of ',size,' dwords, opposite direction...');
|
|
for i := 0 to size-1 do
|
|
begin
|
|
dst[i] := i;
|
|
src[i] := -1;
|
|
end;
|
|
move(dst[0], src[2], (size-4)*sizeof(LongInt));
|
|
test(src[0], -1);
|
|
test(src[1], -1);
|
|
test(src[size-1], -1);
|
|
test(src[size-2], -1);
|
|
for i := 2 to size-3 do
|
|
test(src[i], i-2);
|
|
writeln('Passed!');
|
|
|
|
write('testing move of ',size,' dwords, overlapping forward...');
|
|
for i := 0 to size-1 do
|
|
src[i] := i;
|
|
move(src[0], src[100], (size-100)*sizeof(LongInt));
|
|
for i := 0 to 99 do
|
|
test(src[i], i);
|
|
for i := 100 to size-101 do
|
|
test(src[i], i-100);
|
|
writeln('Passed!');
|
|
|
|
write('testing move of ',size,' dwords, overlapping backward...');
|
|
for i := 0 to size-1 do
|
|
src[i] := i;
|
|
move(src[100], src[0], (size-100)*sizeof(LongInt));
|
|
for i := 0 to size-101 do
|
|
test(src[i], i+100);
|
|
for i := size-100 to size-1 do
|
|
test(src[i], i);
|
|
writeln('Passed!');
|
|
FreeMem(dst);
|
|
FreeMem(src);
|
|
end;
|
|
|
|
{$ifdef fpc}
|
|
procedure test_fillword;
|
|
var
|
|
i: integer;
|
|
begin
|
|
{ non-aligned count }
|
|
write('testing fillword (non-aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arrayword[i] := DEFAULT_VALUE;
|
|
fillword(dst_arrayword, MAX_TABLE-2, FILL_VALUE);
|
|
test(dst_arrayword[MAX_TABLE], DEFAULT_VALUE);
|
|
test(dst_arrayword[MAX_TABLE-1], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-2 do
|
|
test(dst_arrayword[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ modulo 2 count fill }
|
|
write('testing fillword (aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arrayword[i] := DEFAULT_VALUE;
|
|
fillword(dst_arrayword, MAX_TABLE-1, FILL_VALUE);
|
|
test(dst_arrayword[MAX_TABLE], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-1 do
|
|
test(dst_arrayword[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ test zero fillword count }
|
|
write('testing fillword (zero count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arrayword[i] := DEFAULT_VALUE;
|
|
fillword(dst_arrayword, 0, FILL_VALUE);
|
|
for i := 1 to MAX_TABLE do
|
|
test(dst_arrayword[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{ test negative fillword count }
|
|
write('testing fillword (negative count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arrayword[i] := DEFAULT_VALUE;
|
|
fillword(dst_arrayword, -1, FILL_VALUE);
|
|
writeln('Passed!');
|
|
end;
|
|
|
|
|
|
procedure test_filldword;
|
|
var
|
|
i: integer;
|
|
begin
|
|
{ non-aligned count }
|
|
write('testing filldword (non-aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraylongword[i] := DEFAULT_VALUE;
|
|
filldword(dst_arraylongword, MAX_TABLE-2, FILL_VALUE);
|
|
test(dst_arraylongword[MAX_TABLE], DEFAULT_VALUE);
|
|
test(dst_arraylongword[MAX_TABLE-1], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-2 do
|
|
test(dst_arraylongword[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ modulo 2 count fill }
|
|
write('testing filldword (aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraylongword[i] := DEFAULT_VALUE;
|
|
filldword(dst_arraylongword, MAX_TABLE-1, FILL_VALUE);
|
|
test(dst_arraylongword[MAX_TABLE], DEFAULT_VALUE);
|
|
for i := 1 to MAX_TABLE-1 do
|
|
test(dst_arraylongword[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ test zero filldword count }
|
|
write('testing filldword (zero count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraylongword[i] := DEFAULT_VALUE;
|
|
filldword(dst_arraylongword, 0, FILL_VALUE);
|
|
for i := 1 to MAX_TABLE do
|
|
test(dst_arraylongword[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{ test negative filldword count }
|
|
write('testing filldword (negative count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
dst_arraylongword[i] := DEFAULT_VALUE;
|
|
filldword(dst_arraylongword, -1, FILL_VALUE);
|
|
writeln('Passed!');
|
|
end;
|
|
|
|
|
|
procedure test_movechar0;
|
|
begin
|
|
{ non-aligned count }
|
|
write('testing movechar0 (non-aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
movechar0(src_arraybyte, dst_arraybyte, MAX_TABLE-2);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
test(dst_arraybyte[MAX_TABLE-1], DEFAULT_VALUE);
|
|
for i:= 1 to MAX_TABLE-2 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ modulo 2 count fill }
|
|
{ non-aligned count }
|
|
write('testing movechar0 (aligned size)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
movechar0(src_arraybyte, dst_arraybyte, MAX_TABLE-1);
|
|
test(dst_arraybyte[MAX_TABLE], DEFAULT_VALUE);
|
|
for i:= 1 to MAX_TABLE-1 do
|
|
test(dst_arraybyte[i], FILL_VALUE);
|
|
writeln('Passed!');
|
|
{ zero movechar0 count }
|
|
write('test movechar0 (zero count)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := FILL_VALUE;
|
|
end;
|
|
movechar0(src_arraybyte,dst_arraybyte, 0);
|
|
for i:= 1 to MAX_TABLE do
|
|
test(dst_arraybyte[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{ withh null value as first value in index }
|
|
write('test movechar0 with null character...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
src_arraybyte[i] := 0;
|
|
end;
|
|
movechar0(src_arraybyte, dst_arraybyte, MAX_TABLE-1);
|
|
{ nothing should have been moved }
|
|
for i:= 1 to MAX_TABLE do
|
|
test(dst_arraybyte[i], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
{ with null value as second value in index }
|
|
write('test movechar0 with null character (and char)...');
|
|
for i := 1 to MAX_TABLE do
|
|
begin
|
|
dst_arraybyte[i] := DEFAULT_VALUE;
|
|
end;
|
|
src_arraybyte[1] := FILL_VALUE;
|
|
src_arraybyte[2] := 0;
|
|
movechar0(src_arraybyte, dst_arraybyte, MAX_TABLE-1);
|
|
test(dst_arraybyte[1], FILL_VALUE);
|
|
{ the rest should normally not have bene touched }
|
|
test(dst_arraybyte[2], DEFAULT_VALUE);
|
|
writeln('Passed!');
|
|
end;
|
|
{$endif}
|
|
|
|
|
|
begin
|
|
test_fillchar;
|
|
test_move;
|
|
test_move_large(500); // 512 longints=2048 bytes
|
|
{$ifndef CPU16}
|
|
test_move_large(500000);
|
|
{$endif CPU16}
|
|
{$ifdef fpc}
|
|
test_fillword;
|
|
test_filldword;
|
|
test_movechar0;
|
|
{$endif}
|
|
end.
|