* first revision (incomplete!)

tests/test/units/system/tstring.pp

@@ -0,0 +1,737 @@
+{ Program to test system unit string routines 
+  Tested against Delphi 3 and (where possible)
+  against Borland Pascal v7.01
+}
+program tstring;
+{$R+}
+{$Q+}
+{$APPTYPE CONSOLE}
+
+
+var
+   str1 : shortstring;
+   str2 : ansistring;
+{$ifndef ver1_0}   
+   str3 : widestring;
+{$endif}   
+
+
+procedure fail;
+ begin
+   WriteLn('Failed!');
+   Halt(1);
+ end;
+
+
+procedure test_stringofchar;
+ var
+   _result : boolean;
+   i: integer;
+ begin
+   Write('StringOfChar tests...');
+   _result := true;
+   {************************* shortstring ************************}
+   { try to fill a shortstring with a null character }
+   str1:='';
+   str1:=stringofchar(#0,0);
+   if length(str1)<>0 then
+     _result := false;    
+   str1:='';
+   
+   str1:='';
+   str1:=stringofchar('a',-1);
+   if length(str1)<>0 then
+     _result := false;    
+   str1:='';
+   
+   
+   { try to fill a shortstring with more chars than possible }
+   str1:=stringofchar('c',300);
+   if length(str1)<>255 then
+     _result := false;    
+   { try to fill a shortstring with no chars }
+   str1:='';
+   str1:=stringofchar('c',0);
+   if length(str1)<>0 then
+     _result := false;    
+   { try to fill a shortstring chars }
+   str1:='';
+   str1:=stringofchar('a',255);
+   for i:=1 to 255 do
+     if str1[i] <> 'a' then 
+        _result := false;
+   {************************* ansistring *************************}
+   { try to fill a ansistring with a null character }
+   str2:='';
+   str2:=stringofchar(#0,0);
+   if length(str2)<>0 then
+     _result := false;    
+     
+   str2:='';
+   str2:=stringofchar('a',-1);
+   if length(str2)<>0 then
+     _result := false;    
+     
+   { try to fill a ansistring with no chars }
+   str2:='';
+   str2:=stringofchar('c',0);
+   if length(str2)<>0 then
+     _result := false;    
+   { try to fill an ansistring chars }
+   str2:='';
+   str2:=stringofchar('a',1024);
+   for i:=1 to 1024 do
+     if str2[i] <> 'a' then 
+        _result := false;
+   {************************* widestring *************************}
+{$ifndef ver1_0}   
+   { try to fill a widestring with a null character }
+   str3:='';
+   str3:=stringofchar(#0,0);
+   if length(str3)<>0 then
+     _result := false;    
+   str3:='';
+   { try to fill a widestring with no chars }
+   str3:='';
+   str3:=stringofchar('c',0);
+   if length(str3)<>0 then
+     _result := false;    
+   { try to fill an widestring chars }
+   str3:='';
+   str3:=stringofchar('a',1024);
+   for i:=1 to 1024 do
+     if str3[i] <> 'a' then 
+        _result := false;
+        
+   str3:='';
+   str3:=stringofchar('a',-1);
+   if length(str3)<>0 then
+     _result := false;    
+        
+{$endif}     
+   if not _result then
+      fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+ 
+ procedure test_delete;
+ var
+   _result : boolean;
+   i: integer;
+ begin
+   Write('Delete tests...');
+   _result := true;
+   {************************* shortstring ************************}
+   { try to delete from an empty string }
+   str1:='';
+   Delete(str1,0,12);
+   if str1<>'' then
+     _result := false;
+     
+   str1:='Hello';
+   Delete(str1,0,12);
+   if str1<>'Hello' then
+     _result := false;
+     
+   str1:='Hello';
+   Delete(str1,1,12);
+   if str1<>'' then
+     _result := false;
+     
+   str1:='Hello';
+   Delete(str1,12,255);
+   if str1<>'Hello' then
+     _result := false;
+     
+   str1:='Hello';
+   Delete(str1,-1,255);
+   if str1<>'Hello' then
+     _result := false;
+     
+   str1:='Hello';
+   Delete(str1,1,-12);
+   if str1<>'Hello' then
+     _result := false;
+     
+   {************************* ansistring *************************}
+   { try to delete from an empty string }
+   str2:='';
+   Delete(str2,0,12);
+   if str2<>'' then
+     _result := false;
+     
+   str2:='Hello';
+   Delete(str2,0,12);
+   if str2<>'Hello' then
+     _result := false;
+     
+   str2:='Hello';
+   Delete(str2,1,12);
+   if str2<>'' then
+     _result := false;
+     
+   str2:='Hello';
+   Delete(str2,12,255);
+   if str2<>'Hello' then
+     _result := false;
+     
+   STR2:='Hello';
+   Delete(STR2,-1,255);
+   if STR2<>'Hello' then
+     _result := false;
+     
+   STR2:='Hello';
+   Delete(STR2,1,-12);
+   if STR2<>'Hello' then
+     _result := false;
+     
+   {************************* widestring *************************}
+{$ifndef ver1_0}   
+   { try to delete from an empty string }
+   str3:='';
+   Delete(str3,0,12);
+   if str3<>'' then
+     _result := false;
+     
+   str3:='Hello';
+   Delete(str3,0,12);
+   if str3<>'Hello' then
+     _result := false;
+     
+   str3:='Hello';
+   Delete(str3,1,12);
+   if str3<>'' then
+     _result := false;
+     
+   str3:='Hello';
+   Delete(str3,12,255);
+   if str3<>'Hello' then
+     _result := false;
+
+   str3:='Hello';
+   Delete(str3,-1,255);
+   if str3<>'Hello' then
+     _result := false;
+     
+   str3:='Hello';
+   Delete(str3,1,-12);
+   if str3<>'Hello' then
+     _result := false;
+     
+{$endif}   
+   if not _result then
+      fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+ procedure test_copy;
+  var
+    _result : boolean;
+    i: integer;
+  begin
+    Write('Copy tests...');
+    _result := true;
+    
+   {************************* shortstring ************************}
+   { try to copy from an empty string }
+   str1:='';
+   str1:=Copy(str1,1,12);
+   if str1<>'' then
+     _result := false;
+     
+   str1:='';  
+   str1:=Copy('Hello world',0,12);
+   if str1<>'Hello world' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',1,12);
+   if str1<>'Hello world' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',-12,12);
+   if str1<>'Hello world' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',64,128);
+   if str1<>'' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',1,-12);
+   if str1<>'' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',-12,0);
+   if str1<>'' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',7,11);
+   if str1<>'world' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('Hello world',1,11);
+   if str1<>'Hello world' then
+     _result := false;
+
+   str1:='';  
+   str1:=Copy('',0,12);
+   if str1<>'' then
+     _result := false;
+
+   {************************* ansistring *************************}
+   { try to copy from an empty string }
+   str2:='';
+   str2:=Copy(str2,1,12);
+   if str2<>'' then
+     _result := false;
+     
+   str2:='';  
+   str2:=Copy('Hello world',0,12);
+   if str2<>'Hello world' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',1,12);
+   if str2<>'Hello world' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',-12,12);
+   if str2<>'Hello world' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',64,128);
+   if str2<>'' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',1,-12);
+   if str2<>'' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',-12,0);
+   if str2<>'' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',7,11);
+   if str2<>'world' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('Hello world',1,11);
+   if str2<>'Hello world' then
+     _result := false;
+
+   str2:='';  
+   str2:=Copy('',0,12);
+   if str2<>'' then
+     _result := false;
+   {************************* widestring *************************}
+{$ifndef ver1_0}   
+   { try to copy from an empty string }
+   str3:='';
+   str3:=Copy(str3,1,12);
+   if str3<>'' then
+     _result := false;
+     
+   str3:='';  
+   str3:=Copy('Hello world',0,12);
+   if str3<>'Hello world' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',1,12);
+   if str3<>'Hello world' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',-12,12);
+   if str3<>'Hello world' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',64,128);
+   if str3<>'' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',1,-12);
+   if str3<>'' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',-12,0);
+   if str3<>'' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',7,11);
+   if str3<>'world' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('Hello world',1,11);
+   if str3<>'Hello world' then
+     _result := false;
+
+   str3:='';  
+   str3:=Copy('',0,12);
+   if str3<>'' then
+     _result := false;
+{$endif}   
+    if not _result then
+       fail
+    else
+      WriteLn('Success!');
+  end;
+  
+  
+procedure test_insert;
+ var
+   _result : boolean;
+   i: integer;
+ begin
+   Write('Insert tests...');
+   _result := true;
+   {************************* shortstring ************************}
+   str1:='Hello world';
+   Insert(' this is my ',str1,-12);
+   if str1<>' this is my Hello world' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert(' this is my ',str1,0);
+   if str1<>' this is my Hello world' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert(' this is my ',str1,64);
+   if str1<>'Hello world this is my ' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert(' this is my ',str1,300);
+   if str1<>'Hello world this is my ' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert(' this is my ',str1,length(str1)+1);
+   if str1<>'Hello world this is my ' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert('this is my ',str1,7);
+   if str1<>'Hello this is my world' then
+     _result := false;
+     
+   str1:='';
+   Insert(' this is my ',str1,0);
+   if str1<>' this is my ' then
+     _result := false;
+     
+   str1:='';
+   Insert(' this is my ',str1,length(str1));
+   if str1<>' this is my ' then
+     _result := false;
+
+   str1:='';
+   Insert(' this is my ',str1,32);
+   if str1<>' this is my ' then
+     _result := false;
+
+   str1:='Hello world';
+   Insert('',str1,0);
+   if str1<>'Hello world' then
+     _result := false;
+     
+   str1:='Hello world';
+   Insert('',str1,7);
+   if str1<>'Hello world' then
+     _result := false;
+
+   {************************* ansistring *************************}
+   str2:='Hello world';
+   Insert(' this is my ',str2,-12);
+   if str2<>' this is my Hello world' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert(' this is my ',str2,0);
+   if str2<>' this is my Hello world' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert(' this is my ',str2,64);
+   if str2<>'Hello world this is my ' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert(' this is my ',str2,300);
+   if str2<>'Hello world this is my ' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert(' this is my ',str2,length(str2)+1);
+   if str2<>'Hello world this is my ' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert('this is my ',str2,7);
+   if str2<>'Hello this is my world' then
+     _result := false;
+     
+   str2:='';
+   Insert(' this is my ',str2,0);
+   if str2<>' this is my ' then
+     _result := false;
+     
+   str2:='';
+   Insert(' this is my ',str2,length(str2));
+   if str2<>' this is my ' then
+     _result := false;
+
+   str2:='';
+   Insert(' this is my ',str2,32);
+   if str2<>' this is my ' then
+     _result := false;
+
+   str2:='Hello world';
+   Insert('',str2,0);
+   if str2<>'Hello world' then
+     _result := false;
+     
+   str2:='Hello world';
+   Insert('',str2,7);
+   if str2<>'Hello world' then
+     _result := false;
+
+   {************************* widestring *************************}
+{$ifndef ver1_0}   
+   str3:='Hello world';
+   Insert(' this is my ',str3,-12);
+   if str3<>' this is my Hello world' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert(' this is my ',str3,0);
+   if str3<>' this is my Hello world' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert(' this is my ',str3,64);
+   if str3<>'Hello world this is my ' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert(' this is my ',str3,300);
+   if str3<>'Hello world this is my ' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert(' this is my ',str3,length(str3)+1);
+   if str3<>'Hello world this is my ' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert('this is my ',str3,7);
+   if str3<>'Hello this is my world' then
+     _result := false;
+     
+   str3:='';
+   Insert(' this is my ',str3,0);
+   if str3<>' this is my ' then
+     _result := false;
+     
+   str3:='';
+   Insert(' this is my ',str3,length(str3));
+   if str3<>' this is my ' then
+     _result := false;
+
+   str3:='';
+   Insert(' this is my ',str3,32);
+   if str3<>' this is my ' then
+     _result := false;
+
+   str3:='Hello world';
+   Insert('',str3,0);
+   if str3<>'Hello world' then
+     _result := false;
+     
+   str3:='Hello world';
+   Insert('',str3,7);
+   if str3<>'Hello world' then
+     _result := false;
+
+{$endif}
+
+   if not _result then
+      fail
+   else
+     WriteLn('Success!');
+ end;
+   
+ procedure test_pos;
+  var
+    _result : boolean;
+    position: integer;
+  begin
+    Write('Pos tests...');
+    _result := true;
+   {************************* shortstring ************************}
+   str1:='Hello world';
+   position:=Pos('',str1);
+   if position <> 0 then
+     _result := false;
+
+   str1:='';
+   position:=Pos('',str1);
+   if position <> 0 then
+     _result := false;
+     
+   str1:='Hello world';
+   position:=Pos('world',str1);
+   if position <> 7 then
+     _result := false;
+     
+   str1:='Hello world';
+   position:=Pos('world',str1);
+   if position <> 7 then
+     _result := false;
+     
+   str1:='Hello world';
+   position:=Pos('worldx',str1);
+   if position <> 0 then
+     _result := false;
+     
+   str1:='';
+   position:=Pos('worldx',str1);
+   if position <> 0 then
+     _result := false;
+    
+   {************************* ansistring *************************}
+   str2:='Hello world';
+   position:=Pos('',str2);
+   if position <> 0 then
+     _result := false;
+
+   str2:='';
+   position:=Pos('',str2);
+   if position <> 0 then
+     _result := false;
+     
+   str2:='Hello world';
+   position:=Pos('world',str2);
+   if position <> 7 then
+     _result := false;
+     
+   str2:='Hello world';
+   position:=Pos('world',str2);
+   if position <> 7 then
+     _result := false;
+     
+   str2:='Hello world';
+   position:=Pos('worldx',str2);
+   if position <> 0 then
+     _result := false;
+     
+   str2:='';
+   position:=Pos('worldx',str2);
+   if position <> 0 then
+     _result := false;
+
+   {************************* widestring *************************}
+{$ifndef ver1_0}   
+   str3:='Hello world';
+   position:=Pos('',str3);
+   if position <> 0 then
+     _result := false;
+
+   str3:='';
+   position:=Pos('',str3);
+   if position <> 0 then
+     _result := false;
+     
+   str3:='Hello world';
+   position:=Pos('world',str3);
+   if position <> 7 then
+     _result := false;
+     
+   str3:='Hello world';
+   position:=Pos('world',str3);
+   if position <> 7 then
+     _result := false;
+     
+   str3:='Hello world';
+   position:=Pos('worldx',str3);
+   if position <> 0 then
+     _result := false;
+     
+   str3:='';
+   position:=Pos('worldx',str3);
+   if position <> 0 then
+     _result := false;
+    
+{$endif}     
+    if not _result then
+       fail
+    else
+      WriteLn('Success!');
+  end;
+  
+ procedure test_chr;
+  var
+   c: char;
+   _result : boolean;
+  begin
+    Write('Chr tests...');
+    _result := true;
+{    c:=chr($3074);
+     if c<>'t' then
+       _result := false;
+  The above statement compile under Delphi, and it
+  should not imho. Freepascal gives a range-check
+  error, as it should.
+}
+    if chr(76)<>'L' then
+      _result := false;
+      
+    if _result = false then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+ 
+ 
+ procedure test_concat;
+ var
+   _result : boolean;
+   i: integer;
+ begin
+   Write('Concat tests...');
+   _result := true;
+   if not _result then
+      fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+Begin
+  test_delete;
+  test_stringofchar;
+  test_copy;
+  test_insert;
+  test_pos;
+  test_chr;
+end.