mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 11:09:27 +02:00
* Patch from Graeme GeldenHuys to implement UnicodeString versions of MatchStr() and IndexStr() (bug ID 30113)
git-svn-id: trunk@33700 -
This commit is contained in:
michael
parent
5e3b22ab15
commit
8e75ac64f1
@ -44,6 +44,8 @@ Function AnsiEndsStr(const ASubText, AText: string): Boolean;
|
||||
Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;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 MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean;
|
||||
Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Miscellaneous
|
||||
@ -978,6 +980,24 @@ begin
|
||||
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
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
unit tcstrutils;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$codepage utf8}
|
||||
|
||||
interface
|
||||
|
||||
@ -9,8 +10,6 @@ uses
|
||||
|
||||
type
|
||||
|
||||
{ TTestSearchBuf }
|
||||
|
||||
TTestSearchBuf= class(TTestCase)
|
||||
Private
|
||||
Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
|
||||
@ -41,6 +40,14 @@ type
|
||||
Procedure TestDecodeSoundexInt;
|
||||
end;
|
||||
|
||||
|
||||
TTestGeneral = class(TTestCase)
|
||||
published
|
||||
procedure TestIndexStr;
|
||||
procedure TestMatchStr;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
@ -258,8 +265,56 @@ begin
|
||||
TestSearch('in',0,[soWholeWord,soDown],39);
|
||||
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
|
||||
RegisterTest(TTestSearchBuf);
|
||||
RegisterTest(TTestGeneral);
|
||||
writeln ('Testing with ', WhichSearchbuf, ' implementation');
|
||||
writeln;
|
||||
end.
|
||||
|
||||
@ -1,19 +1,24 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
<Title Value="FPCUnit Console test runner"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
@ -27,131 +32,43 @@
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||
</Item2>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="11">
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="tstrutils.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tstrutils"/>
|
||||
<CursorPos X="37" Y="6"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<UsageCount Value="44"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="tcstrutils.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcstrutils"/>
|
||||
<CursorPos X="1" Y="163"/>
|
||||
<TopLine Value="148"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="44"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="tcstringlist.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tcstringlist"/>
|
||||
<CursorPos X="19" Y="47"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="44"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<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"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tclist"/>
|
||||
<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>
|
||||
</Unit3>
|
||||
</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>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="tstrutils"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="units"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="2">
|
||||
|
||||
@ -3,6 +3,7 @@ program tstrutils;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
cwstring,
|
||||
Classes, consoletestrunner, tcstrutils, tcstringlist, tclist;
|
||||
|
||||
type
|
||||
|
||||
Loading…
Reference in New Issue
Block a user