paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 17:19:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazLogger: refactoring: move methods from LazLogger to LazLoggerBase

Browse Source 
git-svn-id: trunk@58077 -
This commit is contained in:
ondrej 2018-06-02 15:58:23 +00:00
parent 213b7bace6
commit ab816ccd37
4 changed files with 171 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/lazutils/LazLoggerImpl.inc
View File

@ -580,3 +580,11 @@ begin
end;
procedure DumpExceptionBackTrace;
begin
{$IFnDEF USED_BY_LAZLOGGER_DUMMY}
DebugLogger.DebugLn(' Stack trace:');
DebugLogger.DumpExceptionBackTrace;
{$ENDIF}
end;

1
components/lazutils/LazLoggerIntf.inc
View File

@ -109,3 +109,4 @@ function dbghex(i: Int64): string; overload;
function dbgMemRange(P: Pointer; Count: integer; Width: integer = 0): string; overload;
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
procedure DumpExceptionBackTrace;

138
components/lazutils/lazlogger.pas
View File

@ -27,7 +27,6 @@ function DbgStr(const StringWithSpecialChars: string): string; overload;
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
function DbgStr(const p: PChar; Len: PtrInt): string; overload;
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
procedure DumpExceptionBackTrace;
function ConvertLineEndings(const s: string): string;
@ -676,156 +675,29 @@ end;
function DbgStr(const StringWithSpecialChars: string): string;
var
i: Integer;
s: String;
l: Integer;
begin
Result:=StringWithSpecialChars;
i:=1;
while (i<=length(Result)) do begin
case Result[i] of
' '..#126: inc(i);
else
s:='#'+HexStr(ord(Result[i]),2);
// Note: do not use copy, fpc might change broken UTF-8 characters to '?'
l:=length(Result)-i;
SetLength(Result,length(Result)-1+length(s));
if l>0 then
system.Move(Result[i+1],Result[i+length(s)],l);
system.Move(s[1],Result[i],length(s));
inc(i,length(s));
end;
end;
Result := LazLoggerBase.DbgStr(StringWithSpecialChars);
end;
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt
): string;
begin
Result:=dbgstr(copy(StringWithSpecialChars,StartPos,Len));
Result := LazLoggerBase.DbgStr(StringWithSpecialChars, StartPos, Len);
end;
function DbgStr(const p: PChar; Len: PtrInt): string;
const
Hex: array[0..15] of char='0123456789ABCDEF';
var
UsedLen: PtrInt;
ResultLen: PtrInt;
Src: PChar;
Dest: PChar;
c: Char;
begin
if (p=nil) or (p^=#0) or (Len<=0) then exit('');
UsedLen:=0;
ResultLen:=0;
Src:=p;
while Src^<>#0 do begin
inc(UsedLen);
if Src^ in [' '..#126] then
inc(ResultLen)
else
inc(ResultLen,3);
if UsedLen>=Len then break;
inc(Src);
end;
SetLength(Result,ResultLen);
Src:=p;
Dest:=PChar(Result);
while UsedLen>0 do begin
dec(UsedLen);
c:=Src^;
if c in [' '..#126] then begin
Dest^:=c;
inc(Dest);
end else begin
Dest^:='#';
inc(Dest);
Dest^:=Hex[ord(c) shr 4];
inc(Dest);
Dest^:=Hex[ord(c) and $f];
inc(Dest);
end;
inc(Src);
end;
Result := LazLoggerBase.DbgStr(p, Len);
end;
function DbgWideStr(const StringWithSpecialChars: widestring): string;
var
s: String;
SrcPos: Integer;
DestPos: Integer;
i: Integer;
begin
SetLength(Result,length(StringWithSpecialChars));
SrcPos:=1;
DestPos:=1;
while SrcPos<=length(StringWithSpecialChars) do begin
i:=ord(StringWithSpecialChars[SrcPos]);
case i of
32..126:
begin
Result[DestPos]:=chr(i);
inc(SrcPos);
inc(DestPos);
end;
else
s:='#'+HexStr(i,4);
inc(SrcPos);
Result:=copy(Result,1,DestPos-1)+s+copy(Result,DestPos+1,length(Result));
inc(DestPos,length(s));
end;
end;
end;
procedure DumpAddr(Addr: Pointer);
begin
// preventing another exception, while dumping stack trace
try
DebugLn(BackTraceStrFunc(Addr));
except
DebugLn(SysBackTraceStr(Addr));
end;
end;
procedure DumpExceptionBackTrace;
var
FrameCount: integer;
Frames: PPointer;
FrameNumber:Integer;
begin
DebugLn(' Stack trace:');
DumpAddr(ExceptAddr);
FrameCount:=ExceptFrameCount;
Frames:=ExceptFrames;
for FrameNumber := 0 to FrameCount-1 do
DumpAddr(Frames[FrameNumber]);
Result := LazLoggerBase.DbgWideStr(StringWithSpecialChars);
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;
Result := LazLoggerBase.ConvertLineEndings(s);
end;
initialization

184
components/lazutils/lazloggerbase.pas
View File

@ -233,6 +233,7 @@ type
const s13: string = ''; const s14: string = ''; const s15: string = '';
const s16: string = ''; const s17: string = ''; const s18: string = ''); overload;
procedure DumpExceptionBackTrace;
end;
{ TLazLoggerWithGroupParam
@ -285,6 +286,11 @@ procedure RecreateDebugLogger;
property DebugLogger: TLazLogger read GetDebugLogger write SetDebugLogger;
property DebugLoggerGroups: TLazLoggerLogGroupList read GetDebugLoggerGroups write SetDebugLoggerGroups;
function DbgStr(const StringWithSpecialChars: string): string; overload;
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload;
function DbgStr(const p: PChar; Len: PtrInt): string; overload;
function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
type
TLazDebugLoggerCreator = function: TRefCountedObject;
@ -390,6 +396,135 @@ begin
end;
end;
function DbgStr(const StringWithSpecialChars: string): string;
var
i: Integer;
s: String;
l: Integer;
begin
Result:=StringWithSpecialChars;
i:=1;
while (i<=length(Result)) do begin
case Result[i] of
' '..#126: inc(i);
else
s:='#'+HexStr(ord(Result[i]),2);
// Note: do not use copy, fpc might change broken UTF-8 characters to '?'
l:=length(Result)-i;
SetLength(Result,length(Result)-1+length(s));
if l>0 then
system.Move(Result[i+1],Result[i+length(s)],l);
system.Move(s[1],Result[i],length(s));
inc(i,length(s));
end;
end;
end;
function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt
): string;
begin
Result:=dbgstr(copy(StringWithSpecialChars,StartPos,Len));
end;
function DbgStr(const p: PChar; Len: PtrInt): string;
const
Hex: array[0..15] of char='0123456789ABCDEF';
var
UsedLen: PtrInt;
ResultLen: PtrInt;
Src: PChar;
Dest: PChar;
c: Char;
begin
if (p=nil) or (p^=#0) or (Len<=0) then exit('');
UsedLen:=0;
ResultLen:=0;
Src:=p;
while Src^<>#0 do begin
inc(UsedLen);
if Src^ in [' '..#126] then
inc(ResultLen)
else
inc(ResultLen,3);
if UsedLen>=Len then break;
inc(Src);
end;
SetLength(Result,ResultLen);
Src:=p;
Dest:=PChar(Result);
while UsedLen>0 do begin
dec(UsedLen);
c:=Src^;
if c in [' '..#126] then begin
Dest^:=c;
inc(Dest);
end else begin
Dest^:='#';
inc(Dest);
Dest^:=Hex[ord(c) shr 4];
inc(Dest);
Dest^:=Hex[ord(c) and $f];
inc(Dest);
end;
inc(Src);
end;
end;
function DbgWideStr(const StringWithSpecialChars: widestring): string;
var
s: String;
SrcPos: Integer;
DestPos: Integer;
i: Integer;
begin
SetLength(Result,length(StringWithSpecialChars));
SrcPos:=1;
DestPos:=1;
while SrcPos<=length(StringWithSpecialChars) do begin
i:=ord(StringWithSpecialChars[SrcPos]);
case i of
32..126:
begin
Result[DestPos]:=chr(i);
inc(SrcPos);
inc(DestPos);
end;
else
s:='#'+HexStr(i,4);
inc(SrcPos);
Result:=copy(Result,1,DestPos-1)+s+copy(Result,DestPos+1,length(Result));
inc(DestPos,length(s));
end;
end;
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;
{ TLazLoggerLogGroupList }
procedure TLazLoggerLogGroupList.Clear;
@ -556,6 +691,28 @@ begin
//
end;
procedure TLazLogger.DumpExceptionBackTrace;
procedure DumpAddr(Addr: Pointer);
begin
// preventing another exception, while dumping stack trace
try
DebugLn(BackTraceStrFunc(Addr));
except
DebugLn(SysBackTraceStr(Addr));
end;
end;
var
FrameCount: integer;
Frames: PPointer;
FrameNumber:Integer;
begin
DumpAddr(ExceptAddr);
FrameCount:=ExceptFrameCount;
Frames:=ExceptFrames;
for FrameNumber := 0 to FrameCount-1 do
DumpAddr(Frames[FrameNumber]);
end;
procedure TLazLogger.DoFinsh;
begin
//
@ -1123,33 +1280,6 @@ begin
end;
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;
finalization // Using TObject, so if none of the functions is used in the app, then even the rlass should be smart linked
ReleaseRefAndNil(TheLazLogger);
ReleaseRefAndNil(PrevLazLogger);