From 6ed3d919895b1b8f0f0fe5a305d42d0c4497e78c Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 2 Dec 2007 18:36:20 +0000 Subject: [PATCH] * 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 | 10 +++----- rtl/inc/sstrings.inc | 37 ++++++++++++++++++++++++++++ rtl/inc/systemh.inc | 1 + rtl/objpas/sysutils/sysstr.inc | 43 +++++++++++++++++++++------------ rtl/objpas/sysutils/sysstrh.inc | 2 +- rtl/objpas/typinfo.pp | 10 +++++--- 6 files changed, 76 insertions(+), 27 deletions(-) diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index de24e36366..d9e35770a4 100644 --- a/rtl/inc/objpas.inc +++ b/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; diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 2a17283a21..77b9a5dd51 100644 --- a/rtl/inc/sstrings.inc +++ b/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; + diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index b951a14d85..3c55735be7 100644 --- a/rtl/inc/systemh.inc +++ b/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; diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc index 10e5c5799b..e283a6f5b4 100644 --- a/rtl/objpas/sysutils/sysstr.inc +++ b/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 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; diff --git a/rtl/objpas/sysutils/sysstrh.inc b/rtl/objpas/sysutils/sysstrh.inc index b96ad41e67..ead36eb5bc 100644 --- a/rtl/objpas/sysutils/sysstrh.inc +++ b/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; diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index 87d447e381..c678be12e0 100644 --- a/rtl/objpas/typinfo.pp +++ b/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));