* updated pos() for Java with an offset parameter (equivalent of r31464 etc)

    (mantis #29626)

git-svn-id: trunk@33160 -

.gitattributes

@@ -11614,6 +11614,7 @@ tests/test/jvm/tsetansistr.pp svneol=native#text/plain
 tests/test/jvm/tsetstring.pp svneol=native#text/plain
 tests/test/jvm/tsmallintarr.pp svneol=native#text/plain
 tests/test/jvm/tstr.pp svneol=native#text/plain
+tests/test/jvm/tstring.pp svneol=native#text/plain
 tests/test/jvm/tstring1.pp svneol=native#text/plain
 tests/test/jvm/tstring9.pp svneol=native#text/plain
 tests/test/jvm/tstrreal1.pp svneol=native#text/plain

rtl/java/jastrings.inc

@@ -702,16 +702,16 @@ end;
 
 
 {$define FPC_HAS_POS_SHORTSTR_ANSISTR}
-Function Pos(Const Substr : ShortString; Const Source : RawByteString) : SizeInt;
+Function Pos(Const Substr : ShortString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
 var
   i,j,k,MaxLen, SubstrLen : SizeInt;
 begin
   Pos:=0;
   SubstrLen:=Length(SubStr);
-  if SubstrLen>0 then
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
    begin
      MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
+     i:=Offset-1;
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -734,16 +734,16 @@ end;
 
 
 {$define FPC_HAS_POS_ANSISTR_ANSISTR}
-Function Pos(Const Substr : RawByteString; Const Source : RawByteString) : SizeInt;
+Function Pos(Const Substr : RawByteString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
 var
   i,j,k,MaxLen, SubstrLen : SizeInt;
 begin
   Pos:=0;
   SubstrLen:=Length(SubStr);
-  if SubstrLen>0 then
+  if (SubstrLen>0) and (Offset>0) and (Offset<=Length(Source)) then
    begin
      MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
+     i:=Offset-1;
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -770,11 +770,13 @@ end;
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
-Function Pos(c : AnsiChar; Const s : RawByteString) : SizeInt;
-var
+Function Pos(c : AnsiChar; Const s : RawByteString; Offset : Sizeint = 1) : SizeInt;var
   i: SizeInt;
 begin
-  for i:=1 to length(s) do
+  Pos:=0;
+  If (Offset<1) or (Offset>Length(S)) then
+    exit;
+  for i:=Offset to length(s) do
    begin
      if AnsistringClass(s).fdata[i-1]=c then
       begin
@@ -782,7 +784,6 @@ begin
         exit;
       end;
    end;
-  pos:=0;
 end;
 
 

rtl/java/jsstrings.inc

@@ -232,16 +232,16 @@ end;
 
 
 {$define FPC_HAS_SHORTSTR_POS_SHORTSTR}
-Function Pos (Const Substr : Shortstring; Const s : Shortstring) : SizeInt;
+Function Pos (Const Substr : Shortstring; Const s : Shortstring; Offset: Sizeint = 1) : SizeInt;
 var
   i,j,k,MaxLen, SubstrLen : SizeInt;
 begin
   Pos:=0;
   SubstrLen:=Length(SubStr);
-  if SubstrLen>0 then
+  if (SubstrLen>0) and (Offset>0) and (Offset<=Length(S)) then
    begin
-     MaxLen:=Length(s)-Length(SubStr);
-     i:=0;
+     MaxLen:=Length(s)-SubstrLen;
+     i:=Offset-1;
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -265,11 +265,11 @@ end;
 
 {$define FPC_HAS_SHORTSTR_POS_CHAR}
 {Faster when looking for a single char...}
-function pos(c:char;const s:shortstring):SizeInt;
+function pos(c:char;const s:shortstring; Offset: Sizeint = 1):SizeInt;
 var
   i : SizeInt;
 begin
-  for i:=0 to length(s)-1 do
+  for i:=Offset-1 to length(s)-1 do
    begin
      if ShortStringClass(@s).fdata[i]=c then
        begin

rtl/java/jsystemh.inc

@@ -461,10 +461,10 @@ var
 Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
 Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);
 Procedure Insert(source:Char;var s:shortstring;index:SizeInt);
-Function  Pos(const substr:shortstring;const s:shortstring):SizeInt;
-Function  Pos(C:Char;const s:shortstring):SizeInt;
+Function  Pos(const substr:shortstring;const s:shortstring; Offset: Sizeint = 1):SizeInt;
+Function  Pos(C:Char;const s:shortstring; Offset: Sizeint = 1):SizeInt;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function  Pos(const Substr : ShortString; const Source : RawByteString) : SizeInt;
+Function  Pos(const Substr : ShortString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt;
 
 {$ifdef FPC_HAS_CPSTRING}
 Procedure fpc_setstring_ansistr_pansichar(out S : RawByteString; Buf : PAnsiChar; Len : SizeInt; cp: TSystemCodePage); rtlproc; compilerproc;
@@ -509,8 +509,8 @@ function  pos(const substr : shortstring;c:char; Offset : Sizeint=1): SizeInt;
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE';
-Function  Pos (const Substr : RawByteString; const Source : RawByteString) : SizeInt;
-Function  Pos (c : AnsiChar; const s : RawByteString) : SizeInt;
+Function  Pos (const Substr : RawByteString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt;
+Function  Pos (c : AnsiChar; const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
 Procedure Insert (const Source : RawByteString; var S : RawByteString; Index : SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 Procedure Delete (var S : RawByteString; Index,Size: SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 Function  StringOfChar(c : Ansichar;l : SizeInt) : AnsiString;

rtl/java/justrings.inc

@@ -652,21 +652,21 @@ end;
 
 
 {$define FPC_HAS_POS_UNICODESTR_UNICODESTR}
-Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
-    Pos:=JLString(Source).indexOf(SubStr)+1;
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
+    Pos:=JLString(Source).indexOf(SubStr,Offset-1)+1
 end;
 
 
 { Faster version for a unicodechar alone }
 {$define FPC_HAS_POS_UNICODECHAR_UNICODESTR}
-Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 begin
   Pos:=0;
-  if length(S)>0 then
-    Pos:=JLString(s).indexOf(ord(c))+1;
+  if (Offset>0) and (Offset<=Length(s)) then
+    Pos:=JLString(s).indexOf(ord(c),Offset-1)+1;
 end;
 
 
@@ -675,13 +675,13 @@ end;
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
 {$define FPC_HAS_POS_CHAR_UNICODESTR}
-Function Pos (c : AnsiChar; Const s : UnicodeString) : SizeInt;
+Function Pos (c : AnsiChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   wc : unicodechar;
 begin
   wc:=c;
-  result:=Pos(wc,s);
+  result:=Pos(wc,s,Offset);
 end;
 
 

tests/test/jvm/testall.bat

@@ -328,3 +328,7 @@ ppcjvm -O2 -g -B  -CTinitlocals tw29585
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tw29585
 if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g -B  -CTinitlocals tstring
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tstring
+if %errorlevel% neq 0 exit /b %errorlevel%

tests/test/jvm/testall.sh

@@ -191,3 +191,5 @@ $PPC -O2 -g -B -Sa tprocvaranon
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprocvaranon
 $PPC -O2 -g -B -Sa tw29585
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tw29585
+$PPC -O2 -g -B -Sa tstring
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tstring

tests/test/jvm/tstring.pp

@@ -0,0 +1,926 @@
+{ Program to test system unit string routines
+  Tested against Delphi 3 and (where possible)
+  against Borland Pascal v7.01
+}
+program tstring;
+{$R+}
+{$Q+}
+
+{$ifdef CPUJVM}
+uses
+  {$ifdef java}jdk15{$else}androidr14{$endif};
+
+  {$macro on}
+  {$define writeln:=jlsystem.fout.println}
+  {$define write:=jlsystem.fout.print}
+{$endif}  
+
+{$ifndef MACOS}
+{$APPTYPE CONSOLE}
+{$else}
+{$APPTYPE TOOL}
+{$endif}
+
+{$ifdef fpc}
+  {$ifndef ver1_0}
+    {$define haswidestring}
+  {$endif}
+{$else}
+  {$ifndef ver70}
+    {$define haswidestring}
+  {$endif}
+{$endif}
+
+var
+   str1 : shortstring;
+   str2 : ansistring;
+{$ifdef haswidestring}
+   str3 : widestring;
+{$endif}
+
+
+procedure fail(apos : integer);
+ begin
+   if APos=0 then
+     WriteLn('Failed!' )
+   else
+     begin
+       Write('Failed on ');
+       WriteLn(APos);
+     end;
+   Halt(1);
+ end;
+
+procedure fail;
+ begin
+   Fail(0);
+   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 *************************}
+{$ifdef haswidestring}
+   { 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 *************************}
+{$ifdef haswidestring}
+   { 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 *************************}
+{$ifdef haswidestring}
+   { 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 *************************}
+{$ifdef haswidestring}
+   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 : integer;
+    position: integer;
+  begin
+    Write('Pos tests...');
+    _result := 0;
+   {************************* shortstring ************************}
+   str1:='Hello world';
+   position:=Pos('',str1);
+   if position <> 0 then
+     _result := 1;
+
+   str1:='';
+   position:=Pos('',str1);
+   if position <> 0 then
+     _result := 2;
+
+   str1:='Hello world';
+   position:=Pos('world',str1);
+   if position <> 7 then
+     _result := 3;
+
+   str1:='Hello world';
+   position:=Pos('world',str1);
+   if position <> 7 then
+     _result := 4;
+
+   str1:='Hello world';
+   position:=Pos('worldx',str1);
+   if position <> 0 then
+     _result := 5;
+
+   str1:='';
+   position:=Pos('worldx',str1);
+   if position <> 0 then
+     _result := 6;
+
+   {************************* ansistring *************************}
+   str2:='Hello world';
+   position:=Pos('',str2);
+   if position <> 0 then
+     _result := 7;
+
+   str2:='';
+   position:=Pos('',str2);
+   if position <> 0 then
+     _result := 8;
+
+   str2:='Hello world';
+   position:=Pos('world',str2);
+   if position <> 7 then
+     _result := 9;
+
+   str2:='Hello world';
+   position:=Pos('world',str2);
+   if position <> 7 then
+     _result := 10;
+
+   str2:='Hello world';
+   position:=Pos('worldx',str2);
+   if position <> 0 then
+     _result := 11;
+
+   str2:='';
+   position:=Pos('worldx',str2);
+   if position <> 0 then
+     _result := 12;
+
+   {************************* widestring *************************}
+{$ifdef haswidestring}
+   str3:='Hello world';
+   position:=Pos('',str3);
+   if position <> 0 then
+     _result := 13;
+
+   str3:='';
+   position:=Pos('',str3);
+   if position <> 0 then
+     _result := 14;
+
+   str3:='Hello world';
+   position:=Pos('world',str3);
+   if position <> 7 then
+     _result := 15;
+
+   str3:='Hello world';
+   position:=Pos('world',str3);
+   if position <> 7 then
+     _result := 16;
+
+   str3:='Hello world';
+   position:=Pos('worldx',str3);
+   if position <> 0 then
+     _result := 17;
+
+   str3:='';
+   position:=Pos('worldx',str3);
+   if position <> 0 then
+     _result := 18;
+
+{$endif}
+    if not (_result=0) then
+       fail(_result)
+    else
+      WriteLn('Success!');
+  end;
+
+  procedure test_pos_offset;
+  var
+    _result : integer;
+    position: integer;
+ begin
+   Write('Pos /Offset tests...');
+   _result := 0;
+  {************************* shortstring ************************}
+  str1:='Hello world';
+  position:=Pos('',str1,3);
+  if position <> 0 then
+    _result := 1;
+
+  str1:='';
+  position:=Pos('',str1,3);
+  if position <> 0 then
+    _result := 2;
+
+  str1:='Hello world';
+  position:=Pos('world',str1,3);
+  if position <> 7 then
+    _result := 3;
+
+  str1:='Hello world';
+  position:=Pos('world',str1,8);
+  if position <> 0 then
+    _result := 20;
+
+  str1:='Hello world';
+  position:=Pos('world',str1,12);
+  if position <> 0 then
+    _result := 26;
+
+  str1:='Hello world';
+  position:=Pos('world',str1,0);
+  if position <> 0 then
+    _result := 27;
+
+  str1:='Hello world';
+  position:=Pos('world',str1,3);
+  if position <> 7 then
+    _result := 4;
+
+  str1:='Hello world';
+  position:=Pos('worldx',str1,3);
+  if position <> 0 then
+    _result := 5;
+
+  str1:='';
+  position:=Pos('worldx',str1,3);
+  if position <> 0 then
+    _result := 6;
+
+  {************************* ansistring *************************}
+  str2:='Hello world';
+  position:=Pos('',str2,3);
+  if position <> 0 then
+    _result := 7;
+
+  str2:='';
+  position:=Pos('',str2,3);
+  if position <> 0 then
+    _result := 8;
+
+  str2:='Hello world';
+  position:=Pos('world',str2,3);
+  if position <> 7 then
+    _result := 9;
+
+  str2:='Hello world';
+  position:=Pos('world',str2,8);
+  if position <> 0 then
+    _result := 21;
+
+  str2:='Hello world';
+  position:=Pos('world',str2,12);
+  if position <> 0 then
+    _result := 28;
+
+  str2:='Hello world';
+  position:=Pos('world',str2,0);
+  if position <> 0 then
+    _result := 29;
+
+  str2:='Hello world';
+  position:=Pos('world',str2,3);
+  if position <> 7 then
+    _result := 10;
+
+  str2:='Hello world';
+  position:=Pos('worldx',str2,3);
+  if position <> 0 then
+    _result := 11;
+
+  str2:='';
+  position:=Pos('worldx',str2,3);
+  if position <> 0 then
+    _result := 12;
+
+  {************************* widestring *************************}
+{$ifdef haswidestring}
+  str3:='Hello world';
+  position:=Pos('',str3,3);
+  if position <> 0 then
+    _result := 13;
+
+  str3:='';
+  position:=Pos('',str3,3);
+  if position <> 0 then
+    _result := 14;
+
+  str3:='Hello world';
+  position:=Pos('world',str3,3);
+  if position <> 7 then
+    _result := 15;
+
+  str3:='Hello world';
+  position:=Pos('world',str3,3);
+  if position <> 7 then
+    _result := 16;
+
+  str3:='Hello world';
+  position:=Pos('world',str3,8);
+  if position <> 0 then
+    _result := 23;
+
+  str3:='Hello world';
+  position:=Pos('world',str3,12);
+  if position <> 0 then
+    _result := 30;
+
+  str3:='Hello world';
+  position:=Pos('world',str3,0);
+  if position <> 0 then
+    _result := 31;
+
+  str3:='Hello world';
+  position:=Pos('worldx',str3,3);
+  if position <> 0 then
+    _result := 17;
+
+  str3:='';
+  position:=Pos('worldx',str3,3);
+  if position <> 0 then
+    _result := 18;
+
+{$endif}
+   if not (_result=0) then
+      fail(_result)
+   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_pos_offset;
+  test_chr;
+end.