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

codetools: consistencychecks now raises exceptions, accelerated TExprEval, added TExprEval.ChangeStamp

Browse Source 
git-svn-id: trunk@17858 -
This commit is contained in:
mattias 2008-12-18 22:32:30 +00:00
parent dd4e9f87a1
commit 1a4313f8bc
10 changed files with 521 additions and 560 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/codetools/basiccodetools.pas
View File

@ -195,10 +195,6 @@ function CompareUnitFileInfos(Data1, Data2: Pointer): integer;
function CompareUnitNameAndUnitFileInfo(UnitnamePAnsiString,
UnitFileInfo: Pointer): integer;
// other useful stuff
procedure RaiseCatchableException(const Msg: string);
//-----------------------------------------------------------------------------
// functions / procedures
@ -4062,17 +4058,6 @@ begin
PChar(TUnitFileInfo(UnitFileInfo).UnitName));
end;
procedure RaiseCatchableException(const Msg: string);
begin
{ Raises an exception.
gdb does not catch fpc Exception objects, therefore this procedure raises
a standard AV which is catched by gdb. }
DebugLn('ERROR in CodeTools: ',Msg);
// creates an exception, that gdb catches:
DebugLn('Creating gdb catchable error:');
if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;
function CountNeededLineEndsToAddForward(const Src: string;
StartPos, MinLineEnds: integer): integer;
var c:char;

53
components/codetools/codecache.pas
View File

@ -74,7 +74,7 @@ type
constructor Create;
destructor Destroy; override;
procedure Clear; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
procedure WriteDebugReport;
function LoadFromFile(const AFilename: string): boolean; override;
function Reload: boolean; // = LoadFromFile(Filename)
@ -163,7 +163,7 @@ type
public
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
function Count: integer;
function CreateFile(const AFilename: string): TCodeBuffer;
function FindFile(AFilename: string): TCodeBuffer;
@ -746,46 +746,38 @@ begin
end;
end;
function TCodeCache.ConsistencyCheck: integer;
procedure TCodeCache.ConsistencyCheck;
// 0 = ok
var ANode: TAVLTreeNode;
CurResult: LongInt;
begin
Result:=FItems.ConsistencyCheck;
if Result<>0 then begin
dec(Result,100); exit;
end;
Result:=FIncludeLinks.ConsistencyCheck;
if Result<>0 then begin
dec(Result,200); exit;
end;
CurResult:=FItems.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
CurResult:=FIncludeLinks.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
ANode:=FItems.FindLowest;
while ANode<>nil do begin
if ANode.Data=nil then begin
Result:=-1;
exit;
end;
Result:=TCodeBuffer(ANode.Data).ConsistencyCheck;
if Result<>0 then begin
dec(Result,300); exit;
end;
if ANode.Data=nil then
RaiseCatchableException('');
TCodeBuffer(ANode.Data).ConsistencyCheck;
ANode:=FItems.FindSuccessor(ANode);
end;
ANode:=FIncludeLinks.FindLowest;
while ANode<>nil do begin
if ANode.Data=nil then begin
Result:=-2;
exit;
end;
if ANode.Data=nil then
RaiseCatchableException('');
ANode:=FIncludeLinks.FindSuccessor(ANode);
end;
Result:=0;
end;
procedure TCodeCache.WriteDebugReport;
begin
DebugLn('[TCodeCache.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck));
DebugLn('[TCodeCache.WriteDebugReport]');
DebugLn(FItems.ReportAsString);
DebugLn(FIncludeLinks.ReportAsString);
ConsistencyCheck;
end;
procedure TCodeCache.WriteAllFileNames;
@ -1034,17 +1026,16 @@ begin
dec(FReferenceCount);
end;
function TCodeBuffer.ConsistencyCheck: integer; // 0 = ok
procedure TCodeBuffer.ConsistencyCheck;
begin
if FScanner<>nil then begin
Result:=FScanner.ConsistencyCheck;
end;
Result:=0;
if FScanner<>nil then
FScanner.ConsistencyCheck;
end;
procedure TCodeBuffer.WriteDebugReport;
begin
DebugLn('[TCodeBuffer.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck));
DebugLn('[TCodeBuffer.WriteDebugReport] ');
ConsistencyCheck;
end;
{ TIncludedByLink }

68
components/codetools/codetoolmanager.pas
View File

@ -682,7 +682,7 @@ type
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
procedure WriteDebugReport(WriteTool,
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean);
end;
@ -4903,53 +4903,30 @@ begin
if Lock then ActivateWriteLock else DeactivateWriteLock;
end;
function TCodeToolManager.ConsistencyCheck: integer;
// 0 = ok
procedure TCodeToolManager.ConsistencyCheck;
var
CurResult: LongInt;
begin
try
Result:=0;
if FCurCodeTool<>nil then begin
FCurCodeTool.ConsistencyCheck;
end;
Result:=DefinePool.ConsistencyCheck;
if Result<>0 then begin
dec(Result,20000); exit;
end;
Result:=DefineTree.ConsistencyCheck;
if Result<>0 then begin
dec(Result,30000); exit;
end;
Result:=SourceCache.ConsistencyCheck;
if Result<>0 then begin
dec(Result,40000); exit;
end;
Result:=GlobalValues.ConsistencyCheck;
if Result<>0 then begin
dec(Result,50000); exit;
end;
Result:=SourceChangeCache.ConsistencyCheck;
if Result<>0 then begin
dec(Result,60000); exit;
end;
Result:=FPascalTools.ConsistencyCheck;
if Result<>0 then begin
dec(Result,70000); exit;
end;
Result:=FDirectivesTools.ConsistencyCheck;
if Result<>0 then begin
dec(Result,80000); exit;
end;
finally
if (Result<>0) and (FCatchExceptions=false) then
raise Exception.CreateFmt(ctsTCodeToolManagerConsistencyCheck, [Result]);
if FCurCodeTool<>nil then begin
FCurCodeTool.ConsistencyCheck;
end;
Result:=0;
DefinePool.ConsistencyCheck;
DefineTree.ConsistencyCheck;
SourceCache.ConsistencyCheck;
GlobalValues.ConsistencyCheck;
SourceChangeCache.ConsistencyCheck;
CurResult:=FPascalTools.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
CurResult:=FDirectivesTools.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
end;
procedure TCodeToolManager.WriteDebugReport(WriteTool,
WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean);
begin
DebugLn('[TCodeToolManager.WriteDebugReport] Consistency=',dbgs(ConsistencyCheck));
DebugLn('[TCodeToolManager.WriteDebugReport]');
if FCurCodeTool<>nil then begin
if WriteTool then
FCurCodeTool.WriteDebugTreeReport;
@ -4957,19 +4934,20 @@ begin
if WriteDefPool then
DefinePool.WriteDebugReport
else
DebugLn(' DefinePool.ConsistencyCheck=',dbgs(DefinePool.ConsistencyCheck));
DefinePool.ConsistencyCheck;
if WriteDefTree then
DefineTree.WriteDebugReport
else
DebugLn(' DefineTree.ConsistencyCheck=',dbgs(DefineTree.ConsistencyCheck));
DefineTree.ConsistencyCheck;
if WriteCache then
SourceCache.WriteDebugReport
else
DebugLn(' SourceCache.ConsistencyCheck=',dbgs(SourceCache.ConsistencyCheck));
SourceCache.ConsistencyCheck;
if WriteGlobalValues then
GlobalValues.WriteDebugReport
else
DebugLn(' GlobalValues.ConsistencyCheck=',dbgs(GlobalValues.ConsistencyCheck));
GlobalValues.ConsistencyCheck;
ConsistencyCheck;
end;
//-----------------------------------------------------------------------------

2
components/codetools/codetools.inc
View File

@ -29,4 +29,6 @@
{off $DEFINE CTDEBUG}
{$inline on}
// end.

95
components/codetools/definetemplates.pas
View File

@ -242,7 +242,7 @@ type
AnAction: TDefineAction);
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
function CreateCopy(OnlyMarked: boolean = false;
WithSiblings: boolean = true;
WithChilds: boolean = true): TDefineTemplate;
@ -392,7 +392,7 @@ type
public
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
function ExtractNonAutoCreated: TDefineTemplate;
function ExtractTemplatesOwnedBy(TheOwner: TObject; const MustFlags,
NotFlags: TDefineTemplateFlags): TDefineTemplate;
@ -500,7 +500,7 @@ type
procedure Clear;
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
procedure WriteDebugReport;
end;
@ -1246,17 +1246,6 @@ begin
until false;
end;
procedure RaiseCatchableException(const Msg: string);
begin
{ Raises an exception.
gdb does not catch fpc Exception objects, therefore this procedure raises
a standard AV which is catched by gdb. }
DebugLn('ERROR in CodeTools: ',Msg);
// creates an exception, that gdb catches:
DebugLn('Creating gdb catchable error:');
if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;
destructor TDefineTemplate.Destroy;
begin
Clear(false);
@ -1521,7 +1510,7 @@ begin
end;
end;
function TDefineTemplate.ConsistencyCheck: integer;
procedure TDefineTemplate.ConsistencyCheck;
var RealChildCount: integer;
DefTempl: TDefineTemplate;
begin
@ -1530,39 +1519,30 @@ begin
if DefTempl<>nil then begin
if DefTempl.Prior<>nil then begin
// not first child
Result:=-2; exit;
RaiseCatchableException('');
end;
while DefTempl<>nil do begin
if DefTempl.Parent<>Self then begin
DebugLn(' C: DefTempl.Parent<>Self: ',Name,',',DefTempl.Name);
Result:=-3; exit;
end;
if (DefTempl.Next<>nil) and (DefTempl.Next.Prior<>DefTempl) then begin
Result:=-4; exit;
end;
if (DefTempl.Prior<>nil) and (DefTempl.Prior.Next<>DefTempl) then begin
Result:=-5; exit;
end;
Result:=DefTempl.ConsistencyCheck;
if Result<>0 then begin
dec(Result,100); exit;
RaiseCatchableException('');
end;
if (DefTempl.Next<>nil) and (DefTempl.Next.Prior<>DefTempl) then
RaiseCatchableException('');
if (DefTempl.Prior<>nil) and (DefTempl.Prior.Next<>DefTempl) then
RaiseCatchableException('');
DefTempl.ConsistencyCheck;
DefTempl:=DefTempl.Next;
inc(RealChildCount);
end;
end;
if (Parent<>nil) then begin
if (Prior=nil) and (Parent.FirstChild<>Self) then begin
Result:=-6; exit;
end;
if (Next=nil) and (Parent.LastChild<>Self) then begin
Result:=-7; exit;
end;
if (Prior=nil) and (Parent.FirstChild<>Self) then
RaiseCatchableException('');
if (Next=nil) and (Parent.LastChild<>Self) then
RaiseCatchableException('');
end;
if RealChildCount<>FChildCount then begin
Result:=-1; exit;
end;
Result:=0;
if RealChildCount<>FChildCount then
RaiseCatchableException('');
end;
procedure TDefineTemplate.SetDefineOwner(NewOwner: TObject;
@ -1605,7 +1585,6 @@ procedure TDefineTemplate.WriteDebugReport(OnlyMarked: boolean);
ActionStr:=DefineActionNames[ANode.Action];
DebugLn(Prefix+'Self='+DbgS(ANode),
' Name="'+ANode.Name,'"',
' Consistency='+dbgs(ANode.ConsistencyCheck),
' Next='+DbgS(ANode.Next),
' Prior='+DbgS(ANode.Prior),
' Action='+ActionStr,
@ -2752,30 +2731,27 @@ begin
ClearCache;
end;
function TDefineTree.ConsistencyCheck: integer;
procedure TDefineTree.ConsistencyCheck;
var
CurResult: LongInt;
begin
if FFirstDefineTemplate<>nil then begin
Result:=FFirstDefineTemplate.ConsistencyCheck;
if Result<>0 then begin
dec(Result,1000); exit;
end;
end;
Result:=FCache.ConsistencyCheck;
if Result<>0 then begin
dec(Result,2000); exit;
end;
Result:=0;
if FFirstDefineTemplate<>nil then
FFirstDefineTemplate.ConsistencyCheck;
CurResult:=FCache.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
end;
procedure TDefineTree.WriteDebugReport;
begin
DebugLn('TDefineTree.WriteDebugReport Consistency=',dbgs(ConsistencyCheck));
DebugLn('TDefineTree.WriteDebugReport');
if FFirstDefineTemplate<>nil then
FFirstDefineTemplate.WriteDebugReport(false)
else
DebugLn(' No templates defined');
DebugLn(FCache.ReportAsString);
DebugLn('');
ConsistencyCheck;
end;
@ -4889,25 +4865,20 @@ begin
Result.SetDefineOwner(Owner,true);
end;
function TDefinePool.ConsistencyCheck: integer;
procedure TDefinePool.ConsistencyCheck;
var i: integer;
begin
for i:=0 to Count-1 do begin
Result:=Items[i].ConsistencyCheck;
if Result<>0 then begin
dec(Result,100); exit;
end;
end;
Result:=0;
for i:=0 to Count-1 do
Items[i].ConsistencyCheck;
end;
procedure TDefinePool.WriteDebugReport;
var i: integer;
begin
DebugLn('TDefinePool.WriteDebugReport Consistency=',dbgs(ConsistencyCheck));
for i:=0 to Count-1 do begin
DebugLn('TDefinePool.WriteDebugReport');
for i:=0 to Count-1 do
Items[i].WriteDebugReport(false);
end;
ConsistencyCheck;
end;

172
components/codetools/expreval.pas
View File

@ -41,11 +41,14 @@ const
type
TOnValuesChanged = procedure of object;
ArrayOfAnsiString = {$IFDEF FPC}^{$ELSE}array of {$ENDIF}AnsiString;
ArrayOfAnsiString = ^AnsiString;
{ TExpressionEvaluator }
TExpressionEvaluator = class
private
FChangeStamp: integer;
FNames, FValues: ArrayOfAnsiString; // always sorted in FNames and FNames uppercase
FCount: integer;
FCapacity: integer;
@ -59,7 +62,7 @@ type
function CompareValues(const v1, v2: string): integer;
function GetVariables(const Name: string): string;
procedure SetVariables(const Name: string; const Value: string);
function IndexOfName(const VarName: string): integer;
function IndexOfName(const VarName: string; InsertPos: boolean): integer;
procedure Expand;
public
property Variables[const Name: string]: string
@ -82,8 +85,10 @@ type
function AsString: string;
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure ConsistencyCheck;
procedure WriteDebugReport;
property ChangeStamp: integer read FChangeStamp;
procedure IncreaseChangeStamp; inline;
end;
{ TExpressionSolver
@ -125,10 +130,12 @@ end;
procedure TExpressionEvaluator.Clear;
var i: integer;
begin
if FCount=0 then exit;
for i:=0 to FCount-1 do begin
FNames[i]:='';
FValues[i]:='';
end;
FCount:=0;
if FNames<>nil then begin
FreeMem(FNames);
FNames:=nil;
@ -137,8 +144,8 @@ begin
FreeMem(FValues);
FValues:=nil;
end;
FCount:=0;
FCapacity:=0;
IncreaseChangeStamp;
end;
function TExpressionEvaluator.CompareValues(const v1, v2: string): integer;
@ -454,30 +461,17 @@ begin
end;
procedure TExpressionEvaluator.Expand;
var i, NewCapacity, NewSize: integer;
NewValues, NewNames: ArrayOfAnsiString;
var
NewSize: integer;
begin
NewCapacity:=(FCapacity shl 1)+10;
NewSize:=SizeOf(AnsiString)*NewCapacity;
GetMem(NewValues,NewSize);
GetMem(NewNames,NewSize);
FillChar(Pointer(NewValues)^,NewSize,0);
FillChar(Pointer(NewNames)^,NewSize,0);
for i:=0 to FCount-1 do begin
NewValues[i]:=FValues[i];
FValues[i]:='';
NewNames[i]:=FNames[i];
FNames[i]:='';
end;
if FValues<>nil then FreeMem(FValues);
if FNames<>nil then FreeMem(FNames);
FValues:=NewValues;
FNames:=NewNames;
FCapacity:=NewCapacity;
FCapacity:=(FCapacity shl 1)+10;
NewSize:=SizeOf(AnsiString)*FCapacity;
ReAllocMem(FValues,NewSize);
ReAllocMem(FNames,NewSize);
end;
function TExpressionEvaluator.IndexOfName(
const VarName: string): integer;
const VarName: string; InsertPos: boolean): integer;
var l,r,m, cmp: integer;
begin
if FCount=0 then begin
@ -494,18 +488,24 @@ begin
l:=m+1
else if cmp<0 then
r:=m-1
else
break;
else begin
Result:=m;
exit;
end;
end;
if InsertPos then begin
if CompareText(VarName,FNames[m])>0 then inc(m);
Result:=m;
end else begin
Result:=-1;
end;
if CompareText(VarName,FNames[m])>0 then inc(m);
Result:=m;
end;
function TExpressionEvaluator.GetVariables(const Name: string): string;
var i: integer;
begin
i:=IndexOfName(Name);
if (i>=0) and (i<FCount) and (CompareText(FNames[i],Name)=0) then
i:=IndexOfName(Name,false);
if (i>=0) then
Result:=FValues[i]
else
Result:='';
@ -514,8 +514,8 @@ end;
function TExpressionEvaluator.IsDefined(const Name: string): boolean;
var i: integer;
begin
i:=IndexOfName(Name);
Result:=(i>=0) and (i<FCount) and (CompareText(FNames[i],Name)=0);
i:=IndexOfName(Name,false);
Result:=(i>=0);
end;
function TExpressionEvaluator.ReadNextAtom: boolean;
@ -619,44 +619,55 @@ begin
FNames[i]:=SourceExpressionEvaluator.FNames[i];
FValues[i]:=SourceExpressionEvaluator.FValues[i];
end;
IncreaseChangeStamp;
end;
if Assigned(FOnChange) then FOnChange;
end;
procedure TExpressionEvaluator.SetVariables(const Name: string;
const Value: string);
var i, j: integer;
var i: integer;
Size: Integer;
begin
i:=IndexOfName(Name);
if (i>=0) and (i<FCount) and (CompareText(FNames[i],Name)=0) then
i:=IndexOfName(Name,true);
if (i>=0) and (i<FCount) and (CompareText(FNames[i],Name)=0) then begin
// variable already exists -> replace value
FValues[i]:=Value
else begin
if FValues[i]<>Value then begin
FValues[i]:=Value;
IncreaseChangeStamp;
end;
end else begin
// new variable
if FCount=FCapacity then Expand;
if i<0 then i:=0;
for j:=FCount downto i+1 do begin
FNames[j]:=FNames[j-1];
FValues[j]:=FValues[j-1];
if i<FCount then begin
Size:=SizeOf(AnsiString)*(FCount-i);
System.Move(PPointer(FNames)[i],PPointer(FNames)[i+1],Size);
System.Move(PPointer(FValues)[i],PPointer(FValues)[i+1],Size);
end;
PPointer(FNames)[i]:=nil;
PPointer(FValues)[i]:=nil;
FNames[i]:=UpperCaseStr(Name);
FValues[i]:=Value;
inc(FCount);
IncreaseChangeStamp;
end;
end;
procedure TExpressionEvaluator.Undefine(const Name: string);
var i, j: integer;
var i: integer;
Size: Integer;
begin
i:=IndexOfName(Name);
if (i>=0) and (i<FCount) and (CompareText(FNames[i],Name)=0) then begin
for j:=i to FCount-2 do begin
FNames[j]:=FNames[j+1];
FValues[j]:=FValues[j+1];
end;
i:=IndexOfName(Name,false);
if (i>=0) then begin
FNames[i]:='';
FValues[i]:='';
dec(FCount);
FNames[FCount]:='';
FValues[FCount]:='';
if FCount>i then begin
Size:=SizeOf(AnsiString)*(FCount-i);
System.Move(PPointer(FNames)[i+1],PPointer(FNames)[i],Size);
System.Move(PPointer(FValues)[i+1],PPointer(FValues)[i],Size);
end;
end;
end;
@ -712,51 +723,42 @@ begin
end;
end;
function TExpressionEvaluator.ConsistencyCheck: integer;
procedure TExpressionEvaluator.ConsistencyCheck;
// 0 = ok
var i: integer;
begin
if FCapacity<0 then begin
Result:=-1; exit;
end;
if FCapacity<FCount then begin
Result:=-2; exit;
end;
if FCount<0 then begin
Result:=-3; exit;
end;
if (FCapacity=0) and (FNames<>nil) then begin
Result:=-4; exit;
end;
if (FNames=nil) xor (FValues=nil) then begin
Result:=-5; exit;
end;
if FCapacity<0 then
RaiseCatchableException('');
if FCapacity<FCount then
RaiseCatchableException('');
if FCount<0 then
RaiseCatchableException('');
if (FCapacity=0) and (FNames<>nil) then
RaiseCatchableException('');
if (FNames=nil) xor (FValues=nil) then
RaiseCatchableException('');
for i:=0 to FCount-1 do begin
if not IsUpperCaseStr(FNames[i]) then begin
Result:=-6; exit;
end;
if (i>0) and (FNames[i-1]=FNames[i]) then begin
Result:=-7; exit;
end;
if (i>0) and (AnsiCompareStr(FNames[i-1],FNames[i])>0) then begin
Result:=-8; exit;
end;
if not IsUpperCaseStr(FNames[i]) then
RaiseCatchableException('');
if (i>0) and (FNames[i-1]=FNames[i]) then
RaiseCatchableException('');
if (i>0) and (CompareText(FNames[i-1],FNames[i])>0) then
RaiseCatchableException('');
end;
for i:=FCount to FCapacity-1 do begin
if (FNames[i]<>'') then begin
Result:=-9; exit;
end;
if (FValues[i]<>'') then begin
Result:=-10; exit;
end;
end;
Result:=0;
end;
procedure TExpressionEvaluator.WriteDebugReport;
begin
DebugLn('[TExpressionEvaluator.WriteDebugReport] Consistency=',
dbgs(ConsistencyCheck));
DebugLn('[TExpressionEvaluator.WriteDebugReport] ');
ConsistencyCheck;
end;
procedure TExpressionEvaluator.IncreaseChangeStamp;
begin
if FChangeStamp<High(Integer) then
inc(FChangeStamp)
else
FChangeStamp:=Low(Integer);
end;

16
components/codetools/fileprocs.pas
View File

@ -351,6 +351,11 @@ function ParamStrUTF8(Param: Integer): string;
function GetEnvironmentStringUTF8(Index : Integer): String;
function GetEnvironmentVariableUTF8(const EnvVar: String): String;
// other useful stuff
procedure RaiseCatchableException(const Msg: string);
implementation
// to get more detailed error messages consider the os
@ -364,6 +369,17 @@ uses
Unix, BaseUnix;
{$ENDIF}
procedure RaiseCatchableException(const Msg: string);
begin
{ Raises an exception.
gdb does not catch fpc Exception objects, therefore this procedure raises
a standard AV which is catched by gdb. }
DebugLn('ERROR in CodeTools: ',Msg);
// creates an exception, that gdb catches:
DebugLn('Creating gdb catchable error:');
if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;
var
LineInfoCache: TAVLTree = nil;
LastTick: int64 = 0;

33
components/codetools/linkscanner.pas
View File

@ -408,7 +408,7 @@ type
property ScanTill: TLinkScannerRange read FScanTill write SetScanTill;
procedure Clear;
function ConsistencyCheck: integer;
procedure ConsistencyCheck;
procedure WriteDebugReport;
constructor Create;
destructor Destroy; override;
@ -1357,32 +1357,23 @@ begin
end;
end;
function TLinkScanner.ConsistencyCheck: integer;
procedure TLinkScanner.ConsistencyCheck;
var i: integer;
begin
if (FLinks=nil) xor (FLinkCapacity=0) then begin
Result:=-1; exit;
end;
if (FLinks=nil) xor (FLinkCapacity=0) then
RaiseCatchableException('');
if FLinks<>nil then begin
for i:=0 to FLinkCount-1 do begin
if FLinks[i].Code=nil then begin
Result:=-2; exit;
end;
if (FLinks[i].CleanedPos<1) or (FLinks[i].CleanedPos>SrcLen) then begin
Result:=-3; exit;
end;
if FLinks[i].Code=nil then
RaiseCatchableException('');
if (FLinks[i].CleanedPos<1) or (FLinks[i].CleanedPos>SrcLen) then
RaiseCatchableException('');
end;
end;
if SrcLen<>length(Src) then begin // length of current source
Result:=-4; exit;
end;
if Values<>nil then begin
Result:=Values.ConsistencyCheck;
if Result<>0 then begin
dec(Result,10); exit;
end;
end;
Result:=0;
if SrcLen<>length(Src) then
RaiseCatchableException('');
if Values<>nil then
Values.ConsistencyCheck;
end;
procedure TLinkScanner.WriteDebugReport;

32
components/codetools/sourcechanger.pas
View File

@ -134,7 +134,7 @@ type
function BeautifyWord(const AWord: string; WordPolicy: TWordPolicy): string;
function BeautifyKeyWord(const AWord: string): string;
function BeautifyIdentifier(const AWord: string): string;
function ConsistencyCheck: integer;
procedure ConsistencyCheck;
procedure WriteDebugReport;
constructor Create;
end;
@ -217,7 +217,7 @@ type
property OnAfterApplyChanges: TOnAfterApplyChanges
read FOnAfterApplyChanges write FOnAfterApplyChanges;
procedure Clear;
function ConsistencyCheck: integer;
procedure ConsistencyCheck;
procedure WriteDebugReport;
constructor Create;
destructor Destroy; override;
@ -600,25 +600,22 @@ begin
FBuffersToModifyNeedsUpdate:=true;
end;
function TSourceChangeCache.ConsistencyCheck: integer;
procedure TSourceChangeCache.ConsistencyCheck;
var
CurResult: LongInt;
begin
Result:=FEntries.ConsistencyCheck;
if Result<>0 then begin
dec(Result,100); exit;
end;
Result:=BeautifyCodeOptions.ConsistencyCheck;
if Result<>0 then begin
dec(Result,200); exit;
end;
Result:=0;
CurResult:=FEntries.ConsistencyCheck;
if CurResult<>0 then
RaiseCatchableException(IntToStr(CurResult));
BeautifyCodeOptions.ConsistencyCheck;
end;
procedure TSourceChangeCache.WriteDebugReport;
begin
DebugLn('[TSourceChangeCache.WriteDebugReport] Consistency=',
dbgs(ConsistencyCheck));
DebugLn('[TSourceChangeCache.WriteDebugReport]');
DebugLn(FEntries.ReportAsString);
BeautifyCodeOptions.WriteDebugReport;
ConsistencyCheck;
end;
function TSourceChangeCache.Apply: boolean;
@ -1459,15 +1456,14 @@ begin
Result:=BeautifyWord(AWord,IdentifierPolicy);
end;
function TBeautifyCodeOptions.ConsistencyCheck: integer;
procedure TBeautifyCodeOptions.ConsistencyCheck;
begin
Result:=0;
end;
procedure TBeautifyCodeOptions.WriteDebugReport;
begin
DebugLn('TBeautifyCodeOptions.WriteDebugReport Consistency=',
dbgs(ConsistencyCheck));
DebugLn('TBeautifyCodeOptions.WriteDebugReport');
ConsistencyCheck;
end;
{ ESourceChangeCacheError }

595
components/jcf2/CommandLine/Lazarus/jcf.lpi
View File

File diff suppressed because it is too large Load Diff