All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0031704FPCRTLpublic2017-04-24 16:422017-04-24 22:53
ReporterDenis KozlovAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.1.1Product Build 
Target Version3.2.0Fixed in Version3.1.1 
Summary0031704: TFPGMap.TryGetData fails when Sorted=False
DescriptionTFPGMap.TryGetData uses binary search on unsorted keys by calling Find method blindly, which of course produces wrong results if keys are not sorted.

Patch is trivial. Use IndexOf instead of Find, which already uses either linear or binary search depending on the Sorted state.

Patch also makes TFPSMap.Find raise an exception if keys are not sorted, instead of silently producing wrong results - same fix was applied to TStringList.Find some time ago.
Additional InformationPatch and sample project are attached.
Tagspatch
Fixed in Revision35942
FPCOldBugId
FPCTarget
Attached Files
  • fgl.pp.patch (597 bytes) 
    Index: rtl/objpas/fgl.pp
===================================================================
--- rtl/objpas/fgl.pp	(revision 35934)
+++ rtl/objpas/fgl.pp	(working copy)
@@ -1317,6 +1317,9 @@
   I,L,R,Dir: Integer;
 begin
   Result := false;
+  Index := -1;
+  if not Sorted then
+    raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := FCount-1;
@@ -1550,7 +1553,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
    fgl.pp.patch (597 bytes)
  • project.pas (588 bytes) 
    program project;

{$mode objfpc}{$H+}

uses
  Classes, FGL;

type
  TStringMap = specialize TFPGMap<string, string>;

procedure TestStringMap(const Strings: array of String; const FindString: String);
var
  List: TStringMap;
  S: String;
begin
  List := TStringMap.Create;
  try
    //List.Sorted := True;
    for S in Strings do
      List.Add(S, S);
    if List.TryGetData(FindString, S) then
      WriteLn('FOUND ' + S)
    else
      WriteLn('NOT FOUND ' + S);
  finally
    List.Free;
  end;
end;

begin
  TestStringMap(['ZZZ', 'AAA'], 'AAA');
end.
    project.pas (588 bytes)
  • fgl-2.pp.patch (1,005 bytes) 
    Index: rtl/objpas/fgl.pp
===================================================================
--- rtl/objpas/fgl.pp	(revision 35934)
+++ rtl/objpas/fgl.pp	(working copy)
@@ -1317,6 +1317,9 @@
   I,L,R,Dir: Integer;
 begin
   Result := false;
+  Index := -1;
+  if not Sorted then
+    raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := FCount-1;
@@ -1550,7 +1553,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1735,7 +1739,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1916,7 +1921,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
    fgl-2.pp.patch (1,005 bytes)

Activities

Denis Kozlov

2017-04-24 16:43

reporter  

fgl.pp.patch (597 bytes) 
Index: rtl/objpas/fgl.pp
===================================================================
--- rtl/objpas/fgl.pp	(revision 35934)
+++ rtl/objpas/fgl.pp	(working copy)
@@ -1317,6 +1317,9 @@
   I,L,R,Dir: Integer;
 begin
   Result := false;
+  Index := -1;
+  if not Sorted then
+    raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := FCount-1;
@@ -1550,7 +1553,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
fgl.pp.patch (597 bytes)

Denis Kozlov

2017-04-24 16:44

reporter  

project.pas (588 bytes) 
program project;

{$mode objfpc}{$H+}

uses
  Classes, FGL;

type
  TStringMap = specialize TFPGMap<string, string>;

procedure TestStringMap(const Strings: array of String; const FindString: String);
var
  List: TStringMap;
  S: String;
begin
  List := TStringMap.Create;
  try
    //List.Sorted := True;
    for S in Strings do
      List.Add(S, S);
    if List.TryGetData(FindString, S) then
      WriteLn('FOUND ' + S)
    else
      WriteLn('NOT FOUND ' + S);
  finally
    List.Free;
  end;
end;

begin
  TestStringMap(['ZZZ', 'AAA'], 'AAA');
end.
project.pas (588 bytes)

Denis Kozlov

2017-04-24 16:46

reporter   ~0099864

Please backport to FPC 3.0 fixes if possible.

Denis Kozlov

2017-04-24 16:59

reporter   ~0099865

TFPGMapObject.TryGetData and TFPGMapInterfacedObjectData.TryGetData also suffer from the same condition.

I will upload an updated patch shortly which also fixes these two methods.

Denis Kozlov

2017-04-24 17:03

reporter  

fgl-2.pp.patch (1,005 bytes) 
Index: rtl/objpas/fgl.pp
===================================================================
--- rtl/objpas/fgl.pp	(revision 35934)
+++ rtl/objpas/fgl.pp	(working copy)
@@ -1317,6 +1317,9 @@
   I,L,R,Dir: Integer;
 begin
   Result := false;
+  Index := -1;
+  if not Sorted then
+    raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := FCount-1;
@@ -1550,7 +1553,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1735,7 +1739,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1916,7 +1921,8 @@
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
fgl-2.pp.patch (1,005 bytes)

Denis Kozlov

2017-04-24 17:04

reporter   ~0099866

New patch uploaded: fgl-2.pp.patch

Michael Van Canneyt

2017-04-24 22:53

administrator   ~0099885

Checked and applied the patch, thank you very much!

Issue History

Date Modified Username Field Change
2017-04-24 16:42 Denis Kozlov New Issue
2017-04-24 16:42 Denis Kozlov Tag Attached: patch
2017-04-24 16:43 Denis Kozlov File Added: fgl.pp.patch
2017-04-24 16:44 Denis Kozlov File Added: project.pas
2017-04-24 16:46 Denis Kozlov Note Added: 0099864
2017-04-24 16:59 Denis Kozlov Note Added: 0099865
2017-04-24 17:03 Denis Kozlov File Added: fgl-2.pp.patch
2017-04-24 17:04 Denis Kozlov Note Added: 0099866
2017-04-24 22:50 Michael Van Canneyt Assigned To => Michael Van Canneyt
2017-04-24 22:50 Michael Van Canneyt Status new => assigned
2017-04-24 22:53 Michael Van Canneyt Fixed in Revision => 35942
2017-04-24 22:53 Michael Van Canneyt Note Added: 0099885
2017-04-24 22:53 Michael Van Canneyt Status assigned => resolved
2017-04-24 22:53 Michael Van Canneyt Fixed in Version => 3.1.1
2017-04-24 22:53 Michael Van Canneyt Resolution open => fixed
2017-04-24 22:53 Michael Van Canneyt Target Version => 3.2.0