paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 05:02:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: find declaration: fixed constructor result type, fixed param compatiblity for convertable

Browse Source 
git-svn-id: trunk@30737 -
This commit is contained in:
mattias 2011-05-15 07:56:50 +00:00
parent 82db7036c2
commit 83bf96457b
5 changed files with 46 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/codetree.pas
View File

@ -81,6 +81,7 @@ const
ctnConstDefinition = 22;
ctnGlobalProperty = 23;
ctnUseUnit = 24;
ctnVarArgs = 25;
ctnClass = 30;
ctnClassInterface = 31;
@ -388,6 +389,7 @@ begin
ctnConstDefinition: Result:='Const';
ctnGlobalProperty: Result:='Global Property';
ctnUseUnit: Result:='use unit';
ctnVarArgs: Result:='VarArgs';
ctnProperty: Result:='Property'; // can start with 'class property'
ctnMethodMap: Result:='Method Map';

27
components/codetools/finddeclarationtool.pas
View File

@ -369,8 +369,8 @@ type
//----------------------------------------------------------------------------
// TTypeCompatibility is the result of a compatibility check
TTypeCompatibility = (
tcExact, // exactly same type
tcCompatible, // type can be auto converted
tcExact, // exactly same type, can be used for var parameters
tcCompatible, // type can be auto converted, can not be used for var parameters
tcIncompatible // type is incompatible
);
TTypeCompatibilityList = ^TTypeCompatibility;
@ -6708,14 +6708,15 @@ var
// search ...
Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
{$IFDEF ShowExprEval}
DebugLn([' ResolveIdentifier Ident="',GetIdentifier(Params.Identifier),'" ContextNode="',Params.ContextNode.DescAsString,'" "',dbgstr(copy(ExprType.Context.Tool.Src,Params.ContextNode.StartPos,15)),'" ',dbgs(Params.Flags)]);
DebugLn([' ResolveIdentifier SubIdent="',GetIdentifier(Params.Identifier),'" ContextNode="',Params.ContextNode.DescAsString,'" "',dbgstr(copy(ExprType.Context.Tool.Src,Params.ContextNode.StartPos,15)),'" ',dbgs(Params.Flags)]);
{$ENDIF}
if ExprType.Context.Tool.FindIdentifierInContext(Params) then begin
if not Params.NewCodeTool.NodeIsConstructor(Params.NewNode) then begin
if IsIdentifierEndOfVariable and (fdfFunctionResult in StartFlags)
and Params.NewCodeTool.NodeIsConstructor(Params.NewNode) then begin
// it's a constructor -> keep the class
end else begin
ExprType.Desc:=xtContext;
ExprType.Context:=CreateFindContext(Params);
end else begin
// it's a constructor -> keep the class
end;
Params.Load(OldInput,true);
end else begin
@ -7732,11 +7733,13 @@ begin
{$ENDIF}
if CompatibilityList<>nil then
CompatibilityList[i]:=ParamCompatibility;
if ParamCompatibility=tcIncompatible then begin
if (ParamCompatibility=tcIncompatible)
or ((ParamCompatibility=tcCompatible)
and MoveCursorToParameterSpecifier(ParamNode)
and (UpAtomIs('VAR') or UpAtomIs('OUT') or UpAtomIs('CONSTREF')))
then begin
Result:=tcIncompatible;
exit;
end else if ParamCompatibility=tcCompatible then begin
Result:=tcCompatible;
end;
ParamNode:=ParamNode.NextBrother;
inc(i);
@ -8477,7 +8480,7 @@ function TFindDeclarationTool.IsBaseCompatible(const TargetType,
var TargetNode, ExprNode: TCodeTreeNode;
begin
{$IFDEF ShowExprEval}
DebugLn('[TFindDeclarationTool.IsBaseCompatible] B ',
DebugLn('[TFindDeclarationTool.IsBaseCompatible] START ',
' TargetType=',ExprTypeToString(TargetType),
' ExpressionType=',ExprTypeToString(ExpressionType));
{$ENDIF}
@ -8512,11 +8515,11 @@ begin
ctnClass, ctnClassInterface, ctnDispinterface, ctnObject, ctnRecordType,
ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
// check, if ExpressionType.Context is descend of TargetContext
// check, if ExpressionType.Context descends from TargetContext
if ContextIsDescendOf(ExpressionType.Context,
TargetType.Context,Params)
then
Result:=tcCompatible;
Result:=tcExact;
ctnRangedArrayType,ctnOpenArrayType:
// ToDo: check range and type of arrayfields

4
components/codetools/ide/declarevardlg.pas
View File

@ -136,6 +136,9 @@ begin
exit;
end;
// ToDo: check if in a comment
// ToDo: check context
// examples:
// identifier:=<something>
@ -143,6 +146,7 @@ begin
// <something>:=aclass.identifier
// <something>:=<something>+aclass.identifier
// <proc>(,,aclass.identifier)
// for identifier in <something>
// ToDo: check where the identifier is already defined
// ToDo: check if the identifier is a sub identifier (e.g. A.identifier)

11
components/codetools/pascalparsertool.pas
View File

@ -1170,7 +1170,6 @@ function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
procedure MacProcName(c: char; ...); external;
}
var CloseBracket: char;
Desc: TCodeTreeNodeDesc;
Node: TCodeTreeNode;
procedure ReadPrefixModifier;
@ -1179,13 +1178,11 @@ var CloseBracket: char;
if UpAtomIs('VAR') or UpAtomIs('CONST') or UpAtomIs('CONSTREF')
or (UpAtomIs('OUT') and (Scanner.CompilerMode in [cmOBJFPC,cmDELPHI,cmFPC]))
then begin
Desc:=ctnVarDefinition;
if not Extract then
ReadNextAtom
else
ExtractNextAtom(phpWithVarModifiers in Attr,Attr);
end else
Desc:=ctnVarDefinition;
end;
end;
procedure ReadDefaultValue;
@ -1235,6 +1232,10 @@ begin
else
exit;
end;
CreateChildNode;
CurNode.Desc:=ctnVarArgs;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
// parse end of parameter list
if (CurPos.StartPos>SrcLen)
@ -1250,7 +1251,7 @@ begin
if not AtomIsIdentifier(ExceptionOnError) then exit;
if (phpCreateNodes in Attr) then begin
CreateChildNode;
CurNode.Desc:=Desc;
CurNode.Desc:=ctnVarDefinition;
end;
if not Extract then
ReadNextAtom

25
components/codetools/pascalreadertool.pas
View File

@ -184,6 +184,7 @@ type
CleanPos: integer): boolean;
function MoveCursorToParameterSpecifier(DefinitionNode: TCodeTreeNode
): boolean;
function GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
function FindEndOfWithVar(WithVarNode: TCodeTreeNode): integer;
function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
function NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
@ -2055,12 +2056,11 @@ function TPascalReaderTool.MoveCursorToParameterSpecifier(
DefinitionNode: TCodeTreeNode): boolean;
begin
Result:=false;
if (DefinitionNode=nil) or (DefinitionNode.Parent=nil)
or (DefinitionNode.Parent.Desc<>ctnProcedureHead) then exit;
if (DefinitionNode=nil) or (DefinitionNode.Desc<>ctnVarDefinition)
or (DefinitionNode.Parent=nil)
or (DefinitionNode.Parent.Desc<>ctnParameterList) then exit;
// find first variable node of this type (e.g. var a,b,c,d: integer)
while (DefinitionNode.PriorBrother<>nil)
and (DefinitionNode.PriorBrother.FirstChild=nil) do
DefinitionNode:=DefinitionNode.PriorBrother;
DefinitionNode:=GetFirstGroupVarNode(DefinitionNode);
if DefinitionNode.PriorBrother<>nil then
MoveCursorToCleanPos(DefinitionNode.PriorBrother.EndPos)
else
@ -2068,7 +2068,20 @@ begin
ReadNextAtom;
while (CurPos.StartPos<DefinitionNode.StartPos) do ReadNextAtom;
UndoReadNextAtom;
Result:=UpAtomIs('CONST') or UpAtomIs('VAR') or UpAtomIs('OUT');
Result:=CurPos.Flag=cafWord;
end;
function TPascalReaderTool.GetFirstGroupVarNode(VarNode: TCodeTreeNode
): TCodeTreeNode;
begin
Result:=VarNode;
if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition) then exit;
while VarNode<>nil do begin
VarNode:=VarNode.PriorBrother;
if (VarNode=nil) or (VarNode.Desc<>ctnVarDefinition)
or (VarNode.FirstChild<>nil) then exit;
Result:=VarNode;
end;
end;
function TPascalReaderTool.FindEndOfWithVar(WithVarNode: TCodeTreeNode