View Issue Details

IDProjectCategoryView StatusLast Update
0038509FPCDatabasepublic2021-03-07 19:17
ReporterMattias Gaertner Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Fixed in Version3.3.1 
Summary0038509: patch TCustomBufDataset.InternalClose clearing FCurrentIndexDef fixing crash
DescriptionWhen closing the dataset, the FCurrentIndexDef is not cleared, resulting in a dangling pointer and crash in TCustomBufDataset.GetIndexFieldNames.

Here is a patch.
TagsNo tags attached.
Fixed in Revision48711
FPCOldBugId
FPCTarget3.2.2
Attached Files

Relationships

has duplicate 0037932 resolvedMichael Van Canneyt Dangling pointer left behind when closing a TBufDataset 

Activities

Mattias Gaertner

2021-02-18 15:29

manager  

CurrentIndexDef_clear.patch (1,781 bytes)   
Index: packages/fcl-db/src/base/bufdataset.pas
===================================================================
--- packages/fcl-db/src/base/bufdataset.pas	(revision 48704)
+++ packages/fcl-db/src/base/bufdataset.pas	(working copy)
@@ -1465,6 +1465,7 @@
   i,r  : integer;
   iGetResult : TGetResult;
   pc : TRecordBuffer;
+  CurBufIndex: TBufDatasetIndex;
 
 begin
   FOpen:=False;
@@ -1514,10 +1515,17 @@
   if FAutoIncValue>-1 then FAutoIncValue:=1;
   if assigned(FParser) then FreeAndNil(FParser);
   For I:=FIndexes.Count-1 downto 0 do
-    if (BufIndexDefs[i].IndexType in [itDefault,itCustom]) or (BufIndexDefs[i].DiscardOnClose) then
-       BufIndexDefs[i].Free
+    begin
+    CurBufIndex:=BufIndexDefs[i];
+    if (CurBufIndex.IndexType in [itDefault,itCustom]) or (CurBufIndex.DiscardOnClose) then
+      begin
+      if FCurrentIndexDef=CurBufIndex then
+        FCurrentIndexDef:=nil;
+      CurBufIndex.Free;
+      end
     else
-       FreeAndNil(BufIndexDefs[i].FBufferIndex);
+      FreeAndNil(CurBufIndex.FBufferIndex);
+    end;
 end;
 
 procedure TCustomBufDataset.InternalFirst;
@@ -3149,16 +3157,18 @@
 var
   i, p: integer;
   s: string;
+  IndexBuf: TBufIndex;
 
 begin
   Result := FIndexFieldNames;
-  if (CurrentIndexBuf=Nil) then
+  IndexBuf:=CurrentIndexBuf;
+  if (IndexBuf=Nil) then
     Exit;
   Result:='';
-  for i := 1 to WordCount(CurrentIndexBuf.FieldsName, [Limiter]) do
+  for i := 1 to WordCount(IndexBuf.FieldsName, [Limiter]) do
   begin
-    s := ExtractDelimited(i, CurrentIndexBuf.FieldsName, [Limiter]);
-    p := Pos(s, CurrentIndexBuf.DescFields);
+    s := ExtractDelimited(i, IndexBuf.FieldsName, [Limiter]);
+    p := Pos(s, IndexBuf.DescFields);
     if p>0 then
       s := s + Desc;
     Result := Result + Limiter + s;
CurrentIndexDef_clear.patch (1,781 bytes)   

Michael Van Canneyt

2021-02-18 16:10

administrator   ~0128995

Applied fix, Ran testsuite; no regressions noticed. Committed.

Thanks !

Issue History

Date Modified Username Field Change
2021-02-18 15:29 Mattias Gaertner New Issue
2021-02-18 15:29 Mattias Gaertner File Added: CurrentIndexDef_clear.patch
2021-02-18 16:10 Michael Van Canneyt Assigned To => Michael Van Canneyt
2021-02-18 16:10 Michael Van Canneyt Status new => resolved
2021-02-18 16:10 Michael Van Canneyt Resolution open => fixed
2021-02-18 16:10 Michael Van Canneyt Fixed in Version => 3.3.1
2021-02-18 16:10 Michael Van Canneyt Fixed in Revision => 48711
2021-02-18 16:10 Michael Van Canneyt FPCTarget => 3.2.2
2021-02-18 16:10 Michael Van Canneyt Note Added: 0128995
2021-03-07 19:17 Michael Van Canneyt Relationship added has duplicate 0037932