+ uppercase/lowercase(unicodestring) (fixes a warning in fina.inc when

    compiled with unicodestring)
  * changed uppercase/lowercase(ansistring) to use the same logic as the
    new unicode versions (unify code for lower/upper, only make result
    unique if necessary)
  + test for all four routines

git-svn-id: branches/cpstrrtl@25006 -

.gitattributes

@@ -12105,6 +12105,7 @@ tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
 tests/test/units/sysutils/tunifile.pp svneol=native#text/plain
+tests/test/units/sysutils/tuplow.pp svneol=native#text/plain
 tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
 tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain

rtl/objpas/sysutils/sysstr.inc

@@ -76,48 +76,49 @@ begin
 Dest := Dest + S;
 end ;
 
-{   UpperCase returns a copy of S where all lowercase characters ( from a to z )
-    have been converted to uppercase   }
-
+Function InternalChangeCase(Const S : AnsiString; const Chars: TSysCharSet; const Adjustment: Longint): AnsiString;
+  var
+    i : Integer;
+    P : PChar;
+    Unique : Boolean;
+  begin
+    Result := S;
+    if Result='' then
+      exit;
+    Unique:=false;
+    P:=PChar(Result);
+    for i:=1 to Length(Result) do
+      begin
+        if CharInSet(P^,Chars) then
+          begin
+            if not Unique then
+              begin
+                UniqueString(Result);
+                p:=@Result[i];
+                Unique:=true;
+              end;
+            P^:=Char(Ord(P^)+Adjustment);
+          end;
+        Inc(P);
+      end;
+  end;
 
-Function UpperCase(Const S : String) : String;
 
-Var
-  i : Integer;
-  P : PChar;
+{   UpperCase returns a copy of S where all lowercase characters ( from a to z )
+    have been converted to uppercase   }
+Function UpperCase(Const S : AnsiString) : AnsiString;
+  begin
+    Result:=InternalChangeCase(S,['a'..'z'],-32);
+  end;
 
-begin
-  Result := S;
-  if not assigned(pointer(result)) then exit;
-  UniqueString(Result);
-  P:=Pchar(pointer(Result));
-  for i := 1 to Length(Result) do
-    begin
-    if (P^ in ['a'..'z']) then P^ := char(byte(p^) - 32);
-      Inc(P);
-    end;
-end;
 
 {   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
     have been converted to lowercase  }
+Function Lowercase(Const S : AnsiString) : AnsiString;
+  begin
+    Result:=InternalChangeCase(S,['A'..'Z'],32);
+  end;
 
-Function Lowercase(Const S : String) : String;
-
-Var
-  i : Integer;
-  P : PChar;
-
-begin
-  Result := S;
-  if not assigned(pointer(result)) then exit;
-  UniqueString(Result);
-  P:=Pchar(pointer(Result));
-  for i := 1 to Length(Result) do
-    begin
-    if (P^ in ['A'..'Z']) then P^ := char(byte(p^) + 32);
-      Inc(P);
-    end;
-end;
 
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin

rtl/objpas/sysutils/sysstrh.inc

@@ -68,7 +68,7 @@ procedure DisposeStr(S: PString); overload;
 procedure DisposeStr(S: PShortString); overload;
 procedure AssignStr(var P: PString; const S: string);
 procedure AppendStr(var Dest: String; const S: string);
-function UpperCase(const s: string): string;
+function UpperCase(const s: string): string; overload;
 function LowerCase(const s: string): string; overload;
 { the compiler can't decide else if it should use the char or the ansistring
   version for a variant }

rtl/objpas/sysutils/sysuni.inc

@@ -50,6 +50,50 @@ function TrimRight(const S: unicodestring): unicodestring;
   end;
 
 
+Function InternalChangeCase(Const S : UnicodeString; const Chars: TSysCharSet; const Adjustment: Longint): UnicodeString;
+  var
+    i : Integer;
+    P : PWideChar;
+    Unique : Boolean;
+  begin
+    Result := S;
+    if Result='' then
+      exit;
+    Unique:=false;
+    P:=PWideChar(Result);
+    for i:=1 to Length(Result) do
+      begin
+        if CharInSet(P^,Chars) then
+          begin
+            if not Unique then
+              begin
+                UniqueString(Result);
+                p:=@Result[i];
+                Unique:=true;
+              end;
+            P^:=WideChar(Ord(P^)+Adjustment);
+          end;
+        Inc(P);
+      end;
+  end;
+
+
+{   UpperCase returns a copy of S where all lowercase characters ( from a to z )
+    have been converted to uppercase   }
+Function UpperCase(Const S : UnicodeString) : UnicodeString;
+  begin
+    Result:=InternalChangeCase(S,['a'..'z'],-32);
+  end;
+
+
+{   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
+    have been converted to lowercase  }
+Function Lowercase(Const S : UnicodeString) : UnicodeString;
+  begin
+    Result:=InternalChangeCase(S,['A'..'Z'],32);
+  end;
+
+
 function UnicodeUpperCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
     result:=widestringmanager.UpperUnicodeStringProc(s);

rtl/objpas/sysutils/sysunih.inc

@@ -18,6 +18,9 @@ function Trim(const S: unicodestring): unicodestring;
 function TrimLeft(const S: unicodestring): unicodestring;
 function TrimRight(const S: unicodestring): unicodestring;
 
+function UpperCase(const s: UnicodeString): UnicodeString; overload;
+function LowerCase(const s: UnicodeString): UnicodeString; overload;
+
 function UnicodeUpperCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function UnicodeLowerCase(const s : UnicodeString) : UnicodeString;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function UnicodeCompareStr(const s1, s2 : UnicodeString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}

tests/test/units/sysutils/tuplow.pp

@@ -0,0 +1,117 @@
+program tuplow;
+
+{$mode objfpc}
+{$h+}
+
+uses
+  SysUtils;
+
+procedure writestring(const s: ansistring);
+  var
+    i: longint;
+  begin
+    for i:=1 to length(s) do
+      if (s[i]<=#32) or (s[i]>=#127) then
+        write('#',ord(s[i]),' ')
+      else
+        write(s[i],' ');
+    writeln;
+  end;
+
+procedure writestring(const s: unicodestring);
+  var
+    i: longint;
+  begin
+    for i:=1 to length(s) do
+      if (s[i]<=#0032) or (s[i]>=#0127) then
+        write('#',ord(s[i]),' ')
+      else
+        write(s[i],' ');
+    writeln;
+  end;
+
+procedure error(const s1,s2: ansistring; nr: longint);
+var
+  i: longint;
+begin
+  writeln('error ',nr);
+  write('  Got: ');
+  writestring(s1);
+  write('  Expected: ');
+  writestring(s2);
+  halt(nr);
+end;
+
+procedure error(const s1,s2: unicodestring; nr: longint);
+var
+  i: longint;
+begin
+  writeln('error ',nr);
+  write('  Got: ');
+  writestring(s1);
+  write('  Expected: ');
+  writestring(s2);
+  halt(nr);
+end;
+
+
+
+procedure testuplowansi;
+  const
+    str = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'aAbBcCdD'#0'fF';
+    upperstr = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'AABBCCDD'#0'FF';
+    lowerstr = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'aabbccdd'#0'ff';
+  var
+    s1, s2: ansistring;
+  begin
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=uppercase(s1);
+    if s1<>upperstr then
+      error(s1,upperstr,1);
+    if s2<>str then
+      error(s2,str,2);
+
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=lowercase(s1);
+    if s1<>lowerstr then
+      error(s1,lowerstr,3);
+    if s2<>str then
+      error(s2,str,4);
+ end;
+
+
+procedure testuplowwide;
+  const
+    str = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'AABBCCDD'#0000'FF';
+    upperstr = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'AABBCCDD'#0000'FF';
+    lowerstr = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'aabbccdd'#0000'ff';
+  var
+    s1, s2: unicodestring;
+  begin
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=uppercase(s1);
+    if s1<>upperstr then
+      error(s1,upperstr,5);
+    if s2<>str then
+      error(s2,str,6);
+
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=lowercase(s1);
+    if s1<>lowerstr then
+      error(s1,lowerstr,7);
+    if s2<>str then
+      error(s2,str,8);
+ end;
+
+begin
+  testuplowansi;
+  testuplowwide;
+end.