Virtual-File-System/Tests/VfsDebugTest.pas

unit VfsDebugTest;
{$ASSERTIONS ON}

(***)  interface  (***)

uses
  SysUtils, TestFramework,
  Utils, VfsDebug;

type
  TestDebug = class (TTestCase)
   private
    procedure TestAssertHandler;

   published
    procedure TestLogging;
  end;

(***)  implementation  (***)


var
  LogContents: string;

procedure ClearLog;
begin
  LogContents := '';
end;

function GetLog: string;
begin
  result := LogContents;
end;

procedure WriteLog (const Operation, Message: pchar); stdcall;
begin
  LogContents := LogContents + Operation + ';' + Message;
end;

procedure TestDebug.TestAssertHandler ();
var
  Raised: boolean;

begin
  Raised := false;

  try
    System.Assert(false, 'Some assertion message');
  except
    on E: VfsDebug.EAssertFailure do Raised := true;
  end;

  Check(Raised, 'Assertion should raise EAssertFailure exception');
end;

procedure TestDebug.TestLogging;
var
  PrevLoggingProc: VfsDebug.TLoggingProc;

begin
  PrevLoggingProc := Ptr(1);
  // * * * * * //
  try
    ClearLog;
    PrevLoggingProc := VfsDebug.SetLoggingProc(@WriteLog);
    VfsDebug.WriteLog('TestOperation', 'TestMessage');
    Check(GetLog() = 'TestOperation;TestMessage', 'Custom logging proc should have written certain message to log');
    VfsDebug.SetLoggingProc(PrevLoggingProc);

    ClearLog;
    VfsDebug.SetLoggingProc(nil);
    VfsDebug.WriteLog('TestOperation', 'TestMessage');
    Check(GetLog() = '', 'Nil logging proc must not write anything to log');
    VfsDebug.SetLoggingProc(PrevLoggingProc);
  finally
    if @PrevLoggingProc <> Ptr(1) then begin
      VfsDebug.SetLoggingProc(PrevLoggingProc);
    end;
  end; // .try
end; // .procedure TestDebug.TestLogging

begin
  RegisterTest(TestDebug.Suite);
end.