UPD: Thread-safe DebugLn via LazLogger for Lazarus >= 0.9.31.

src/udebug.pas

@@ -27,12 +27,12 @@ unit uDebug;
 interface
 
 uses
-  Classes, SysUtils; 
+  Classes, SysUtils, LCLVersion;
+
+// For Lazarus < 0.9.31.
+// Thread-safe DebugLn via DCDebug functions.
+// Still not fully safe because may conflict with DebugLn called by LCL.
 
-// Thread-safe calling DebugLn.
-// Still not fully safe because may conflict with DebugLn called by LCL,
-// so maybe redirect LCL to a file and use DCDebug as thread-safe write to console.
-// Or write directly with Writeln(StdOut, ...)
 procedure DCDebug(Args: array of const);
 procedure DCDebug(const S: String; Args: array of const);// similar to Format(s,Args)
 procedure DCDebug(const s: String);
@@ -41,10 +41,114 @@ procedure DCDebug(const s1,s2,s3: String);
 procedure DCDebug(const s1,s2,s3,s4: String);
 procedure DCDebug(const s1,s2,s3,s4,s5: String);
 
+// For Lazarus >= 0.9.31.
+// DebugLn and DbgOut are thread-safe due to TDCLogger but since TLazLogger
+// itself is designed for single-thread then DebugLnEnter, DebugLnExit cannot
+// be used from multiple threads.
+
 implementation
 
 uses
-  LCLProc, syncobjs;
+  LCLProc, syncobjs
+  {$IF lcl_fullversion >= 093100}
+  , LazLogger
+  {$ENDIF}
+  ;
+
+{$IF lcl_fullversion >= 093100}
+type
+  {en
+     Logger with thread-safe DebugLn and DbgOut.
+  }
+  TDCLogger = class(TLazLogger)
+  private
+    DebugLnLock: TCriticalSection;
+  protected
+    procedure DoDbgOut(const s: string); override;
+    procedure DoDebugLn(const s: string); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+var
+  DCLogger: TDCLogger;
+
+{ TDCLogger }
+
+procedure TDCLogger.DoDbgOut(const s: string);
+begin
+  DebugLnLock.Acquire;
+  try
+    inherited DoDbgOut(s);
+  finally
+    DebugLnLock.Release;
+  end;
+end;
+
+procedure TDCLogger.DoDebugLn(const s: string);
+begin
+  DebugLnLock.Acquire;
+  try
+    inherited DoDebugLn(s);
+  finally
+    DebugLnLock.Release;
+  end;
+end;
+
+constructor TDCLogger.Create;
+begin
+  DebugLnLock := TCriticalSection.Create;
+  inherited Create;
+end;
+
+destructor TDCLogger.Destroy;
+begin
+  inherited Destroy;
+  DebugLnLock.Free;
+end;
+
+procedure DCDebug(Args: array of const);
+begin
+  DebugLn(Args);
+end;
+
+procedure DCDebug(const S: String; Args: array of const);// similar to Format(s,Args)
+begin
+  DebugLn(S, Args);
+end;
+
+procedure DCDebug(const s: String);
+begin
+  DebugLn(s);
+end;
+
+procedure DCDebug(const s1,s2: String);
+begin
+  DebugLn(s1, s2);
+end;
+
+procedure DCDebug(const s1,s2,s3: String);
+begin
+  DebugLn(s1, s2, s3);
+end;
+
+procedure DCDebug(const s1,s2,s3,s4: String);
+begin
+  DebugLn(s1, s2, s3, s4);
+end;
+
+procedure DCDebug(const s1,s2,s3,s4,s5: String);
+begin
+  DebugLn(s1, s2, s3, s4, s5);
+end;
+
+procedure DCDebug(const s1,s2,s3,s4,s5,s6: String);
+begin
+  DebugLn(s1, s2, s3, s4, s5, s6);
+end;
+
+{$ELSE}
 
 var
   DebugLnLock: TCriticalSection;
@@ -128,12 +232,21 @@ begin
     DebugLnLock.Release;
   end;
 end;
+{$ENDIF}
 
 initialization
+  {$IF lcl_fullversion >= 093100}
+  DCLogger := TDCLogger.Create;
+  LazLogger.SetDebugLogger(DCLogger);
+  {$ELSE}
   DebugLnLock := TCriticalSection.Create;
+  {$ENDIF}
 
 finalization
+  {$IF lcl_fullversion >= 093100}
+  {$ELSE}
   DebugLnLock.Free;
+  {$ENDIF}
 
 end.