more work on class tracking

library/fsl/fsl_base.pas

@@ -95,6 +95,7 @@ function ExceptionStack(e : Exception) : String;
   // particular subclasses
   EFslAbstract = Class(EFslException);
   EFslAssertion = Class(EFslException);
+  EObjectTrackingFail = class (EFslAssertion);
   ETodo = Class(EFslException)
   public
     Constructor Create(place : String);
@@ -1012,11 +1013,38 @@ procedure TClassTrackingType.check(msg: String; condition: boolean);
   Message := Description;
 End;
 
+procedure handleObjectTrackingFail(msg : String);
+var
+  fn : String;
+  f : System.text;
+begin
+  // Application is pretty much cactus at this point, so we don't mind doing
+  // slow file operation inside such a system critical lock as GLock
+
+  try
+    fn := 'c:\temp\object-tracking-errors.log';
+    AssignFile(f, fn);
+    if (FileExists(fn)) then
+      Append(f)
+    else
+      Rewrite(f);
+    writeln(f, msg);
+    closeFile(f);
+  except
+    // nothing - we really can't do anything
+  end;
+
+  raise EObjectTrackingFail.create(msg);
+end;
+
 { TFslObject }
 
 constructor TFslObject.Create;
 var
   t : TClassTrackingType;
+  {$IFOPT C+}
+  isNil : boolean;
+  {$ENDIF}
 Begin
   Inherited;
   {$IFOPT D+}
@@ -1041,6 +1069,12 @@ constructor TFslObject.Create;
       t := TClassTrackingType.Create;
       GClassTracker.Add(ClassName, t);
     end;
+    {$IFOPT C+}
+    isNil := t.firstObject = nil;
+    if not (isNil = (t.count = 0)) then
+      handleObjectTrackingFail(className+': firstObject = '+BoolToStr(isNil, 'Nil', 'not nil')+' and count = '+inttostr(t.count)+' (create)');
+    {$ENDIF}
+
     inc(t.count);
     inc(t.deltaCount);
     inc(t.serial);
@@ -1051,8 +1085,6 @@ constructor TFslObject.Create;
     {$ENDIF}
     if t.firstObject = nil then
     begin
-      if (t.count <> 1) then
-        assert(t.count = 1, 'Object Tracking Error - tracking record for '+className+' is nil, but count is '+inttostr(t.count));
       t.firstObject := self;
       t.lastObject := self;
       FPrev := nil;
@@ -1073,20 +1105,26 @@ constructor TFslObject.Create;
 
 destructor TFslObject.Destroy;
 var
-  t : TClassTrackingType;
+  t : TClassTrackingType;  
+  {$IFOPT C+}
+  isNil : boolean;
+  {$ENDIF}
 Begin
   {$IFDEF OBJECT_TRACKING}
   if GInited then
   begin
     EnterCriticalSection(GLock);
     try
       if GClassTracker.TryGetValue(ClassName, t) then // this will succeed
-      begin
-        assert(t.count > 0);
-        if FPrev <> nil then      
-          assert(FPrev.ClassName = className, 'Previous object wrong class: '+ClassName);
-        if FNext <> nil then
-          assert(FNext.ClassName = className, 'Next object wrong class: '+ClassName);
+      begin         
+        {$IFOPT C+}
+        if (t.count = 0) then
+          handleObjectTrackingFail(className+': count is 0 freeing object');
+        if (FPrev <> nil) and (FPrev.ClassName <> className) then
+          handleObjectTrackingFail(className+': Previous object wrong class: '+FPrev.ClassName);
+        if (FNext <> nil) and (FNext.ClassName <> className) then
+          handleObjectTrackingFail(className+': Next object wrong class: '+FNext.ClassName);
+        {$ENDIF}
 
         dec(t.Count);
         dec(t.deltaCount);
@@ -1117,10 +1155,17 @@           assert(FNext.ClassName = className, 'Next object wrong class: '+ClassN
         end;
       end
       else
-        assert(false, 'Object Tracking Error - tracking record for '+ClassName+' not found');
+      begin
+        {$IFOPT C+}
+        handleObjectTrackingFail(ClassName+': tracking record not found in destroy');
+        {$ENDIF}
+      end;
 
-      if (t.firstObject = nil) and (t.count > 0) then
-        assert(t.count = 1, 'Object Tracking Error - tracking record for '+ClassName+' just became nil, but count is '+inttostr(t.count));
+      {$IFOPT C+}
+      isNil := t.firstObject = nil;
+      if not (isNil = (t.count = 0)) then
+        handleObjectTrackingFail(className+': firstObject = '+BoolToStr(isNil, 'Nil', 'not nil')+' and count = '+inttostr(t.count)+' (destroy)');
+      {$ENDIF}
     finally
       LeaveCriticalSection(GLock);
     end;