Explorar el Código

* new test

git-svn-id: trunk@3814 -
peter hace 19 años
padre
commit
77a7476620
Se han modificado 2 ficheros con 120 adiciones y 0 borrados
  1. 1 0
      .gitattributes
  2. 119 0
      tests/webtbs/tw6989.pp

+ 1 - 0
.gitattributes

@@ -7188,6 +7188,7 @@ tests/webtbs/tw6742.pp svneol=native#text/plain
 tests/webtbs/tw6767.pp svneol=native#text/plain
 tests/webtbs/tw6960.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
+tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 119 - 0
tests/webtbs/tw6989.pp

@@ -0,0 +1,119 @@
+unit tw6989;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+const
+  ltValue   = 3;
+
+
+
+type
+  TDebugClass = 0..31;
+
+
+  { TLogger }
+
+  TLogger = class
+  private
+    FDefaultClass: TDebugClass;
+   // FChannels:TChannelList;
+    procedure SendString(AMsgType: Integer;const AText:String);
+  public
+    ActiveClasses: set of TDebugClass;//Made a public field toallow use of include
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Send(const AText: String); inline;
+    procedure Send(AClass: TDebugClass; const AText: String);
+    procedure Send(const AText: String; Args: array of const); inline;
+    procedure Send(AClass: TDebugClass; const AText: String; Args: array of const);
+    procedure Send(const AText, AValue: String); inline;
+    procedure Send(AClass: TDebugClass; const AText,AValue: String);
+    procedure Send(const AText: String; AValue: Integer); inline;
+    procedure Send(AClass: TDebugClass; const AText: String; AValue: Integer);
+    procedure Send(const AText: String; AValue: Boolean); inline;
+    procedure Send(AClass: TDebugClass; const AText: String; AValue: Boolean);
+    procedure Send(const AText: String; ARect: TRect); inline;
+    //if the next inline is commented no error occurs
+    procedure Send(AClass: TDebugClass; const AText: String; ARect: TRect); inline;
+  end;
+
+implementation
+
+{ TLogger }
+
+procedure TLogger.SendString(AMsgType: Integer; const AText: String);
+begin
+end;
+
+constructor TLogger.Create;
+begin
+end;
+
+destructor TLogger.Destroy;
+begin
+end;
+
+procedure TLogger.Clear;
+begin
+end;
+
+procedure TLogger.Send(const AText: String);
+begin
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText: String);
+begin
+end;
+
+procedure TLogger.Send(const AText: String; Args: array of const);
+begin
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText: String;
+  Args: array of const);
+begin
+end;
+
+procedure TLogger.Send(const AText, AValue: String);
+begin
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText, AValue: String);
+begin
+end;
+
+procedure TLogger.Send(const AText: String; AValue: Integer);
+begin
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText: String; AValue: Integer);
+begin
+end;
+
+procedure TLogger.Send(const AText: String; AValue: Boolean);
+begin
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText: String; AValue: Boolean);
+begin
+end;
+
+procedure TLogger.Send(const AText: String; ARect: TRect);
+begin
+
+end;
+
+procedure TLogger.Send(AClass: TDebugClass; const AText: String; ARect: TRect);
+begin
+  //if this body procedure is commented also no error occurs
+  if not (AClass in ActiveClasses) then Exit;
+  with ARect do
+    SendString(ltValue,Format('%s = (Left: %d; Top: %d; Right: %d; Bottom: %d)',[AText,Left,Top,Right,Bottom]));
+end;
+end.