+ setstring testing

  * args checking is not interactive
  + zero and negative length checking for move/fillchar

tests/test/units/system/targs.pp

@@ -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
 
 }

tests/test/units/system/tmem.pp

@@ -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

tests/test/units/system/tsetstr.pp

@@ -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
+
+}