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

git-svn-id: trunk@33700 -

packages/rtl-objpas/src/inc/strutils.pp

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

tests/test/units/fpcunit/tcstrutils.pp

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

tests/test/units/fpcunit/tstrutils.lpi

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

tests/test/units/fpcunit/tstrutils.lpr

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