paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 15:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Graeme GeldenHuys to implement UnicodeString versions of MatchStr() and IndexStr() (bug ID 30113)

Browse Source 
git-svn-id: trunk@33700 -
This commit is contained in:
michael 2016-05-16 16:40:27 +00:00
parent 5e3b22ab15
commit 8e75ac64f1
4 changed files with 106 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/rtl-objpas/src/inc/strutils.pp
View File

@ -44,6 +44,8 @@ Function AnsiEndsStr(const ASubText, AText: string): Boolean;
Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline; Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline;
Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline; Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline;
Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer; Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean;
Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Miscellaneous Miscellaneous
@ -978,6 +980,24 @@ begin
end; end;
Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean;
begin
Result := IndexStr(AText,AValues) <> -1;
end;
Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
var
i: longint;
begin
Result := -1;
if (high(AValues) = -1) or (High(AValues) > MaxInt) Then
Exit;
for i := low(AValues) to High(Avalues) do
if (avalues[i] = AText) Then
exit(i); // make sure it is the first val.
end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Playthingies Playthingies
---------------------------------------------------------------------} ---------------------------------------------------------------------}

59
tests/test/units/fpcunit/tcstrutils.pp
View File

@ -1,6 +1,7 @@
unit tcstrutils; unit tcstrutils;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$codepage utf8}
interface interface
@ -9,8 +10,6 @@ uses
type type
{ TTestSearchBuf }
TTestSearchBuf= class(TTestCase) TTestSearchBuf= class(TTestCase)
Private Private
Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer); Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
@ -41,6 +40,14 @@ type
Procedure TestDecodeSoundexInt; Procedure TestDecodeSoundexInt;
end; end;
TTestGeneral = class(TTestCase)
published
procedure TestIndexStr;
procedure TestMatchStr;
end;
implementation implementation
Const Const
@ -258,8 +265,56 @@ begin
TestSearch('in',0,[soWholeWord,soDown],39); TestSearch('in',0,[soWholeWord,soDown],39);
end; end;
procedure TTestGeneral.TestIndexStr;
var
s: UnicodeString;
a: array of UnicodeString;
begin
s := 'Henry';
AssertTrue('Failed on 1', IndexStr(s, ['Brian', 'Jim', 'Henry']) = 2);
AssertTrue('Failed on 2', IndexStr(s, ['Brian', 'Jim', 'henry']) = -1);
AssertTrue('Failed on 3', IndexStr(s, ['BRIAN', 'JIM', 'HENRY']) = -1);
s := 'HENRY';
AssertTrue('Failed on 4', IndexStr(s, ['BRIAN', 'HENRY', 'JIM']) = 1);
SetLength(a, 3);
a[0] := 'Brian';
a[1] := 'Jim';
a[2] := 'Henry';
AssertTrue('Failed on 5', IndexStr(s, a) = -1);
s := 'Henry';
AssertTrue('Failed on 6', IndexStr(s, a) = 2);
a[2] := 'henry';
AssertTrue('Failed on 7', IndexStr(s, a) = -1);
end;
procedure TTestGeneral.TestMatchStr;
var
s: UnicodeString;
a: array of UnicodeString;
begin
s := 'Henry';
AssertEquals('Failed on 1', True, MatchStr(s, ['Brian', 'Jim', 'Henry']));
AssertEquals('Failed on 2', False, MatchStr(s, ['Brian', 'Jim', 'henry']));
AssertEquals('Failed on 3', False, MatchStr(s, ['BRIAN', 'JIM', 'HENRY']));
s := 'HENRY';
AssertEquals('Failed on 4', True, MatchStr(s, ['BRIAN', 'HENRY', 'JIM']));
SetLength(a, 3);
a[0] := 'Brian';
a[1] := 'Jim';
a[2] := 'Henry';
AssertEquals('Failed on 5', False, MatchStr(s, a));
s := 'Henry';
AssertEquals('Failed on 6', True, MatchStr(s, a));
a[2] := 'henry';
AssertEquals('Failed on 7', False, MatchStr(s, a));
end;
initialization initialization
RegisterTest(TTestSearchBuf); RegisterTest(TTestSearchBuf);
RegisterTest(TTestGeneral);
writeln ('Testing with ', WhichSearchbuf, ' implementation'); writeln ('Testing with ', WhichSearchbuf, ' implementation');
writeln; writeln;
end. end.

139
tests/test/units/fpcunit/tstrutils.lpi
View File

@ -1,19 +1,24 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="/"/> <Version Value="9"/>
<Version Value="6"/>
<General> <General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <Title Value="FPCUnit Console test runner"/>
<TargetFileExt Value=""/> <ResourceType Value="res"/>
<ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/> <Language Value=""/>
<CharSet Value=""/> <CharSet Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo> </VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/> <IgnoreBinaries Value="False"/>
@ -27,131 +32,43 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="1">
<Item1> <Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="FPCUnitConsoleRunner"/> <PackageName Value="FPCUnitConsoleRunner"/>
</Item2> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="11"> <Units Count="4">
<Unit0> <Unit0>
<Filename Value="tstrutils.lpr"/> <Filename Value="tstrutils.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tstrutils"/>
<CursorPos X="37" Y="6"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="tcstrutils.pp"/> <Filename Value="tcstrutils.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tcstrutils"/>
<CursorPos X="1" Y="163"/>
<TopLine Value="148"/>
<EditorIndex Value="0"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="tcstringlist.pp"/> <Filename Value="tcstringlist.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tcstringlist"/>
<CursorPos X="19" Y="47"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../../../../fpc/packages/fcl-fpcunit/src/fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="6" Y="554"/>
<TopLine Value="524"/>
<UsageCount Value="8"/>
</Unit3>
<Unit4>
<Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
<CursorPos X="1" Y="233"/>
<TopLine Value="212"/>
<EditorIndex Value="4"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="searchbuf.inc"/>
<CursorPos X="47" Y="117"/>
<TopLine Value="65"/>
<UsageCount Value="8"/>
</Unit5>
<Unit6>
<Filename Value="tclist.pp"/> <Filename Value="tclist.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tclist"/> </Unit3>
<CursorPos X="66" Y="341"/>
<TopLine Value="346"/>
<EditorIndex Value="3"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../../../fpc/rtl/objpas/classes/resreference.inc"/>
<CursorPos X="39" Y="345"/>
<TopLine Value="311"/>
<UsageCount Value="21"/>
</Unit7>
<Unit8>
<Filename Value="../../../../fpc/rtl/objpas/classes/lists.inc"/>
<CursorPos X="20" Y="271"/>
<TopLine Value="222"/>
<EditorIndex Value="5"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="testll.pp"/>
<UnitName Value="Testll"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="20"/>
</Unit9>
<Unit10>
<Filename Value="../../../../testsi.pp"/>
<UnitName Value="testsi"/>
<CursorPos X="1" Y="12"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit10>
</Units> </Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="tcstrutils.pp"/>
<Caret Line="164" Column="5" TopLine="109"/>
</Position1>
<Position2>
<Filename Value="tcstrutils.pp"/>
<Caret Line="163" Column="1" TopLine="161"/>
</Position2>
</JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="11"/>
<CodeGeneration> <Target>
<Generate Value="Faster"/> <Filename Value="tstrutils"/>
</CodeGeneration> </Target>
<Linking> <SearchPaths>
<Debugging> <UnitOutputDirectory Value="units"/>
<GenerateDebugInfo Value="True"/> </SearchPaths>
</Debugging> <Parsing>
</Linking> <SyntaxOptions>
<Other> <AllowLabel Value="False"/>
<CompilerPath Value="$(CompPath)"/> </SyntaxOptions>
</Other> </Parsing>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="2"> <Exceptions Count="2">

1
tests/test/units/fpcunit/tstrutils.lpr
View File

@ -3,6 +3,7 @@ program tstrutils;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
uses uses
cwstring,
Classes, consoletestrunner, tcstrutils, tcstringlist, tclist; Classes, consoletestrunner, tcstrutils, tcstringlist, tclist;
type type