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

MG: fixed finddeclaration IsCompatible for nodes

Browse Source 
git-svn-id: trunk@3266 -
This commit is contained in:
lazarus 2002-08-30 14:59:14 +00:00
parent 9caac69e35
commit 5d5f7d7b6e
2 changed files with 30 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/codetools/eventcodetool.pas
View File

@ -35,6 +35,7 @@ interface
{$I codetools.inc}
{$DEFINE CTDEBUG}
{ $DEFINE ShowAllProcs}
uses
{$IFDEF MEM_CHECK}
@ -678,15 +679,10 @@ var
ParamCompatibility: TTypeCompatibility;
FirstParameterNode: TCodeTreeNode;
begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CollectPublishedMethods] A ',
' Node=',FoundContext.Node.DescAsString,
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
' Tool=',FoundContext.Tool.MainFilename);
{$ENDIF}
if (FoundContext.Node.Desc=ctnProcedure) then begin
{$IFDEF CTDEBUG}
writeln('[TEventsCodeTool.CollectPublishedMethods] B ',
{$IFDEF ShowAllProcs}
writeln('');
writeln('[TEventsCodeTool.CollectPublishedMethods] A ',
' Node=',FoundContext.Node.DescAsString,
' "',copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50),'"',
' Tool=',FoundContext.Tool.MainFilename);
@ -697,10 +693,11 @@ begin
FirstParameterNode,
SearchedExprList,false,
Params,SearchedCompatibilityList);
if ParamCompatibility=tcExact then begin
{$IFDEF CTDEBUG}
writeln('ParamCompatibility=',TypeCompatibilityNames[ParamCompatibility]);
{$IFDEF ShowAllProcs}
writeln('[TEventsCodeTool.CollectPublishedMethods] A',
' ParamCompatibility=',TypeCompatibilityNames[ParamCompatibility]);
{$ENDIF}
if ParamCompatibility=tcExact then begin
// ToDo: ppu, ppw, dcu

42
components/codetools/finddeclarationtool.pas
View File

@ -4198,31 +4198,33 @@ begin
Include(Params.Flags,fdfExceptionOnNotFound);
TargetContext:=FindBaseTypeOfNode(Params,TargetNode);
Params.Flags:=OldInput.Flags;
if (TargetContext.Node.Desc=ctnSetType) then begin
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.IsCompatible] TargetContext.Node.Desc=ctnSetType',
' "',copy(TargetContext.Tool.Src,TargetContext.Node.Parent.StartPos,20),'"');
{$ENDIF}
if (ExpressionType.Desc<>xtConstSet) then
exit;
// both are sets, compare type of sets
if (ExpressionType.SubDesc<>xtNone) then begin
// ToDo: check if enums of expression fits into enums of target
// ToDo: ppu, ppw, dcu
Result:=tcCompatible;
end else
// the empty set is compatible to all kinds of sets
Result:=tcExact;
exit;
end;
// compare node base type and ExpressionType
if (ExpressionType.Context.Node<>nil)
and (ExpressionType.Context.Node=TargetContext.Node) then begin
// same base type
Result:=tcExact;
end
else if (TargetContext.Node.Desc=ctnSetType) then begin
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.IsCompatible] TargetContext.Node.Desc=ctnSetType',
' "',copy(TargetContext.Tool.Src,TargetContext.Node.Parent.StartPos,20),'"');
{$ENDIF}
if (ExpressionType.Desc=xtConstSet) then begin
// both are sets, compare type of sets
if (ExpressionType.SubDesc<>xtNone) then begin
// ToDo: check if enums of expression fits into enums of target
// ToDo: ppu, ppw, dcu
Result:=tcCompatible;
end else
// the empty set is compatible to all kinds of sets
Result:=tcExact;
end else begin
end;
end else begin
NodeExprType:=CleanExpressionType;
NodeExprType.Desc:=xtContext;