* CompareText for shortstrings added

  * optimize CompareText
  * use CompareText for case-insenstive compares in the RTL
  patches from Sergei Gorelkin

git-svn-id: trunk@9384 -

rtl/inc/objpas.inc

@@ -245,13 +245,11 @@
       class function TObject.MethodAddress(const name : shortstring) : pointer;
 
         var
-           UName : ShortString;
            methodtable : pmethodnametable;
            i : dword;
            vmt : tclass;
 
         begin
-           UName := UpCase(name);
            vmt:=self;
            while assigned(vmt) do
              begin
@@ -259,7 +257,7 @@
                 if assigned(methodtable) then
                   begin
                      for i:=0 to methodtable^.count-1 do
-                       if UpCase(methodtable^.entries[i].name^)=UName then
+                       if ShortCompareText(methodtable^.entries[i].name^, name)=0 then
                          begin
                             MethodAddress:=methodtable^.entries[i].addr;
                             exit;
@@ -323,7 +321,6 @@
            end;
 
         var
-           UName: ShortString;
            CurClassType: TClass;
            FieldTable: PFieldTable;
            FieldInfo: PFieldInfo;
@@ -332,7 +329,6 @@
         begin
            if Length(name) > 0 then
            begin
-             UName := UpCase(name);
              CurClassType := ClassType;
              while CurClassType <> nil do
              begin
@@ -342,7 +338,7 @@
                  FieldInfo := @FieldTable^.Fields[0];
                  for i := 0 to FieldTable^.FieldCount - 1 do
                  begin
-                   if UpCase(FieldInfo^.Name) = UName then
+                   if ShortCompareText(FieldInfo^.Name, name) = 0 then
                    begin
                      fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
                      exit;
@@ -384,7 +380,7 @@
       class function TObject.ClassNameIs(const name : string) : boolean;
 
         begin
-           ClassNameIs:=Upcase(ClassName)=Upcase(name);
+           ClassNameIs:=ShortCompareText(ClassName, name) = 0;
         end;
 
       class function TObject.InheritsFrom(aclass : TClass) : Boolean;

rtl/inc/sstrings.inc

@@ -1341,3 +1341,40 @@ begin
     end;
 end;
 
+function ShortCompareText(const S1, S2: shortstring): SizeInt;
+var
+  c1, c2: Byte;
+  i: Integer;
+  L1, L2, Count: SizeInt;
+  P1, P2: PChar;
+begin
+  L1 := Length(S1);
+  L2 := Length(S2);
+  if L1 > L2 then
+    Count := L2
+  else
+    Count := L1;
+  i := 0;
+  P1 := @S1[1];
+  P2 := @S2[1];
+  while i < count do
+  begin
+    c1 := byte(p1^);
+    c2 := byte(p2^);
+    if c1 <> c2 then
+    begin
+      if c1 in [97..122] then
+        Dec(c1, 32);
+      if c2 in [97..122] then
+        Dec(c2, 32);
+      if c1 <> c2 then
+        Break;
+    end;
+    Inc(P1); Inc(P2); Inc(I);
+  end;
+  if i < count then
+    ShortCompareText := c1 - c2
+  else
+    ShortCompareText := L1 - L2;
+end;
+

rtl/inc/systemh.inc

@@ -561,6 +561,7 @@ Function  Pos (const Substr : ShortString; const Source : AnsiString) : SizeInt;
 Procedure SetString (out S : AnsiString; Buf : PChar; Len : SizeInt);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
+function  ShortCompareText(const S1, S2: shortstring): SizeInt;
 Function  upCase(const s:shortstring):shortstring;
 Function  lowerCase(const s:shortstring):shortstring; overload;
 Function  Space(b:byte):shortstring;

rtl/objpas/sysutils/sysstr.inc

@@ -183,28 +183,36 @@ function CompareText(const S1, S2: string): integer;
 
 var
   i, count, count1, count2: integer; Chr1, Chr2: byte;
+  P1, P2: PChar;
 begin
-  result := 0;
   Count1 := Length(S1);
   Count2 := Length(S2);
   if (Count1>Count2) then
     Count := Count2
   else
     Count := Count1;
+  P1 := @S1[1];
+  P2 := @S2[1];
   i := 0;
-  while (result=0) and (i<count) do
+  while i < Count do
+  begin
+    Chr1 := byte(p1^);
+    Chr2 := byte(p2^);
+    if Chr1 <> Chr2 then
     begin
-    inc (i);
-     Chr1 := byte(s1[i]);
-     Chr2 := byte(s2[i]);
-     if Chr1 in [97..122] then
-       dec(Chr1,32);
-     if Chr2 in [97..122] then
-       dec(Chr2,32);
-     result := Chr1 - Chr2;
-     end ;
-  if (result = 0) then
-    result:=(count1-count2);
+      if Chr1 in [97..122] then
+        dec(Chr1,32);
+      if Chr2 in [97..122] then
+        dec(Chr2,32);
+      if Chr1 <> Chr2 then
+        Break;
+    end;
+    Inc(P1); Inc(P2); Inc(I);
+  end;
+  if i < Count then
+    result := Chr1-Chr2
+  else
+    result := count1-count2;
 end;
 
 function SameText(const s1,s2:String):Boolean;
@@ -2389,10 +2397,15 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin
 end ;
 
 Function LastDelimiter(const Delimiters, S: string): Integer;
-
+var
+  chs: TSysCharSet;
+  I: LongInt;
 begin
+  chs := [];
+  for I := 1 to Length(Delimiters) do
+    Include(chs, Delimiters[I]);
   Result:=Length(S);
-  While (Result>0) and (Pos(S[Result],Delimiters)=0) do
+  While (Result>0) and not (S[Result] in chs) do
     Dec(Result);
 end;
 

rtl/objpas/sysutils/sysstrh.inc

@@ -71,7 +71,7 @@ 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 }
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
-function CompareStr(const S1, S2: string): Integer;
+function CompareStr(const S1, S2: string): Integer; overload;
 function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
 function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
 function CompareText(const S1, S2: string): integer;

rtl/objpas/typinfo.pp

@@ -354,17 +354,19 @@ Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
   Var PS : PShortString;
       PT : PTypeData;
       Count : longint;
+      sName: shortstring;
 
 begin
   If Length(Name)=0 then
     exit(-1);
+  sName := Name;
   PT:=GetTypeData(TypeInfo);
   Count:=0;
   Result:=-1;
   PS:=@PT^.NameList;
   While (Result=-1) and (PByte(PS)^<>0) do
     begin
-      If CompareText(PS^, Name) = 0 then
+      If ShortCompareText(PS^, sName) = 0 then
         Result:=Count;
       PS:=PShortString(pointer(PS)+PByte(PS)^+1);
       Inc(Count);
@@ -517,10 +519,10 @@ Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 var
   hp : PTypeData;
   i : longint;
-  p : string;
+  p : shortstring;
   pd : ^TPropData;
 begin
-  P:=UpCase(PropName);
+  P:=PropName;  // avoid Ansi<->short conversion in a loop
   while Assigned(TypeInfo) do
     begin
       // skip the name
@@ -531,7 +533,7 @@ begin
       for i:=1 to pd^.PropCount do
         begin
           // found a property of that name ?
-          if Upcase(Result^.Name)=P then
+          if ShortCompareText(Result^.Name, P) = 0 then
             exit;
           // skip to next property
           Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+1));