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

MG: reduced output

Browse Source 
git-svn-id: trunk@1601 -
This commit is contained in:
lazarus 2002-04-11 08:20:14 +00:00
parent 9b66e0abc7
commit 41d00f60e4
1 changed files with 58 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
components/codetools/finddeclarationtool.pas
View File

@ -1596,7 +1596,7 @@ var CurAtom, NextAtom: TAtomPosition;
Result:=false; Result:=false;
end; end;
procedure ResolveIdentifier; procedure ResolveIdentifier(var AFindContext: TFindContext);
begin begin
// for example 'AnObject[3]' // for example 'AnObject[3]'
@ -1610,7 +1610,7 @@ var CurAtom, NextAtom: TAtomPosition;
end; end;
// check special identifiers 'Result' and 'Self' // check special identifiers 'Result' and 'Self'
if (Result.Node=Params.ContextNode) then begin if (AFindContext.Node=Params.ContextNode) then begin
if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
// SELF in a method is the object itself // SELF in a method is the object itself
// -> check if in a proc // -> check if in a proc
@ -1618,8 +1618,9 @@ var CurAtom, NextAtom: TAtomPosition;
while (ProcNode<>nil) do begin while (ProcNode<>nil) do begin
if (ProcNode.Desc=ctnProcedure) then begin if (ProcNode.Desc=ctnProcedure) then begin
// in a proc -> find the class context // in a proc -> find the class context
if Result.Tool.FindClassOfMethod(ProcNode,Params,true) then begin if AFindContext.Tool.FindClassOfMethod(ProcNode,Params,true) then
Result:=CreateFindContext(Params); begin
AFindContext:=CreateFindContext(Params);
exit; exit;
end; end;
end; end;
@ -1633,7 +1634,7 @@ var CurAtom, NextAtom: TAtomPosition;
if (ProcNode.Desc=ctnProcedure) then begin if (ProcNode.Desc=ctnProcedure) then begin
Params.Save(OldInput); Params.Save(OldInput);
Include(Params.Flags,fdfFunctionResult); Include(Params.Flags,fdfFunctionResult);
Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode); AFindContext:=AFindContext.Tool.FindBaseTypeOfNode(Params,ProcNode);
Params.Load(OldInput); Params.Load(OldInput);
exit; exit;
end; end;
@ -1646,14 +1647,15 @@ var CurAtom, NextAtom: TAtomPosition;
if (NextAtomType in [atSpace]) if (NextAtomType in [atSpace])
and CompareSrcIdentifier(CurAtom.StartPos,'FREE') and CompareSrcIdentifier(CurAtom.StartPos,'FREE')
and ((Result.Node.Desc=ctnClass) or NodeIsInAMethod(Result.Node)) then and ((AFindContext.Node.Desc=ctnClass)
or NodeIsInAMethod(AFindContext.Node)) then
begin begin
// FREE calls the destructor of an object // FREE calls the destructor of an object
Params.Save(OldInput); Params.Save(OldInput);
Params.SetIdentifier(Self,'DESTRUCTOR',nil); Params.SetIdentifier(Self,'DESTRUCTOR',nil);
Exclude(Params.Flags,fdfExceptionOnNotFound); Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Tool.FindIdentifierInContext(Params) then begin if AFindContext.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params); AFindContext:=CreateFindContext(Params);
exit; exit;
end; end;
Params.Load(OldInput); Params.Load(OldInput);
@ -1667,19 +1669,19 @@ var CurAtom, NextAtom: TAtomPosition;
+(fdfGlobals*Params.Flags); +(fdfGlobals*Params.Flags);
if CurAtomType=atPreDefIdentifier then if CurAtomType=atPreDefIdentifier then
Exclude(Params.Flags,fdfExceptionOnNotFound); Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Node=Params.ContextNode then begin if AFindContext.Node=Params.ContextNode then begin
// there is no special context -> also search in parent contexts // there is no special context -> also search in parent contexts
Params.Flags:=Params.Flags Params.Flags:=Params.Flags
+[fdfSearchInParentNodes,fdfIgnoreCurContextNode]; +[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
end else end else
// special context // special context
Params.ContextNode:=Result.Node; Params.ContextNode:=AFindContext.Node;
Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier); Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
if Result.Tool.FindIdentifierInContext(Params) then begin if AFindContext.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params); AFindContext:=CreateFindContext(Params);
end else begin end else begin
// predefined identifier not redefined // predefined identifier not redefined
Result:=CreateFindContext(Self,nil); AFindContext:=CreateFindContext(Self,nil);
end; end;
// ToDo: check if identifier in 'Protected' section // ToDo: check if identifier in 'Protected' section
@ -1689,10 +1691,11 @@ var CurAtom, NextAtom: TAtomPosition;
end; end;
// find base type // find base type
if Result.Node<>nil then begin if AFindContext.Node<>nil then begin
if (Result.Node<>nil) if (AFindContext.Node<>nil)
and (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin and (AFindContext.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin
Result.Tool.BuildSubTreeForProcHead(Result.Node,FuncResultNode); AFindContext.Tool.BuildSubTreeForProcHead(AFindContext.Node,
FuncResultNode);
if FuncResultNode<>nil then begin if FuncResultNode<>nil then begin
// this is function // this is function
if (NextAtomType in [atSpace,atNone,atRoundBracketClose, if (NextAtomType in [atSpace,atNone,atRoundBracketClose,
@ -1711,14 +1714,15 @@ var CurAtom, NextAtom: TAtomPosition;
Include(Params.Flags,fdfFunctionResult); Include(Params.Flags,fdfFunctionResult);
end; end;
end; end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node); AFindContext:=AFindContext.Tool.FindBaseTypeOfNode(Params,
AFindContext.Node);
end; end;
end; end;
procedure ResolvePoint; procedure ResolvePoint(var AFindContext: TFindContext);
begin begin
// for example 'A.B' // for example 'A.B'
if Result.Node=Params.ContextNode then begin if AFindContext.Node=Params.ContextNode then begin
MoveCursorToCleanPos(CurAtom.StartPos); MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,'.']); RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,'.']);
end; end;
@ -1728,12 +1732,12 @@ var CurAtom, NextAtom: TAtomPosition;
ReadNextAtom; ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]); RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end; end;
if (Result.Node.Desc in AllUsableSourceTypes) then begin if (AFindContext.Node.Desc in AllUsableSourceTypes) then begin
// identifier in front of the point is a unit name // identifier in front of the point is a unit name
if Result.Tool<>Self then begin if AFindContext.Tool<>Self then begin
Result.Node:=Result.Tool.GetInterfaceNode; AFindContext.Node:=AFindContext.Tool.GetInterfaceNode;
end else begin end else begin
Result:=CreateFindContext(Self,Params.ContextNode); AFindContext:=CreateFindContext(Self,Params.ContextNode);
end; end;
end; end;
// there is no special left to do, since Result already points to // there is no special left to do, since Result already points to
@ -1754,7 +1758,7 @@ var CurAtom, NextAtom: TAtomPosition;
// -> context is default context // -> context is default context
end; end;
procedure ResolveUp; procedure ResolveUp(var AFindContext: TFindContext);
begin begin
// for example: // for example:
// 1. 'PInt = ^integer' pointer type // 1. 'PInt = ^integer' pointer type
@ -1765,7 +1769,7 @@ var CurAtom, NextAtom: TAtomPosition;
ReadNextAtom; ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]); RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end; end;
if Result.Node<>Params.ContextNode then begin if AFindContext.Node<>Params.ContextNode then begin
// left side of expression has defined a special context // left side of expression has defined a special context
// => this '^' is a dereference // => this '^' is a dereference
if (not (NextAtomType in [atSpace,atPoint,atAS,atUP,atEdgedBracketOpen])) if (not (NextAtomType in [atSpace,atPoint,atAS,atUP,atEdgedBracketOpen]))
@ -1774,19 +1778,20 @@ var CurAtom, NextAtom: TAtomPosition;
ReadNextAtom; ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,['.',GetAtom]); RaiseExceptionFmt(ctsStrExpectedButAtomFound,['.',GetAtom]);
end; end;
if Result.Node.Desc<>ctnPointerType then begin if AFindContext.Node.Desc<>ctnPointerType then begin
MoveCursorToCleanPos(CurAtom.StartPos); MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsIllegalQualifier,['^']); RaiseExceptionFmt(ctsIllegalQualifier,['^']);
end; end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild); AFindContext:=AFindContext.Tool.FindBaseTypeOfNode(Params,
end else if NodeHasParentOfType(Result.Node,ctnPointerType) then begin AFindContext.Node.FirstChild);
//end else if Result.Node.Parent.Desc=ctnPointerType then begin end else if NodeHasParentOfType(AFindContext.Node,ctnPointerType) then begin
//end else if AFindContext.Node.Parent.Desc=ctnPointerType then begin
// this is a pointer type definition // this is a pointer type definition
// -> the default context is ok // -> the default context is ok
end; end;
end; end;
procedure ResolveEdgedBracketClose; procedure ResolveEdgedBracketClose(var AFindContext: TFindContext);
begin begin
{ for example: a[] { for example: a[]
this could be: this could be:
@ -1804,16 +1809,18 @@ var CurAtom, NextAtom: TAtomPosition;
ReadNextAtom; ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]); RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end; end;
if Result.Node<>Params.ContextNode then begin if AFindContext.Node<>Params.ContextNode then begin
case Result.Node.Desc of case AFindContext.Node.Desc of
ctnArrayType: ctnArrayType:
// the array type is the last child node // the array type is the last child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.LastChild); AFindContext:=AFindContext.Tool.FindBaseTypeOfNode(Params,
AFindContext.Node.LastChild);
ctnPointerType: ctnPointerType:
// the pointer type is the only child node // the pointer type is the only child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild); AFindContext:=AFindContext.Tool.FindBaseTypeOfNode(Params,
AFindContext.Node.FirstChild);
ctnClass: ctnClass:
begin begin
@ -1824,16 +1831,16 @@ var CurAtom, NextAtom: TAtomPosition;
+fdfAllClassVisibilities*Params.Flags; +fdfAllClassVisibilities*Params.Flags;
// special identifier for default property // special identifier for default property
Params.SetIdentifier(Self,'[',nil); Params.SetIdentifier(Self,'[',nil);
Params.ContextNode:=Result.Node; Params.ContextNode:=AFindContext.Node;
Result.Tool.FindIdentifierInContext(Params); AFindContext.Tool.FindIdentifierInContext(Params);
Result:=Params.NewCodeTool.FindBaseTypeOfNode( AFindContext:=Params.NewCodeTool.FindBaseTypeOfNode(
Params,Params.NewNode); Params,Params.NewNode);
Params.Load(OldInput); Params.Load(OldInput);
end; end;
ctnIdentifier: ctnIdentifier:
begin begin
MoveCursorToNodeStart(Result.Node); MoveCursorToNodeStart(AFindContext.Node);
ReadNextAtom; ReadNextAtom;
if UpAtomIs('STRING') or UpAtomIs('ANSISTRING') if UpAtomIs('STRING') or UpAtomIs('ANSISTRING')
or UpAtomIs('SHORTSTRING') then begin or UpAtomIs('SHORTSTRING') then begin
@ -1860,7 +1867,7 @@ var CurAtom, NextAtom: TAtomPosition;
end; end;
end; end;
procedure ResolveRoundBracketClose; procedure ResolveRoundBracketClose(var AFindContext: TFindContext);
begin begin
{ for example: { for example:
(a+b) expression bracket: the type is the result type of the (a+b) expression bracket: the type is the result type of the
@ -1874,7 +1881,7 @@ var CurAtom, NextAtom: TAtomPosition;
ReadNextAtom; ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]); RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end; end;
if Result.Node<>Params.ContextNode then begin if AFindContext.Node<>Params.ContextNode then begin
// typecast or function // typecast or function
end else begin end else begin
// expression // expression
@ -1888,7 +1895,7 @@ var CurAtom, NextAtom: TAtomPosition;
end; end;
end; end;
procedure ResolveINHERITED; procedure ResolveINHERITED(var AFindContext: TFindContext);
begin begin
// for example: inherited A; // for example: inherited A;
if not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier]) then if not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier]) then
@ -1904,7 +1911,7 @@ var CurAtom, NextAtom: TAtomPosition;
// searching in the ancestor // searching in the ancestor
// find ancestor of class of method // find ancestor of class of method
ProcNode:=Result.Node; ProcNode:=AFindContext.Node;
while (ProcNode<>nil) do begin while (ProcNode<>nil) do begin
if not (ProcNode.Desc in [ctnProcedure,ctnProcedureHead,ctnBeginBlock, if not (ProcNode.Desc in [ctnProcedure,ctnProcedureHead,ctnBeginBlock,
ctnAsmBlock,ctnWithVariable,ctnWithStatement,ctnCaseBlock, ctnAsmBlock,ctnWithVariable,ctnWithStatement,ctnCaseBlock,
@ -1913,10 +1920,10 @@ var CurAtom, NextAtom: TAtomPosition;
break; break;
end; end;
if ProcNode.Desc=ctnProcedure then begin if ProcNode.Desc=ctnProcedure then begin
Result.Tool.FindClassOfMethod(ProcNode,Params,true); AFindContext.Tool.FindClassOfMethod(ProcNode,Params,true);
// find class ancestor // find class ancestor
Params.NewCodeTool.FindAncestorOfClass(Params.NewNode,Params,true); Params.NewCodeTool.FindAncestorOfClass(Params.NewNode,Params,true);
Result:=CreateFindContext(Params); AFindContext:=CreateFindContext(Params);
exit; exit;
end; end;
ProcNode:=ProcNode.Parent; ProcNode:=ProcNode.Parent;
@ -1966,13 +1973,13 @@ begin
{$ENDIF} {$ENDIF}
case CurAtomType of case CurAtomType of
atIdentifier, atPreDefIdentifier: ResolveIdentifier; atIdentifier, atPreDefIdentifier: ResolveIdentifier(Result);
atPoint: ResolvePoint; atPoint: ResolvePoint(Result);
atAS: ResolveAs; atAS: ResolveAs;
atUP: ResolveUp; atUP: ResolveUp(Result);
atEdgedBracketClose: ResolveEdgedBracketClose; atEdgedBracketClose: ResolveEdgedBracketClose(Result);
atRoundBracketClose: ResolveRoundBracketClose; atRoundBracketClose: ResolveRoundBracketClose(Result);
atINHERITED: ResolveINHERITED; atINHERITED: ResolveINHERITED(Result);
else else
// expression start found // expression start found
begin begin
@ -4165,8 +4172,6 @@ end;
procedure TFindDeclarationTool.ClearNodeCaches(Force: boolean); procedure TFindDeclarationTool.ClearNodeCaches(Force: boolean);
var var
NodeCache: TCodeTreeNodeCache; NodeCache: TCodeTreeNodeCache;
GlobalWriteLockIsSet: boolean;
GlobalWriteLockStep: integer;
BaseTypeCache: TBaseTypeCache; BaseTypeCache: TBaseTypeCache;
begin begin
// check if there is something in cache to delete // check if there is something in cache to delete