View Issue Details

IDProjectCategoryView StatusLast Update
0021685LazarusLCLpublic2012-04-12 02:12
Reportercobines Assigned ToJuha Manninen  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
PlatformWin32OSWindows XP 
Product Version0.9.31 (SVN) 
Summary0021685: Updating PO crashes when string was moved to another file if there are duplicate strings in FOriginalToItem
DescriptionPrevious bug 0021615 not completely fixed. If there are two or more identical strings in FOriginalToItem pointing to different Items then when freeing an Item the wrong Item may be removed from FOriginalToItem, because removing is done by string only.
I have extended StringHashList to allow Find and Remove by String+Data combination then used the new function to remove Items from FOriginalToItem.
TagsNo tags attached.
Fixed in Revisionr36729
LazTarget-
Widgetset
Attached Files

Relationships

related to 0021615 closedMattias Gaertner Updating PO file when string was moved to another file crashes 

Activities

2012-04-09 11:32

 

remove_from_foriginal.diff (5,661 bytes)   
Index: lcl/stringhashlist.pas
===================================================================
--- lcl/stringhashlist.pas	(revision 36674)
+++ lcl/stringhashlist.pas	(working copy)
@@ -47,8 +47,10 @@
     FList: PStringHashItemList;
     FCount: Integer;
     fCaseSensitive: Boolean;
+    function BinarySearch(HashValue: Cardinal): Integer;
     function CompareString(const Value1, Value2: String): Boolean;
     function CompareValue(const Value1, Value2: Cardinal): Integer;
+    procedure FindHashBoundaries(HashValue: Cardinal; StartFrom: Integer; out First, Last: Integer);
     function GetData(const S: String): Pointer;
     procedure SetCaseSensitive(const Value: Boolean);
     procedure Delete(Index: Integer);
@@ -63,7 +65,9 @@
     function Add(const S: String; ItemData: Pointer): Integer;
     procedure Clear;
     function Find(const S: String): Integer;
+    function Find(const S: String; Data: Pointer): Integer;
     function Remove(const S: String): Integer;
+    function Remove(const S: String; Data: Pointer): Integer;
     property CaseSensitive: Boolean read fCaseSensitive write SetCaseSensitive;
     property Count: Integer read FCount;
     property Data[const S: String]: Pointer read GetData write SetData; default;
@@ -125,6 +129,24 @@
   Insert(Result,Item);
 end;
 
+function TStringHashList.BinarySearch(HashValue: Cardinal): Integer;
+var
+  First, Last, Temp: Integer;
+begin
+  Result:= -1;
+  First:= 0;
+  Last:= Count -1;
+  while First <= Last do
+  begin
+    Temp:= (First + Last) div 2;
+    case CompareValue(HashValue, FList[Temp]^.HashValue) of
+      1: First:= Temp + 1;
+      0: exit(Temp);
+     -1: Last:= Temp-1;
+    end;
+  end;
+end;
+
 procedure TStringHashList.Clear;
 var
   I: Integer;
@@ -216,45 +238,37 @@
 function TStringHashList.Find(const S: String): Integer;
 var
   Value: Cardinal;
-  First, Last, Temp, I: Integer;
+  First, Last, I: Integer;
 begin
   Value:= HashOf(s);
-  Result:= -1;
-  First:= 0;
-  Last:= Count -1;
-  while First <= Last do
+  Result:= BinarySearch(Value);
+  if (Result <> -1) and not CompareString(S, FList[Result]^.Key) then
   begin
-    Temp:= (First + Last) div 2;
-    case CompareValue(Value, FList[Temp]^.HashValue) of
-     1: First:= Temp + 1;
-     0:
-       begin
-         Result:= Temp;
-         if CompareString(S, FList[Temp]^.Key) then
-           exit
-         else
-           break;
-       end;
-     -1: Last:= Temp-1;
-    end;
+    FindHashBoundaries(Value, Result, First, Last);
+    Result:= -1;
+    for I := First to Last do
+      if CompareString(S, FList[I]^.Key) then
+      begin
+        Result:= I;
+        Exit;
+      end;
   end;
-  if Result <> -1 then
+end;
+
+function TStringHashList.Find(const S: String; Data: Pointer): Integer;
+var
+  Value: Cardinal;
+  First, Last, I: Integer;
+begin
+  Value:= HashOf(s);
+  Result:= BinarySearch(Value);
+  if (Result <> -1) and
+     not (CompareString(S, FList[Result]^.Key) and (FList[Result]^.Data = Data)) then
   begin
+    FindHashBoundaries(Value, Result, First, Last);
     Result:= -1;
-    First:= Temp -1;
-    //Find first matching hash index
-    while (First >= 0) and (CompareValue(Value, FList[First]^.HashValue) = 0) do
-      dec(First);
-    if (First < 0) or ((CompareValue(Value, FList[First]^.HashValue) <> 0)) then
-      inc(First);
-    //Find the last matching hash index
-    Last:= Temp +1;
-    while (Last <= (FCount - 1)) and (CompareValue(Value, FList[Last]^.HashValue) = 0) do
-      inc(Last);
-    if (Last > (FCount - 1)) or (CompareValue(Value, FList[Last]^.HashValue) <> 0) then
-      dec(Last);
     for I := First to Last do
-      if CompareString(S, FList[I]^.Key) then
+      if CompareString(S, FList[I]^.Key) and (FList[I]^.Data = Data) then
       begin
         Result:= I;
         Exit;
@@ -262,6 +276,22 @@
   end;
 end;
 
+procedure TStringHashList.FindHashBoundaries(HashValue: Cardinal; StartFrom: Integer; out First, Last: Integer);
+begin
+  First:= StartFrom -1;
+  //Find first matching hash index
+  while (First >= 0) and (CompareValue(HashValue, FList[First]^.HashValue) = 0) do
+    dec(First);
+  if (First < 0) or ((CompareValue(HashValue, FList[First]^.HashValue) <> 0)) then
+    inc(First);
+  //Find the last matching hash index
+  Last:= StartFrom +1;
+  while (Last <= (FCount - 1)) and (CompareValue(HashValue, FList[Last]^.HashValue) = 0) do
+    inc(Last);
+  if (Last > (FCount - 1)) or (CompareValue(HashValue, FList[Last]^.HashValue) <> 0) then
+    dec(Last);
+end;
+
 function TStringHashList.HashOf(const Key: string): Cardinal;
 var
   P: PChar;
@@ -312,6 +342,16 @@
   end;
 end;
 
+function TStringHashList.Remove(const S: String; Data: Pointer): Integer;
+begin
+  Result:= Find(S, Data);
+  if Result > -1 then
+  begin
+    Dispose(fList[Result]);
+    Delete(Result);
+  end;
+end;
+
 procedure TStringHashList.SetCaseSensitive(const Value: Boolean);
 begin
   if fCaseSensitive <> Value then
Index: lcl/translations.pas
===================================================================
--- lcl/translations.pas	(revision 36674)
+++ lcl/translations.pas	(working copy)
@@ -506,7 +506,7 @@
     if (VItem=Item) then
       FIdentLowVarToItem.Remove(VarName);
 
-    FOriginalToItem.Remove(Item.Original);
+    FOriginalToItem.Remove(Item.Original, Item);
     FItems.Delete(i);
     Item.Free;
   end;
@@ -1041,7 +1041,7 @@
     if Item.Tag<>aTag then
       Continue;
     FIdentifierLowToItem.Remove(Item.IdentifierLow);
-    FOriginalToItem.Remove(Item.Original);
+    FOriginalToItem.Remove(Item.Original, Item);
     FItems.Delete(i);
     Item.Free;
   end;
remove_from_foriginal.diff (5,661 bytes)   

Juha Manninen

2012-04-11 18:42

developer   ~0058506

Applied, thanks.
Please test.

cobines

2012-04-12 02:12

reporter   ~0058518

Thanks.

Issue History

Date Modified Username Field Change
2012-04-09 11:32 cobines New Issue
2012-04-09 11:32 cobines File Added: remove_from_foriginal.diff
2012-04-09 11:49 Juha Manninen Relationship added related to 0021615
2012-04-11 16:59 Juha Manninen Status new => assigned
2012-04-11 16:59 Juha Manninen Assigned To => Juha Manninen
2012-04-11 18:42 Juha Manninen Fixed in Revision => r36729
2012-04-11 18:42 Juha Manninen LazTarget => -
2012-04-11 18:42 Juha Manninen Status assigned => resolved
2012-04-11 18:42 Juha Manninen Resolution open => fixed
2012-04-11 18:42 Juha Manninen Note Added: 0058506
2012-04-12 02:12 cobines Status resolved => closed
2012-04-12 02:12 cobines Note Added: 0058518