paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:00:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
(mantis #29626)

git-svn-id: trunk@33160 -
This commit is contained in:
Jonas Maebe 2016-03-05 15:32:25 +00:00
parent a100309350
commit 87f46dcafd
8 changed files with 963 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

21
rtl/java/jastrings.inc
View File

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

12
rtl/java/jsstrings.inc
View File

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

10
rtl/java/jsystemh.inc
View File

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

16
rtl/java/justrings.inc
View File

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

4
tests/test/jvm/testall.bat
View File

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

2
tests/test/jvm/testall.sh
View File

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

926
tests/test/jvm/tstring.pp Normal file
View File

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