jcl-checkins-diff Mailing List for JEDI Code Library (Page 52)

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Revision: 2613
          http://jcl.svn.sourceforge.net/jcl/?rev=2613&view=rev
Author:   jedi_mbe
Date:     2009-02-01 13:43:11 +0000 (Sun, 01 Feb 2009)

Log Message:
-----------
* Fixed bug in StrCompareRange
* Fixed bugs in CompareNaturalStr and CompareNaturalText
* Added a nil-safe Clone method to TJclTabSet.

Modified Paths:
--------------
    trunk/help/Strings.dtx
    trunk/jcl/source/common/JclStrings.pas

Modified: trunk/help/Strings.dtx
===================================================================

--- trunk/help/Strings.dtx	2009-01-26 08:03:50 UTC (rev 2612)
+++ trunk/help/Strings.dtx	2009-02-01 13:43:11 UTC (rev 2613)
@@ -3143,6 +3143,22 @@
 Donator:
   Marcel Bestebroer
 --------------------------------------------------------------------------------
+@@TJclTabSet.Clone
+Summary:
+  Initializes a new tab set instance equal to the current instance.
+Description:
+  The Clone method initializes a new instance of the TJclTabSet class and
+  copies the contents of the current instance to the new one.
+Result:
+  <b>nil</b> if Clone is called on a <b>nil</b> instance<p>
+  <i>- or -</i><p>
+  A new TJclTabSet instance identical to the instance Close was called on
+Notes:
+  This method is <i><b>nil</b>-safe</i>; when invoked on a
+  <b>nil</b>-reference, this method will return <b>nil</b>.
+Donator:
+  Marcel Bestebroer
+--------------------------------------------------------------------------------
 @@TJclTabSet.Count
 Summary:
   Indicates the number of tabulation positions specified.

Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas	2009-01-26 08:03:50 UTC (rev 2612)
+++ trunk/jcl/source/common/JclStrings.pas	2009-02-01 13:43:11 UTC (rev 2613)
@@ -534,6 +534,7 @@
     constructor Create(TabWidth: Integer); overload;
     constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean); overload;
     constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer); overload;
+    function Clone: TJclTabSet;
 
     // Tab stops manipulation
     function Add(Column: Integer): Integer;
@@ -2915,10 +2916,6 @@
          SUB     EDX, ECX
          JLE     @@NoWork
 
-        // # of chars in S1 - (Count - 1)
-         SUB     EDX, EBX
-         JLE     @@NoWork
-
         // move to index'th char
          ADD     ESI, ECX
 
@@ -2933,6 +2930,10 @@
          MOV     ECX, EBX
 
          @@Skip1:
+        // # of chars in S1 - (Min(Count, Length(S2)) - 1)
+         SUB     EDX, ECX
+         JLE     @@NoWork
+
          XOR     EAX, EAX
          XOR     EDX, EDX
 
@@ -5627,6 +5628,14 @@
     FRealWidth := FWidth;
 end;
 
+function TJclTabSet.Clone: TJclTabSet;
+begin
+  if Self <> nil then
+    Result := TJclTabSet.Create(FStops, FZeroBased, FWidth)
+  else
+    Result := nil;
+end;
+
 function TJclTabSet.Delete(Column: Integer): Integer;
 begin
   Result := FindStop(Column);
@@ -6226,6 +6235,11 @@
   Cur1, Len1,
   Cur2, Len2: Integer;
 
+  function IsRealNumberChar(ch: Char): Boolean;
+  begin
+    Result := ((ch >= '0') and (ch <= '9')) or (ch = '-') or (ch = '+');
+  end;
+
   procedure NumberCompare;
   var
     IsReallyNumber: Boolean;
@@ -6235,37 +6249,37 @@
     Result := 0;
     IsReallyNumber := False;
     // count leading spaces in S1
-    while CharIsWhiteSpace(S1[Cur1]) do
+    while (Cur1 <= Len1) and CharIsWhiteSpace(S1[Cur1]) do
     begin
       Dec(Result);
       Inc(Cur1);
     end;
     // count leading spaces in S2 (canceling them out against the ones in S1)
-    while CharIsWhiteSpace(S2[Cur2]) do
+    while (Cur2 <= Len2) and CharIsWhiteSpace(S2[Cur2]) do
     begin
       Inc(Result);
       Inc(Cur2);
     end;
 
     // if spaces match, or both strings are actually followed by a numeric character, continue the checks
-    if (Result = 0) or (CharIsNumberChar(S1[Cur1])) and (CharIsNumberChar(S2[Cur2])) then
+    if (Result = 0) or ((Cur1 <= Len1) and CharIsNumberChar(S1[Cur1]) and (Cur2 <= Len2) and CharIsNumberChar(S2[Cur2])) then
     begin
       // Check signed number
-      if (S1[Cur1] = '-') and (S2[Cur2] <> '-') then
+      if (Cur1 <= Len1) and (S1[Cur1] = '-') and ((Cur2 > Len2) or (S2[Cur2] <> '-')) then
         Result := 1
       else
-      if (S2[Cur2] = '-') and (S1[Cur1] <> '-') then
+      if (Cur2 <= Len2) and (S2[Cur2] = '-') and ((Cur1 > Len1) or (S1[Cur1] <> '-')) then
         Result := -1
       else
         Result := 0;
 
-      if (S1[Cur1] = '-') or (S1[Cur1] = '+') then
+      if (Cur1 <= Len1) and ((S1[Cur1] = '-') or (S1[Cur1] = '+')) then
         Inc(Cur1);
-      if (S2[Cur2] = '-') or (S2[Cur2] = '+') then
+      if (Cur2 <= Len2) and ((S2[Cur2] = '-') or (S2[Cur2] = '+')) then
         Inc(Cur2);
 
-      FirstDiffBreaks := (S1[Cur1] = '0') or (S2[Cur2] = '0');
-      while CharIsDigit(S1[Cur1]) and CharIsDigit(S2[Cur2]) do
+      FirstDiffBreaks := (Cur1 <= Len1) and (S1[Cur1] = '0') or (Cur2 <= Len2) and (S2[Cur2] = '0');
+      while (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) and (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) do
       begin
         IsReallyNumber := True;
         Val1 := StrToInt(S1[Cur1]);
@@ -6286,16 +6300,37 @@
       begin
         if not FirstDiffBreaks then
         begin
-          if CharIsDigit(S1[Cur1]) then
+          if (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) then
             Result := 1
           else
-          if CharIsDigit(S2[Cur2]) then
+          if (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) then
             Result := -1;
         end;
       end;
     end;
   end;
 
+  procedure SetByCompareLength;
+  var
+    Remain1: Integer;
+    Remain2: Integer;
+  begin
+    // base result on relative compare length (spaces could be ignored, so even if S1 is longer than S2, they could be
+    // completely equal, or S2 could be longer)
+    Remain1 := Len1 - Cur1 + 1;
+    Remain2 := Len2 - Cur2 + 1;
+    if Remain1 < 0 then
+      Remain1 := 0;
+    if Remain2 < 0 then
+      Remain2 := 0;
+
+    if Remain1 < Remain2 then
+      Result := -1
+    else
+    if Remain1 > Remain2 then
+      Result := 1;
+  end;
+
 begin
   Cur1 := 1;
   Len1 := Length(S1);
@@ -6305,24 +6340,24 @@
 
   while (Result = 0) do
   begin
-    if (Cur1 = Len1) and (Cur2 = Len2) then
-      Break
+    if (Cur1 > Len1) or (Cur2 > Len2) then
+    begin
+      SetByCompareLength;
+      Break;
+    end
     else
-    if (S1[Cur1] = '-') and CharIsNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then
+    if (Cur1 <= Len1) and (Cur2 > Len2) then
+      Result := 1
+    else
+    if (S1[Cur1] = '-') and IsRealNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then
       Result := -1
     else
-    if (S2[Cur2] = '-') and CharIsNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then
+    if (S2[Cur2] = '-') and IsRealNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then
       Result := 1
     else
-    if CharIsNumberChar(S1[Cur1]) and CharIsNumberChar(S2[Cur2]) then
+    if (IsRealNumberChar(S1[Cur1]) or CharIsWhiteSpace(S1[Cur1])) and (IsRealNumberChar(S2[Cur2]) or CharIsWhiteSpace(S2[Cur2])) then
       NumberCompare
     else
-    if (Cur1 = Len1) and (Cur2 < Len2) then
-      Result := -1
-    else
-    if (Cur1 < Len1) and (Cur2 = Len2) then
-      Result := 1
-    else
     begin
       {$IFDEF CLR}
       Result := System.String.Compare(S1.Substring(Cur1 - 1),S2.Substring(Cur2 - 1),CaseInsensitive);


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




2006	Jan	Feb	Mar	Apr (20)	May (48)	Jun (8)	Jul (23)	Aug (41)	Sep (42)	Oct (22)	Nov (17)	Dec (36)
2007	Jan (43)	Feb (42)	Mar (17)	Apr (39)	May (16)	Jun (35)	Jul (37)	Aug (47)	Sep (49)	Oct (9)	Nov (52)	Dec (37)
2008	Jan (48)	Feb (21)	Mar (7)	Apr (2)	May (5)	Jun (17)	Jul (17)	Aug (40)	Sep (58)	Oct (38)	Nov (19)	Dec (32)
2009	Jan (67)	Feb (46)	Mar (54)	Apr (34)	May (37)	Jun (52)	Jul (67)	Aug (72)	Sep (48)	Oct (35)	Nov (27)	Dec (12)
2010	Jan (56)	Feb (46)	Mar (19)	Apr (14)	May (21)	Jun (3)	Jul (13)	Aug (48)	Sep (34)	Oct (51)	Nov (16)	Dec (32)
2011	Jan (36)	Feb (14)	Mar (12)	Apr (3)	May (5)	Jun (24)	Jul (15)	Aug (30)	Sep (21)	Oct (4)	Nov (25)	Dec (23)
2012	Jan (45)	Feb (42)	Mar (19)	Apr (14)	May (13)	Jun (7)	Jul (3)	Aug (46)	Sep (21)	Oct (10)	Nov (2)	Dec
2013	Jan (5)	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov	Dec

jcl-checkins-diff Mailing List for JEDI Code Library (Page 52)

jcl-checkins-diff — SVN file check-in notifications with file differences included