paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-16 01:10:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* new test

Browse Source 
git-svn-id: trunk@3814 -
This commit is contained in:
peter 2006-06-06 10:25:27 +00:00
parent dc043e1ed3
commit 77a7476620
2 changed files with 120 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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
tests/webtbs/tw6989.pp Executable file
View File

@ -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.