Fixed: FS#20 - OutputDebugString still present in NamedPipeClient

Fixed: FS#21 - NamedPipe observer fails to flush queue in time
2024-12-31 05:23:07 +01:00 · 2014-10-22 18:24:54 +00:00 · 2014-10-22 18:24:54 +00:00 · 31e9be16d3
commit 31e9be16d3
parent d7b18972c3
6 changed files with 143 additions and 27 deletions
--- a/Test/X2LogTest.dpr
+++ b/Test/X2LogTest.dpr
@ -22,7 +22,8 @@ uses
  X2Log.Details.Default in '..\X2Log.Details.Default.pas',
  X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
  X2Log.Details.Intf in '..\X2Log.Details.Intf.pas',
-  X2Log.Util.Stream in '..\X2Log.Util.Stream.pas';
+  X2Log.Util.Stream in '..\X2Log.Util.Stream.pas',
+  X2Log.Decorator in '..\X2Log.Decorator.pas';

 {$R *.res}

--- a/Test/X2LogTest.dproj
+++ b/Test/X2LogTest.dproj
@ -194,6 +194,7 @@
 			<DCCReference Include="..\X2Log.Details.Registry.pas"/>
 			<DCCReference Include="..\X2Log.Details.Intf.pas"/>
 			<DCCReference Include="..\X2Log.Util.Stream.pas"/>
+			<DCCReference Include="..\X2Log.Decorator.pas"/>
 			<RcItem Include="resources\Graphic.jpg">
 				<ResourceType>RCDATA</ResourceType>
 				<ResourceId>GraphicDetails</ResourceId>
--- a/Test/source/MainFrm.dfm
+++ b/Test/source/MainFrm.dfm
@ -3,7 +3,7 @@ object MainForm: TMainForm
  Top = 0
  Caption = 'X'#178'Log Test'
  ClientHeight = 544
-  ClientWidth = 611
+  ClientWidth = 647
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
@ -20,23 +20,25 @@ object MainForm: TMainForm
    AlignWithMargins = True
    Left = 8
    Top = 176
-    Width = 595
+    Width = 631
    Height = 327
    Margins.Left = 8
    Margins.Top = 8
    Margins.Right = 8
    Margins.Bottom = 8
-    ActivePage = tsEvent
+    ActivePage = tsNamedPipe
    Align = alClient
    Images = ilsObservers
    TabOrder = 0
+    ExplicitWidth = 595
    object tsEvent: TTabSheet
      Caption = 'Event'
+      ExplicitWidth = 587
      object mmoEvent: TMemo
        AlignWithMargins = True
        Left = 8
        Top = 40
-        Width = 571
+        Width = 607
        Height = 251
        Margins.Left = 8
        Margins.Top = 40
@ -46,6 +48,7 @@ object MainForm: TMainForm
        ReadOnly = True
        ScrollBars = ssVertical
        TabOrder = 0
+        ExplicitWidth = 571
      end
      object btnEventStart: TButton
        Left = 8
@ -68,6 +71,10 @@ object MainForm: TMainForm
    end
    object tsFile: TTabSheet
      Caption = 'File'
+      ExplicitWidth = 587
+      DesignSize = (
+        623
+        299)
      object lblFilename: TLabel
        Left = 12
        Top = 64
@ -96,8 +103,9 @@ object MainForm: TMainForm
      object edtFilename: TEdit
        Left = 88
        Top = 61
-        Width = 489
+        Width = 525
        Height = 21
+        Anchors = [akLeft, akTop, akRight]
        TabOrder = 2
        Text = 'X2LogTest\Test.log'
      end
@ -130,8 +138,9 @@ object MainForm: TMainForm
    end
    object tsNamedPipe: TTabSheet
      Caption = 'Named Pipe'
+      ExplicitWidth = 587
      DesignSize = (
-        587
+        623
        299)
      object lblPipeName: TLabel
        Left = 8
@ -168,13 +177,14 @@ object MainForm: TMainForm
      object edtPipeName: TEdit
        Left = 88
        Top = 61
-        Width = 489
+        Width = 525
        Height = 21
+        Anchors = [akLeft, akTop, akRight]
        TabOrder = 2
        Text = 'X2LogTest'
      end
      object btnNamedPipeRefresh: TButton
-        Left = 502
+        Left = 538
        Top = 96
        Width = 75
        Height = 25
@ -182,15 +192,17 @@ object MainForm: TMainForm
        Caption = '&Refresh'
        TabOrder = 3
        OnClick = btnNamedPipeRefreshClick
+        ExplicitLeft = 502
      end
      object lbNamedPipeServers: TListBox
        Left = 8
        Top = 132
-        Width = 569
+        Width = 605
        Height = 157
        Anchors = [akLeft, akTop, akRight, akBottom]
        ItemHeight = 13
        TabOrder = 4
+        ExplicitWidth = 569
      end
    end
  end
@ -198,7 +210,7 @@ object MainForm: TMainForm
    AlignWithMargins = True
    Left = 8
    Top = 511
-    Width = 595
+    Width = 631
    Height = 25
    Margins.Left = 8
    Margins.Top = 0
@ -207,8 +219,9 @@ object MainForm: TMainForm
    Align = alBottom
    BevelOuter = bvNone
    TabOrder = 1
+    ExplicitWidth = 595
    object btnClose: TButton
-      Left = 520
+      Left = 556
      Top = 0
      Width = 75
      Height = 25
@ -217,6 +230,7 @@ object MainForm: TMainForm
      Caption = 'Close'
      TabOrder = 1
      OnClick = btnCloseClick
+      ExplicitLeft = 520
    end
    object btnMonitorForm: TButton
      Left = 0
@ -266,19 +280,21 @@ object MainForm: TMainForm
    AlignWithMargins = True
    Left = 8
    Top = 32
-    Width = 595
+    Width = 631
    Height = 104
    Margins.Left = 8
    Margins.Top = 8
    Margins.Right = 8
    Margins.Bottom = 0
-    ActivePage = tsBinary
+    ActivePage = tsTimer
    Align = alTop
    TabOrder = 2
+    ExplicitWidth = 595
    object tsText: TTabSheet
      Caption = 'Text'
+      ExplicitWidth = 587
      DesignSize = (
-        587
+        623
        76)
      object lblMessage: TLabel
        Left = 16
@ -326,12 +342,13 @@ object MainForm: TMainForm
      object edtMessage: TEdit
        Left = 92
        Top = 12
-        Width = 477
+        Width = 513
        Height = 21
        Anchors = [akLeft, akTop, akRight]
        TabOrder = 4
        Text = 'Hello world!'
        OnKeyDown = edtMessageKeyDown
+        ExplicitWidth = 477
      end
      object btnCategory: TButton
        Left = 416
@ -346,8 +363,9 @@ object MainForm: TMainForm
    object tsException: TTabSheet
      Caption = 'Exception'
      ImageIndex = 1
+      ExplicitWidth = 587
      DesignSize = (
-        587
+        623
        76)
      object lblException: TLabel
        Left = 16
@ -368,17 +386,19 @@ object MainForm: TMainForm
      object edtException: TEdit
        Left = 92
        Top = 12
-        Width = 477
+        Width = 513
        Height = 21
        Anchors = [akLeft, akTop, akRight]
        TabOrder = 1
        Text = 'Horrible things are happening.'
        OnKeyDown = edtExceptionKeyDown
+        ExplicitWidth = 477
      end
    end
    object tsBinary: TTabSheet
      Caption = 'Binary'
      ImageIndex = 2
+      ExplicitWidth = 587
      object btnBinaryRawByteString: TButton
        Left = 12
        Top = 15
@ -398,12 +418,60 @@ object MainForm: TMainForm
        OnClick = btnGraphicClick
      end
    end
+    object tsTimer: TTabSheet
+      Caption = 'Timer'
+      ImageIndex = 3
+      ExplicitWidth = 587
+      object lblTimer: TLabel
+        Left = 8
+        Top = 12
+        Width = 580
+        Height = 13
+        Caption = 
+          'Send out a series of log messages at regular intervals. Tests an' +
+          ' issue with the thread queue in the named pipe observer.'
+      end
+      object lblInterval: TLabel
+        Left = 8
+        Top = 43
+        Width = 92
+        Height = 13
+        Caption = 'Interval (seconds):'
+      end
+      object edtInterval: TEdit
+        Left = 130
+        Top = 40
+        Width = 89
+        Height = 21
+        TabOrder = 0
+        Text = '1'
+      end
+      object btnTimerStart: TButton
+        Left = 228
+        Top = 38
+        Width = 75
+        Height = 25
+        Caption = 'Start'
+        TabOrder = 1
+        OnClick = btnTimerStartClick
+      end
+      object btnTimerStop: TButton
+        Left = 309
+        Top = 38
+        Width = 75
+        Height = 25
+        Caption = 'Stop'
+        Enabled = False
+        TabOrder = 2
+        OnClick = btnTimerStopClick
+      end
+    end
  end
  object pnlDispatch: TPanel
    AlignWithMargins = True
    Left = 8
    Top = 0
-    Width = 595
+    Width = 631
    Height = 24
    Margins.Left = 8
    Margins.Top = 0
@ -420,6 +488,7 @@ object MainForm: TMainForm
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 3
+    ExplicitWidth = 595
    object bvlDispatch: TBevel
      Left = 80
      Top = 12
@ -432,7 +501,7 @@ object MainForm: TMainForm
    AlignWithMargins = True
    Left = 8
    Top = 144
-    Width = 595
+    Width = 631
    Height = 24
    Margins.Left = 8
    Margins.Top = 8
@ -449,6 +518,7 @@ object MainForm: TMainForm
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 4
+    ExplicitWidth = 595
    object bvlObservers: TBevel
      Left = 80
      Top = 12
@ -463,7 +533,7 @@ object MainForm: TMainForm
    Left = 552
    Top = 176
    Bitmap = {
-      494C01010200140050000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000300000000C00000001002000000000000009
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
@ -545,4 +615,11 @@ object MainForm: TMainForm
      E07E070000000000FFFFFF000000000000000000000000000000000000000000
      000000000000}
  end
+  object Timer: TTimer
+    Enabled = False
+    Interval = 10000
+    OnTimer = TimerTimer
+    Left = 464
+    Top = 176
+  end
 end
--- a/Test/source/MainFrm.pas
+++ b/Test/source/MainFrm.pas
@ -62,6 +62,13 @@ type
    btnLock: TButton;
    btnUnlock: TButton;
    btnCategory: TButton;
+    tsTimer: TTabSheet;
+    lblTimer: TLabel;
+    lblInterval: TLabel;
+    edtInterval: TEdit;
+    btnTimerStart: TButton;
+    btnTimerStop: TButton;
+    Timer: TTimer;
    
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
@ -83,6 +90,9 @@ type
    procedure btnGraphicClick(Sender: TObject);
    procedure btnNamedPipeRefreshClick(Sender: TObject);
    procedure btnCategoryClick(Sender: TObject);
+    procedure btnTimerStartClick(Sender: TObject);
+    procedure btnTimerStopClick(Sender: TObject);
+    procedure TimerTimer(Sender: TObject);
  private
    FLog: IX2Log;
    FEventObserver: IX2LogObserver;
@ -364,4 +374,32 @@ begin
  end;
 end;

+
+procedure TMainForm.btnTimerStartClick(Sender: TObject);
+begin
+  Timer.Interval := StrToIntDef(edtInterval.Text, 5) * 1000;
+  Timer.Enabled := True;
+
+  btnTimerStart.Enabled := False;
+  btnTimerStop.Enabled := True;
+end;
+
+
+procedure TMainForm.btnTimerStopClick(Sender: TObject);
+begin
+  Timer.Enabled := False;
+
+  btnTimerStart.Enabled := True;
+  btnTimerStop.Enabled := False;
+end;
+
+
+procedure TMainForm.TimerTimer(Sender: TObject);
+begin
+  FLog.Warning('Batch start');
+  FLog.Info('Message 1');
+  FLog.Info('Message 2');
+  FLog.Info('Message 3');
+end;
+
 end.
--- a/X2Log.Observer.CustomThreaded.pas
+++ b/X2Log.Observer.CustomThreaded.pas
@ -150,7 +150,7 @@ end;
 constructor TX2LogObserverWorkerThread.Create;
 begin
  FThreadStartSignal := TEvent.Create(nil, True, False, '');
-  FLogQueueSignal := TEvent.Create(nil, False, False, '');
+  FLogQueueSignal := TEvent.Create(nil, True, False, '');
  FLogQueue := TObjectQueue<TX2LogQueueEntry>.Create(True);

  inherited Create(False);
@ -177,11 +177,10 @@ begin
  TMonitor.Enter(LogQueue);
  try
    LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, ADateTime, AMessage, ACategory, ADetails));
+    LogQueueSignal.SetEvent;
  finally
    TMonitor.Exit(LogQueue);
  end;
-
-  LogQueueSignal.SetEvent;
 end;


@ -205,7 +204,9 @@ begin
      TMonitor.Enter(LogQueue);
      try
        if LogQueue.Count > 0 then
-          entry := LogQueue.Extract;
+          entry := LogQueue.Extract
+        else
+          LogQueueSignal.ResetEvent;
      finally
        TMonitor.Exit(LogQueue);
      end;
--- a/X2Log.Observer.NamedPipe.pas
+++ b/X2Log.Observer.NamedPipe.pas
@ -146,8 +146,6 @@ end;

 procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry);
 begin
-  OutputDebugString(PChar(AEntry.Message));
-
  if not Assigned(WriteBuffer) then
    DoSend(AEntry)
  else