From 87f46dcafd812ffd2ef6342fb545fc3ef033928b Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 5 Mar 2016 15:32:25 +0000 Subject: [PATCH] * updated pos() for Java with an offset parameter (equivalent of r31464 etc) (mantis #29626) git-svn-id: trunk@33160 - --- .gitattributes | 1 + rtl/java/jastrings.inc | 21 +- rtl/java/jsstrings.inc | 12 +- rtl/java/jsystemh.inc | 10 +- rtl/java/justrings.inc | 16 +- tests/test/jvm/testall.bat | 4 + tests/test/jvm/testall.sh | 2 + tests/test/jvm/tstring.pp | 926 +++++++++++++++++++++++++++++++++++++ 8 files changed, 963 insertions(+), 29 deletions(-) create mode 100644 tests/test/jvm/tstring.pp diff --git a/.gitattributes b/.gitattributes index df3e9b42d2..de4e2d7bd0 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/java/jastrings.inc b/rtl/java/jastrings.inc index ca3392e434..06d1b9145d 100644 --- a/rtl/java/jastrings.inc +++ b/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; diff --git a/rtl/java/jsstrings.inc b/rtl/java/jsstrings.inc index 79b2d7b10f..ec8b7a9b15 100644 --- a/rtl/java/jsstrings.inc +++ b/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 diff --git a/rtl/java/jsystemh.inc b/rtl/java/jsystemh.inc index 37c4e91456..1f77189503 100644 --- a/rtl/java/jsystemh.inc +++ b/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; diff --git a/rtl/java/justrings.inc b/rtl/java/justrings.inc index bc40e03e54..91761d1b8b 100644 --- a/rtl/java/justrings.inc +++ b/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; diff --git a/tests/test/jvm/testall.bat b/tests/test/jvm/testall.bat index cdb45c3b10..315a0d185c 100644 --- a/tests/test/jvm/testall.bat +++ b/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% diff --git a/tests/test/jvm/testall.sh b/tests/test/jvm/testall.sh index 9f725e3cf4..7a1145c3b8 100755 --- a/tests/test/jvm/testall.sh +++ b/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 diff --git a/tests/test/jvm/tstring.pp b/tests/test/jvm/tstring.pp new file mode 100644 index 0000000000..6dfcc7b9ff --- /dev/null +++ b/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.