mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 14:49:10 +02:00
+ setstring testing
* args checking is not interactive + zero and negative length checking for move/fillchar
This commit is contained in:
carl
parent
650843907e
commit
e5fcd92643
@ -1,4 +1,3 @@
|
||||
{ %INTERACTIVE }
|
||||
program targs;
|
||||
|
||||
var
|
||||
@ -12,7 +11,12 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-19 22:22:33 carl
|
||||
Revision 1.2 2002-10-20 11:44:15 carl
|
||||
+ setstring testing
|
||||
* args checking is not interactive
|
||||
+ zero and negative length checking for move/fillchar
|
||||
|
||||
Revision 1.1 2002/10/19 22:22:33 carl
|
||||
* small test for argv/argc checking
|
||||
|
||||
}
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
{ 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
|
||||
@ -10,8 +13,12 @@ const
|
||||
|
||||
|
||||
var
|
||||
dst_array : array[1..MAX_TABLE] of byte;
|
||||
src_array : array[1..MAX_TABLE] of byte;
|
||||
dst_arraybyte : array[1..MAX_TABLE] of byte;
|
||||
src_arraybyte : array[1..MAX_TABLE] of byte;
|
||||
dst_arrayword : array[1..MAX_TABLE] of word;
|
||||
src_arrayword : array[1..MAX_TABLE] of word;
|
||||
dst_arraylongword : array[1..MAX_TABLE] of longword;
|
||||
src_arratlongword : array[1..MAX_TABLE] of longword;
|
||||
i: integer;
|
||||
|
||||
|
||||
@ -34,21 +41,35 @@ procedure test_fillchar;
|
||||
{ non-aligned count }
|
||||
write('testing fillchar (non-aligned size)...');
|
||||
for i := 1 to MAX_TABLE do
|
||||
dst_array[i] := DEFAULT_VALUE;
|
||||
fillchar(dst_array, MAX_TABLE-2, FILL_VALUE);
|
||||
test(dst_array[MAX_TABLE], DEFAULT_VALUE);
|
||||
test(dst_array[MAX_TABLE-1], DEFAULT_VALUE);
|
||||
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_array[i], FILL_VALUE);
|
||||
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_array[i] := DEFAULT_VALUE;
|
||||
fillchar(dst_array, MAX_TABLE-1, FILL_VALUE);
|
||||
test(dst_array[MAX_TABLE], DEFAULT_VALUE);
|
||||
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_array[i], FILL_VALUE);
|
||||
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!');
|
||||
{ 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);
|
||||
writeln('Passed!');
|
||||
end;
|
||||
|
||||
@ -59,40 +80,212 @@ begin
|
||||
write('testing move (non-aligned size)...');
|
||||
for i := 1 to MAX_TABLE do
|
||||
begin
|
||||
dst_array[i] := DEFAULT_VALUE;
|
||||
src_array[i] := FILL_VALUE;
|
||||
dst_arraybyte[i] := DEFAULT_VALUE;
|
||||
src_arraybyte[i] := FILL_VALUE;
|
||||
end;
|
||||
move(src_array, dst_array, MAX_TABLE-2);
|
||||
test(dst_array[MAX_TABLE], DEFAULT_VALUE);
|
||||
test(dst_array[MAX_TABLE-1], DEFAULT_VALUE);
|
||||
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_array[i], FILL_VALUE);
|
||||
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_array[i] := DEFAULT_VALUE;
|
||||
src_array[i] := FILL_VALUE;
|
||||
dst_arraybyte[i] := DEFAULT_VALUE;
|
||||
src_arraybyte[i] := FILL_VALUE;
|
||||
end;
|
||||
move(src_array, dst_array, MAX_TABLE-1);
|
||||
test(dst_array[MAX_TABLE], DEFAULT_VALUE);
|
||||
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_array[i], FILL_VALUE);
|
||||
test(dst_arraybyte[i], FILL_VALUE);
|
||||
writeln('Passed!');
|
||||
{ zero move count }
|
||||
write('test 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!');
|
||||
{ negative move count }
|
||||
write('test move (negative count)...');
|
||||
move(src_arraybyte,dst_arraybyte,-12);
|
||||
writeln('Passed!');
|
||||
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;
|
||||
{$ifdef fpc}
|
||||
test_fillword;
|
||||
test_filldword;
|
||||
test_movechar0;
|
||||
{$endif}
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-09-07 15:40:56 peter
|
||||
Revision 1.3 2002-10-20 11:44:15 carl
|
||||
+ setstring testing
|
||||
* args checking is not interactive
|
||||
+ zero and negative length checking for move/fillchar
|
||||
|
||||
Revision 1.2 2002/09/07 15:40:56 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.1 2002/03/05 21:52:00 carl
|
||||
|
||||
170
tests/test/units/system/tsetstr.pp
Normal file
170
tests/test/units/system/tsetstr.pp
Normal file
@ -0,0 +1,170 @@
|
||||
{ Program to test system unit setstring routines
|
||||
Tested against Delphi 3 and (where possible)
|
||||
against Borland Pascal v7.01
|
||||
Copyright (c) 2002 Carl Eric Codere
|
||||
}
|
||||
program tsetstr;
|
||||
{$R+}
|
||||
{$Q+}
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
{$ifdef fpc}
|
||||
{$ifndef ver1_0}
|
||||
{$define haswidestring}
|
||||
{$endif}
|
||||
{$else}
|
||||
{$ifndef ver70}
|
||||
{$define haswidestring}
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$ifdef fpc}
|
||||
uses strings;
|
||||
{$else}
|
||||
uses sysutils;
|
||||
{$endif}
|
||||
const
|
||||
HELLO_STRING = 'Hello my little world!';
|
||||
PCHAR_NULL = nil;
|
||||
PCHAR_EMPTY : pchar = #0;
|
||||
PCHAR_NORMAL : pchar = HELLO_STRING;
|
||||
|
||||
|
||||
var
|
||||
str1 : shortstring;
|
||||
str2 : ansistring;
|
||||
{$ifdef haswidestring}
|
||||
str3 : widestring;
|
||||
{$endif}
|
||||
|
||||
procedure fail;
|
||||
begin
|
||||
WriteLn('Failed!');
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
procedure test_shortstring;
|
||||
var
|
||||
_failed : boolean;
|
||||
begin
|
||||
_failed := false;
|
||||
write('Testing setstring() with shortstring...');
|
||||
{ buffer : pchar with #0 character }
|
||||
{ pchar = nil }
|
||||
{ pchar = valid value }
|
||||
str1:='';
|
||||
setstring(str1, PCHAR_NULL, 0);
|
||||
if str1 <> '' then
|
||||
_failed := true;
|
||||
str1:='';
|
||||
setstring(str1,PCHAR_EMPTY,strlen(PCHAR_EMPTY));
|
||||
if str1 <> '' then
|
||||
_failed := true;
|
||||
setstring(str1,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str1 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
{ len = 0, len = normal length, len > 255 }
|
||||
str1:='';
|
||||
setstring(str1, PCHAR_NORMAL, 0);
|
||||
if str1 <> '' then
|
||||
_failed := true;
|
||||
str1:='';
|
||||
setstring(str1,PCHAR_NORMAL,512);
|
||||
if str1 <> '' then
|
||||
_failed := true;
|
||||
str1:='';
|
||||
setstring(str1,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str1 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
if _failed then
|
||||
fail;
|
||||
writeln('Passed!');
|
||||
end;
|
||||
|
||||
|
||||
procedure test_ansistring;
|
||||
var
|
||||
_failed : boolean;
|
||||
begin
|
||||
_failed := false;
|
||||
write('Testing setstring() with ansistring...');
|
||||
{ buffer : pchar with #0 character }
|
||||
{ pchar = nil }
|
||||
{ pchar = valid value }
|
||||
str2:='';
|
||||
setstring(str2, PCHAR_NULL, 0);
|
||||
if str2 <> '' then
|
||||
_failed := true;
|
||||
str2:='';
|
||||
setstring(str2,PCHAR_EMPTY,strlen(PCHAR_EMPTY));
|
||||
if str2 <> '' then
|
||||
_failed := true;
|
||||
setstring(str2,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str2 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
{ len = 0, len = normal length, len > 255 }
|
||||
str2:='';
|
||||
setstring(str2, PCHAR_NORMAL, 0);
|
||||
if str2 <> '' then
|
||||
_failed := true;
|
||||
str2:='';
|
||||
setstring(str2,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str2 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
if _failed then
|
||||
fail;
|
||||
writeln('Passed!');
|
||||
end;
|
||||
|
||||
{$ifdef haswidestring}
|
||||
procedure test_widestring;
|
||||
var
|
||||
_failed : boolean;
|
||||
begin
|
||||
_failed := false;
|
||||
write('Testing setstring() with widestring...');
|
||||
{ buffer : pchar with #0 character }
|
||||
{ pchar = nil }
|
||||
{ pchar = valid value }
|
||||
str3:='';
|
||||
setstring(str3, PCHAR_NULL, 0);
|
||||
if str3 <> '' then
|
||||
_failed := true;
|
||||
str3:='';
|
||||
setstring(str3,PCHAR_EMPTY,strlen(PCHAR_EMPTY));
|
||||
if str3 <> '' then
|
||||
_failed := true;
|
||||
setstring(str3,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str3 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
{ len = 0, len = normal length, len > 255 }
|
||||
str3:='';
|
||||
setstring(str3, PCHAR_NORMAL, 0);
|
||||
if str3 <> '' then
|
||||
_failed := true;
|
||||
str3:='';
|
||||
setstring(str3,PCHAR_NORMAL,strlen(PCHAR_NORMAL));
|
||||
if str3 <> HELLO_STRING then
|
||||
_failed := true;
|
||||
if _failed then
|
||||
fail;
|
||||
writeln('Passed!');
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
Begin
|
||||
test_shortstring;
|
||||
test_ansistring;
|
||||
{$ifdef haswidestring}
|
||||
test_widestring;
|
||||
{$endif}
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-20 11:44:15 carl
|
||||
+ setstring testing
|
||||
* args checking is not interactive
|
||||
+ zero and negative length checking for move/fillchar
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user