paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 04:18:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

new Debugln via LazLogger (ifdef WithLazLogger)

Browse Source 
git-svn-id: trunk@35187 -
This commit is contained in:
martin 2012-02-06 18:43:49 +00:00
parent f20d3c9354
commit 71814e408a
7 changed files with 1348 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1790,6 +1790,7 @@ components/lazutils/laz_xmlwrite.pas svneol=native#text/pascal
components/lazutils/lazdbglog.pas svneol=native#text/plain
components/lazutils/lazfilecache.pas svneol=native#text/plain
components/lazutils/lazfileutils.pas svneol=native#text/plain
components/lazutils/lazlogger.pas svneol=native#text/pascal
components/lazutils/lazmethodlist.pas svneol=native#text/plain
components/lazutils/lazutf16.pas svneol=native#text/pascal
components/lazutils/lazutf8.pas svneol=native#text/plain

1059
components/lazutils/lazlogger.pas Normal file
View File

File diff suppressed because it is too large Load Diff

18
components/lazutils/lazutils.pas
View File

@ -2,23 +2,23 @@
This source is only used to compile and install the package.
}
unit LazUtils;
unit LazUtils;
interface
uses
laz2_DOM, Laz2_XMLCfg, laz2_XMLRead, laz2_xmlutils, laz2_XMLWrite, Laz_DOM,
Laz_XMLCfg, Laz_XMLRead, Laz_XMLStreaming, Laz_XMLWrite, LazFileUtils,
LazFileCache, LUResStrings, LazUTF8, LazDbgLog, paswstring, FileUtil,
lazutf8classes, Masks, LazUtilsStrConsts, LConvEncoding, lazutf16,
lazutf8sysutils, LazMethodList, AvgLvlTree, LazarusPackageIntf;
laz2_DOM, Laz2_XMLCfg, laz2_XMLRead, laz2_xmlutils, laz2_XMLWrite, Laz_DOM, Laz_XMLCfg,
Laz_XMLRead, Laz_XMLStreaming, Laz_XMLWrite, LazFileUtils, LazFileCache, LUResStrings,
LazUTF8, LazDbgLog, paswstring, FileUtil, lazutf8classes, Masks, LazUtilsStrConsts,
LConvEncoding, lazutf16, lazutf8sysutils, LazMethodList, AvgLvlTree, LazLogger,
LazarusPackageIntf;
implementation
procedure Register;
procedure Register;
begin
end;
end;
initialization
RegisterPackage('LazUtils', @Register);
RegisterPackage('LazUtils', @Register);
end.

10
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -45,7 +45,7 @@ uses
lazcanvas, lazregions, lazdeviceapis,
InterfaceBase,
Controls, Forms, lclproc, IntfGraphics, GraphType,
LCLType, LMessages, Graphics, LCLStrConsts;
LCLType, LMessages, Graphics, LCLStrConsts, LazLogger;
type
{$ifdef CD_Windows}
@ -147,7 +147,11 @@ type
{$endif}
{$ifdef CD_Android}
CombiningAccent: Cardinal;
{$IFDEF WithLazLogger}
procedure AndroidDebugLn(ASender: TObject; AStr: string; var AHandled: Boolean);
{$ELSE}
procedure AndroidDebugLn(AStr: string);
{$ENDIF}
function AndroidKeyCodeToLCLKeyCode(AAndroidKeyCode: Integer): Word;
{$endif}
{$ifdef CD_Cocoa}
@ -169,7 +173,11 @@ type
// Mobile emulator and mobile mode
MobileMainForm: TLCLIntfHandle;
// For unusual implementations of DebugLn/DebugOut
{$IFDEF WithLazLogger}
procedure AccumulatingDebugOut(ASender: TObject; AStr: string; var AHandled: Boolean);
{$ELSE}
procedure AccumulatingDebugOut(AStr: string);
{$ENDIF}
//
procedure CDSetFocusToControl(ALCLControl, AIntfControl: TWinControl);
//

8
lcl/interfaces/customdrawn/customdrawnobject.inc
View File

@ -15,10 +15,18 @@
}
//---------------------------------------------------------------
{$IFDEF WithLazLogger}
procedure TCDWidgetSet.AccumulatingDebugOut(ASender: TObject; AStr: string; var AHandled: Boolean);
begin
AccumulatedStr := AccumulatedStr + AStr;
AHandled := True;
end;
{$ELSE}
procedure TCDWidgetSet.AccumulatingDebugOut(AStr: string);
begin
AccumulatedStr := AccumulatedStr + AStr;
end;
{$ENDIF}
procedure TCDWidgetSet.CDSetFocusToControl(ALCLControl, AIntfControl: TWinControl);
var

14
lcl/interfaces/customdrawn/customdrawnobject_android.inc
View File

@ -465,11 +465,20 @@ procedure JNI_OnUnload(vm:PJavaVM;reserved:pointer); cdecl;
begin
end;
{$IFDEF WithLazLogger}
procedure TCDWidgetSet.AndroidDebugLn(ASender: TObject; AStr: string; var AHandled: Boolean);
begin
__android_log_write(ANDROID_LOG_INFO, 'lclapp', PChar(AccumulatedStr+AStr));
AccumulatedStr := '';
AHandled := True;
end;
{$ELSE}
procedure TCDWidgetSet.AndroidDebugLn(AStr: string);
begin
__android_log_write(ANDROID_LOG_INFO, 'lclapp', PChar(AccumulatedStr+AStr));
AccumulatedStr := '';
end;
{$ENDIF}
function TCDWidgetSet.AndroidKeyCodeToLCLKeyCode(AAndroidKeyCode: Integer): Word;
var
@ -711,8 +720,13 @@ end;
procedure TCDWidgetSet.BackendCreate;
begin
// Setup DebugLn
{$IFDEF WithLazLogger}
DebugLogger.DebugLnProc := @AndroidDebugLn;
DebugLogger.DbgOutProc := @AccumulatingDebugOut;
{$ELSE}
DebugLnProc := @AndroidDebugLn;
DebugOutProc := @AccumulatingDebugOut;
{$ENDIF}
{$ifdef CD_UseNativeText}
// Create the dummy screen DC

337
lcl/lclproc.pas
View File

@ -37,6 +37,7 @@ uses
Win9xWsManager, // Support for Lower/UpperWideStringProc on Win9x, also used by some Utf8 string handling functions
{$ENDIF}
{$ENDIF}
{$IFDEF WithLazLogger} LazLogger, {$ENDIF}
Classes, SysUtils, Math, TypInfo, Types, FPCAdds, AvgLvlTree, FileUtil,
LCLStrConsts, LCLType, WSReferences, LazMethodList, LazUTF8;
@ -172,6 +173,49 @@ function StackTraceAsString(const AStack: TStackTracePointers;
UseCache: boolean): string;
function GetLineInfo(Addr: Pointer; UseCache: boolean): string;
{$IFDEF WithLazLogger}
procedure DbgOut(const s: string = ''); inline; overload;
procedure DbgOut(Args: array of const); inline; overload;
procedure DbgOut(const S: String; Args: array of const); inline; overload;// similar to Format(s,Args)
procedure DbgOut(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLn(const s: string = ''); inline; overload;
procedure DebugLn(Args: array of const); inline; overload;
procedure DebugLn(const S: String; Args: array of const); inline; overload;// similar to Format(s,Args)
procedure DebugLn(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLnEnter(const s: string = ''); inline; overload;
procedure DebugLnEnter(Args: array of const); inline; overload;
procedure DebugLnEnter(s: string; Args: array of const); inline; overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure DebugLnExit(const s: string = ''); inline; overload;
procedure DebugLnExit(Args: array of const); inline; overload;
procedure DebugLnExit(s: string; Args: array of const); inline; overload;
procedure DebugLnExit (const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); inline; overload;
procedure CloseDebugOutput;
{$ELSE}
procedure DebugLn(Args: array of const); overload;
procedure DebugLn(const S: String; Args: array of const); overload;// similar to Format(s,Args)
procedure DebugLn; overload;
@ -192,26 +236,24 @@ procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14: string);
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15: string); overload;
procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15,s16: string); overload;
procedure DebugLnEnter(const s: string = nil); overload;
procedure DebugLnEnter(const s: string = ''); overload;
procedure DebugLnEnter(Args: array of const); overload;
procedure DebugLnEnter(s: string; Args: array of const); overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = nil;
const s4: string = nil; const s5: string = nil; const s6: string = nil;
const s7: string = nil; const s8: string = nil; const s9: string = nil;
const s10: string = nil; const s11: string = nil; const s12: string = nil;
const s13: string = nil; const s14: string = nil; const s15: string = nil;
const s16: string = nil; const s17: string = nil; const s18: string = nil); overload;
procedure DebugLnExit(const s: string = nil); overload;
procedure DebugLnEnter(const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DebugLnExit(const s: string = ''); overload;
procedure DebugLnExit(Args: array of const); overload;
procedure DebugLnExit(s: string; Args: array of const); overload;
procedure DebugLnExit (const s1, s2: string; const s3: string = nil;
const s4: string = nil; const s5: string = nil; const s6: string = nil;
const s7: string = nil; const s8: string = nil; const s9: string = nil;
const s10: string = nil; const s11: string = nil; const s12: string = nil;
const s13: string = nil; const s14: string = nil; const s15: string = nil;
const s16: string = nil; const s17: string = nil; const s18: string = nil); overload;
function ConvertLineEndings(const s: string): string;
procedure DebugLnExit (const s1, s2: string; const s3: string = '';
const s4: string = ''; const s5: string = ''; const s6: string = '';
const s7: string = ''; const s8: string = ''; const s9: string = '';
const s10: string = ''; const s11: string = ''; const s12: string = '';
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DbgOut(const S: String; Args: array of const); overload;
procedure DbgOut(const s: string); overload;
@ -227,6 +269,10 @@ procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string); overload;
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string); overload;
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string); overload;
procedure CloseDebugOutput;
{$ENDIF}
function ConvertLineEndings(const s: string): string;
function DbgS(const c: cardinal): string; overload;
function DbgS(const i: longint): string; overload;
function DbgS(const i: int64): string; overload;
@ -264,8 +310,6 @@ procedure DbgSaveData(FileName: String; AData: PChar; ADataSize: PtrUInt);
procedure DbgAppendToFile(FileName, S: String);
procedure DbgAppendToFileWithoutLn(FileName, S: String);
procedure CloseDebugOutput;
// some string manipulation functions
function StripLN(const ALine: String): String;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String;
@ -359,6 +403,7 @@ procedure LCLGetLanguageIDs(var Lang, FallbackLang: String);
function CreateFirstIdentifier(const Identifier: string): string;
function CreateNextIdentifier(const Identifier: string): string;
{$IFnDEF WithLazLogger}
type
TDebugLnProc = procedure (s: string) of object;
@ -369,6 +414,7 @@ var
DebugLnProc: TDebugLnProc = nil;
DebugOutProc: TDebugLnProc = nil;
{$ENDIF}
implementation
@ -382,10 +428,12 @@ const
var
InterfaceInitializationHandlers: TFPList = nil;
InterfaceFinalizationHandlers: TFPList = nil;
{$IFnDEF WithLazLogger}
DebugTextAllocated: boolean;
DebugNestLvl: Integer = 0;
DebugNestPrefix: PChar = nil;
DebugNestAtBOL: Boolean;
{$ENDIF}
LineInfoCache: TAvgLvlTree = nil;
function DeleteAmpersands(var Str : String) : Longint;
@ -847,12 +895,6 @@ begin
DumpAddr(Frames[FrameNumber]);
end;
procedure DumpStack;
begin
if Assigned(DebugText) then
Dump_Stack(DebugText^, get_frame);
end;
function GetStackTrace(UseCache: boolean): string;
var
bp: Pointer;
@ -1356,6 +1398,114 @@ end;
// Debug funcs :
{$IFDEF WithLazLogger}
procedure DumpStack;
begin
DebugLogger.DebuglnStack;
end;
procedure CloseDebugOutput;
begin
DebugLogger.Finish;
end;
procedure DbgOut(const s: string);
begin
DebugLogger.DbgOut(s);
end;
procedure DbgOut(Args: array of const);
begin
DebugLogger.DbgOut(Args);
end;
procedure DbgOut(const S: String; Args: array of const);
begin
DebugLogger.DbgOut(S, Args);
end;
procedure DbgOut(const s1, s2: string; const s3: string; const s4: string; const s5: string;
const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
const s11: string; const s12: string; const s13: string; const s14: string;
const s15: string; const s16: string; const s17: string; const s18: string);
begin
DebugLogger.DbgOut(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
end;
procedure DebugLn(const s: string);
begin
DebugLogger.DebugLn(s);
end;
procedure DebugLn(Args: array of const);
begin
DebugLogger.DebugLn(Args);
end;
procedure DebugLn(const S: String; Args: array of const);
begin
DebugLogger.DebugLn(S, Args);
end;
procedure DebugLn(const s1, s2: string; const s3: string; const s4: string; const s5: string;
const s6: string; const s7: string; const s8: string; const s9: string; const s10: string;
const s11: string; const s12: string; const s13: string; const s14: string;
const s15: string; const s16: string; const s17: string; const s18: string);
begin
DebugLogger.DebugLn(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
end;
procedure DebugLnEnter(const s: string);
begin
DebugLogger.DebugLnEnter(s);
end;
procedure DebugLnEnter(Args: array of const);
begin
DebugLogger.DebugLnEnter(Args);
end;
procedure DebugLnEnter(s: string; Args: array of const);
begin
DebugLogger.DebugLnEnter(s, Args);
end;
procedure DebugLnEnter(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DebugLogger.DebugLnEnter(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
end;
procedure DebugLnExit(const s: string);
begin
DebugLogger.DebugLnExit(s);
end;
procedure DebugLnExit(Args: array of const);
begin
DebugLogger.DebugLnExit(Args);
end;
procedure DebugLnExit(s: string; Args: array of const);
begin
DebugLogger.DebugLnExit(s, Args);
end;
procedure DebugLnExit(const s1, s2: string; const s3: string; const s4: string;
const s5: string; const s6: string; const s7: string; const s8: string; const s9: string;
const s10: string; const s11: string; const s12: string; const s13: string;
const s14: string; const s15: string; const s16: string; const s17: string;
const s18: string);
begin
DebugLogger.DebugLnExit(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18);
end;
{$ELSE}
procedure InitializeDebugOutput;
var
DebugFileName: string;
@ -1436,6 +1586,49 @@ begin
CloseDebugOutput;
end;
procedure DebugLnNestCreatePrefix;
const
CurrentLen: Integer = 0;
var
s: String;
NewLen: Integer;
begin
NewLen := DebugNestLvl * DebugLnNestLvlIndent;
if NewLen < 0 then NewLen := 0;
if (NewLen >= DebugLnMaxNestPrefixLen) then begin
NewLen := DebugLnMaxNestPrefixLen;
s := IntToStr(DebugNestLvl);
if length(s)+1 > NewLen then
NewLen := length(s)+1;
end else
s := '';
if NewLen > CurrentLen then
ReAllocMem(DebugNestPrefix, NewLen+21);
CurrentLen := NewLen+20;
FillChar(DebugNestPrefix^, NewLen, ' ');
if s <> '' then
System.Move(s[1], DebugNestPrefix[0], length(s));
if (NewLen >= DebugLnMaxNestPrefixLen) then
DebugNestPrefix[DebugLnMaxNestPrefixLen] := #0
else
DebugNestPrefix[NewLen] := #0;
end;
procedure DebugLnNestFreePrefix;
begin
if DebugNestPrefix <> nil then
ReAllocMem(DebugNestPrefix, 0);
end;
procedure DumpStack;
begin
if Assigned(DebugText) then
Dump_Stack(DebugText^, get_frame);
end;
procedure DebugLn(Args: array of const);
var
i: Integer;
@ -1586,43 +1779,6 @@ begin
DebugLn(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16);
end;
procedure DebugLnNestCreatePrefix;
const
CurrentLen: Integer = 0;
var
s: String;
NewLen: Integer;
begin
NewLen := DebugNestLvl * DebugLnNestLvlIndent;
if NewLen < 0 then NewLen := 0;
if (NewLen >= DebugLnMaxNestPrefixLen) then begin
NewLen := DebugLnMaxNestPrefixLen;
s := IntToStr(DebugNestLvl);
if length(s)+1 > NewLen then
NewLen := length(s)+1;
end else
s := '';
if NewLen > CurrentLen then
ReAllocMem(DebugNestPrefix, NewLen+21);
CurrentLen := NewLen+20;
FillChar(DebugNestPrefix^, NewLen, ' ');
if s <> '' then
System.Move(s[1], DebugNestPrefix[0], length(s));
if (NewLen >= DebugLnMaxNestPrefixLen) then
DebugNestPrefix[DebugLnMaxNestPrefixLen] := #0
else
DebugNestPrefix[NewLen] := #0;
end;
procedure DebugLnNestFreePrefix;
begin
if DebugNestPrefix <> nil then
ReAllocMem(DebugNestPrefix, 0);
end;
procedure DebugLnEnter(const s: string);
begin
if not DebugNestAtBOL then
@ -1691,33 +1847,6 @@ begin
DebugLnExit(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15+s16+s17+s18);
end;
function ConvertLineEndings(const s: string): string;
var
i: Integer;
EndingStart: LongInt;
begin
Result:=s;
i:=1;
while (i<=length(Result)) do begin
if Result[i] in [#10,#13] then begin
EndingStart:=i;
inc(i);
if (i<=length(Result)) and (Result[i] in [#10,#13])
and (Result[i]<>Result[i-1]) then begin
inc(i);
end;
if (length(LineEnding)<>i-EndingStart)
or (LineEnding<>copy(Result,EndingStart,length(LineEnding))) then begin
// line end differs => replace with current LineEnding
Result:=
copy(Result,1,EndingStart-1)+LineEnding+copy(Result,i,length(Result));
i:=EndingStart+length(LineEnding);
end;
end else
inc(i);
end;
end;
procedure DbgOut(const S: String; Args: array of const);
begin
DbgOut(Format(S, Args));
@ -1799,6 +1928,34 @@ procedure DbgOut(const s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12: string
begin
DbgOut(s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12);
end;
{$ENDIF}
function ConvertLineEndings(const s: string): string;
var
i: Integer;
EndingStart: LongInt;
begin
Result:=s;
i:=1;
while (i<=length(Result)) do begin
if Result[i] in [#10,#13] then begin
EndingStart:=i;
inc(i);
if (i<=length(Result)) and (Result[i] in [#10,#13])
and (Result[i]<>Result[i-1]) then begin
inc(i);
end;
if (length(LineEnding)<>i-EndingStart)
or (LineEnding<>copy(Result,EndingStart,length(LineEnding))) then begin
// line end differs => replace with current LineEnding
Result:=
copy(Result,1,EndingStart-1)+LineEnding+copy(Result,i,length(Result));
i:=EndingStart+length(LineEnding);
end;
end else
inc(i);
end;
end;
function DbgS(const c: cardinal): string;
begin
@ -3149,7 +3306,7 @@ begin
end;
initialization
InitializeDebugOutput;
{$IFnDEF WithLazLogger} InitializeDebugOutput; {$ENDIF}
{$ifdef WinCE}
// The stabs based back trace function crashes on wince,
// see http://bugs.freepascal.org/view.php?id=14330
@ -3172,7 +3329,9 @@ finalization
DebugLCLComponents:=nil;
{$ENDIF}
FreeLineInfoCache;
{$IFnDEF WithLazLogger}
FinalizeDebugOutput;
DebugLnNestFreePrefix;
{$ENDIF}
end.