From f8cac4fbb4ee1ec6a04ed2ca7dccb0920db45f0f Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 8 Jan 2004 16:13:47 +0000 Subject: [PATCH] implemented class to Pointer assignment compatibility check git-svn-id: trunk@5030 - --- components/codetools/eventcodetool.pas | 17 +- components/codetools/finddeclarationtool.pas | 162 ++++++++++++++----- ide/main.pp | 7 +- ideintf/propedits.pp | 156 +++++++++--------- 4 files changed, 218 insertions(+), 124 deletions(-) diff --git a/components/codetools/eventcodetool.pas b/components/codetools/eventcodetool.pas index 922e65096c..7e075603a1 100644 --- a/components/codetools/eventcodetool.pas +++ b/components/codetools/eventcodetool.pas @@ -434,13 +434,14 @@ begin SearchedCompatibilityList:=nil; end; try - // check for compatibility + // check if the method fits into the TypeData FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode( FoundContext.Node); - ParamCompatibility:=FoundContext.Tool.IsParamListCompatible( - FirstParameterNode, - SearchedExprList,false, - Params,SearchedCompatibilityList); + ParamCompatibility:= + FoundContext.Tool.IsParamNodeListCompatibleToExprList( + SearchedExprList, + FirstParameterNode, + Params,SearchedCompatibilityList); if ParamCompatibility=tcExact then begin MethodIsCompatible:=true; end; @@ -701,9 +702,11 @@ begin {$ENDIF} FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode( FoundContext.Node); - ParamCompatibility:=FoundContext.Tool.IsParamListCompatible( + // check if the found proc fits into + // the method mask (= current expression list) + ParamCompatibility:=FoundContext.Tool.IsParamNodeListCompatibleToExprList( + SearchedExprList, FirstParameterNode, - SearchedExprList,false, Params,SearchedCompatibilityList); {$IFDEF ShowAllProcs} writeln('[TEventsCodeTool.CollectPublishedMethods] A', diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index c760ba981f..0f02d873a0 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -309,13 +309,16 @@ const xtAllRealTypes = [xtReal, xtConstReal, xtSingle, xtDouble, xtExtended, xtCurrency, xtComp]; xtAllStringTypes = [xtConstString, xtShortString, xtString, xtAnsiString]; - xtAllStringCompatibleTypes = xtAllStringTypes+[xtChar]; xtAllWideStringTypes = [xtConstString, xtWideString]; - xtAllWideStringCompatibleTypes = xtAllWideStringTypes+[xtWideChar,xtChar]; xtAllPointerTypes = [xtPointer, xtNil]; + + xtAllStringCompatibleTypes = xtAllStringTypes+[xtChar]; + xtAllWideStringCompatibleTypes = xtAllWideStringTypes+[xtWideChar,xtChar]; + xtAllIntegerConvertibles = xtAllIntegerTypes; xtAllRealConvertibles = xtAllRealTypes+xtAllIntegerTypes; - xtAllStringConvertibles = xtAllStringTypes+[xtChar,xtPChar]; + xtAllStringConvertibles = xtAllStringCompatibleTypes+[xtPChar]; + xtAllWideStringConvertibles = xtAllWideStringCompatibleTypes+[xtPChar]; xtAllBooleanConvertibles = xtAllBooleanTypes+[xtConstBoolean]; xtAllPointerConvertibles = xtAllPointerTypes+[xtPChar]; @@ -597,12 +600,18 @@ type function GetInterfaceNode: TCodeTreeNode; function CompatibilityList1IsBetter(List1, List2: TTypeCompatibilityList; ListCount: integer): boolean; - function IsParamListCompatible(FirstParameterNode: TCodeTreeNode; - ExprParamList: TExprTypeList; IgnoreMissingParameters: boolean; + function IsParamExprListCompatibleToNodeList( + FirstTargetParameterNode: TCodeTreeNode; + SourceExprParamList: TExprTypeList; IgnoreMissingParameters: boolean; Params: TFindDeclarationParams; CompatibilityList: TTypeCompatibilityList): TTypeCompatibility; - function IsParamListCompatible(FirstParameterNode1, - FirstParameterNode2: TCodeTreeNode; + function IsParamNodeListCompatibleToExprList( + TargetExprParamList: TExprTypeList; + FirstSourceParameterNode: TCodeTreeNode; + Params: TFindDeclarationParams; + CompatibilityList: TTypeCompatibilityList): TTypeCompatibility; + function IsParamNodeListCompatibleToParamNodeList(FirstTargetParameterNode, + FirstSourceParameterNode: TCodeTreeNode; Params: TFindDeclarationParams; CompatibilityList: TTypeCompatibilityList): TTypeCompatibility; function CreateParamExprListFromStatement(StartPos: integer; @@ -4760,19 +4769,19 @@ begin Result:=RightOperand; end; -function TFindDeclarationTool.IsParamListCompatible( - FirstParameterNode: TCodeTreeNode; - ExprParamList: TExprTypeList; IgnoreMissingParameters: boolean; +function TFindDeclarationTool.IsParamExprListCompatibleToNodeList( + FirstTargetParameterNode: TCodeTreeNode; + SourceExprParamList: TExprTypeList; IgnoreMissingParameters: boolean; Params: TFindDeclarationParams; CompatibilityList: TTypeCompatibilityList): TTypeCompatibility; -// tests if ExprParamList fits into the FirstParameterNode +// tests if SourceExprParamList fits into the TargetFirstParameterNode var ParamNode: TCodeTreeNode; i, MinParamCnt, MaxParamCnt: integer; ParamCompatibility: TTypeCompatibility; begin // quick check: parameter count - ParamNode:=FirstParameterNode; + ParamNode:=FirstTargetParameterNode; MinParamCnt:=0; while (ParamNode<>nil) and ((ParamNode.SubDesc and ctnsHasDefaultValue)=0) do begin @@ -4786,28 +4795,29 @@ begin end; {$IFDEF ShowExprEval} - writeln('[TFindDeclarationTool.IsParamListCompatible] ', - ' ExprParamList.Count=',ExprParamList.Count, + writeln('[TFindDeclarationTool.IsParamExprListCompatibleToNodeList] ', + ' ExprParamList.Count=',SourceExprParamList.Count, ' MinParamCnt=',MinParamCnt,' MaxParamCnt=',MaxParamCnt ); try {$ENDIF} Result:=tcExact; - if (ExprParamlist.Count>MaxParamCnt) - or ((not IgnoreMissingParameters) and (ExprParamList.CountMaxParamCnt) + or ((not IgnoreMissingParameters) and (SourceExprParamList.Countnil) and (inil) and (inil then CompatibilityList[i]:=ParamCompatibility; @@ -4820,7 +4830,7 @@ begin ParamNode:=ParamNode.NextBrother; inc(i); end; - if (inil) then begin @@ -4842,26 +4852,95 @@ begin end; {$IFDEF ShowExprEval} finally - writeln('[TFindDeclarationTool.IsParamListCompatible] END ', + writeln('[TFindDeclarationTool.IsParamExprListCompatibleToNodeList] END ', ' Result=',TypeCompatibilityNames[Result],' ! ONLY VALID if no error !' ); end; {$ENDIF} end; -function TFindDeclarationTool.IsParamListCompatible(FirstParameterNode1, - FirstParameterNode2: TCodeTreeNode; Params: TFindDeclarationParams; +function TFindDeclarationTool.IsParamNodeListCompatibleToExprList( + TargetExprParamList: TExprTypeList; FirstSourceParameterNode: TCodeTreeNode; + Params: TFindDeclarationParams; + CompatibilityList: TTypeCompatibilityList): TTypeCompatibility; +// tests if FirstSourceParameterNode fits into the TargetExprParamList +var + ParamNode: TCodeTreeNode; + i, MinParamCnt, MaxParamCnt: integer; + ParamCompatibility: TTypeCompatibility; + SourceExprType: TExpressionType; +begin + // quick check: parameter count + + MinParamCnt:=0; + ParamNode:=FirstSourceParameterNode; + while (ParamNode<>nil) do begin + ParamNode:=ParamNode.NextBrother; + inc(MinParamCnt); + end; + MaxParamCnt:=MinParamCnt; + + {$IFDEF ShowExprEval} + writeln('[TFindDeclarationTool.IsParamNodeListCompatibleToExprList] ', + ' ExprParamList.Count=',TargetExprParamList.Count, + ' MinParamCnt=',MinParamCnt,' MaxParamCnt=',MaxParamCnt + ); + try + {$ENDIF} + Result:=tcExact; + + if (TargetExprParamList.Count<>MaxParamCnt) then begin + Result:=tcIncompatible; + exit; + end; + + // check each parameter for compatibility + ParamNode:=FirstSourceParameterNode; + i:=0; + while (ParamNode<>nil) and (inil then + CompatibilityList[i]:=ParamCompatibility; + if ParamCompatibility=tcIncompatible then begin + Result:=tcIncompatible; + exit; + end else if ParamCompatibility=tcCompatible then begin + Result:=tcCompatible; + end; + ParamNode:=ParamNode.NextBrother; + inc(i); + end; + if (ParamNode<>nil) or (inil) and (CurParamNode2<>nil) do begin CurParamNode1:=CurParamNode1.NextBrother; CurParamNode2:=CurParamNode2.NextBrother; @@ -4874,14 +4953,14 @@ begin // check each parameter OldFlags:=Params.Flags; Params.Flags:=Params.Flags-[fdfFindVariable]+[fdfIgnoreOverloadedProcs]; - CurParamNode1:=FirstParameterNode1; - CurParamNode2:=FirstParameterNode2; + CurParamNode1:=FirstTargetParameterNode; + CurParamNode2:=FirstSourceParameterNode; Result:=tcExact; i:=0; while (CurParamNode1<>nil) and (CurParamNode2<>nil) do begin - ExprType1:=ConvertNodeToExpressionType(CurParamNode1,Params); - ExprType2:=ConvertNodeToExpressionType(CurParamNode2,Params); - ParamCompatibility:=IsBaseCompatible(ExprType1,ExprType2,Params); + TargetExprType:=ConvertNodeToExpressionType(CurParamNode1,Params); + SourceExprType:=ConvertNodeToExpressionType(CurParamNode2,Params); + ParamCompatibility:=IsBaseCompatible(TargetExprType,SourceExprType,Params); if CompatibilityList<>nil then CompatibilityList[i]:=ParamCompatibility; if ParamCompatibility=tcIncompatible then begin @@ -5067,7 +5146,7 @@ begin Params.FoundProc^.Context.Node); Params.Save(OldInput); ParamCompatibility:= - Params.FoundProc^.Context.Tool.IsParamListCompatible( + Params.FoundProc^.Context.Tool.IsParamExprListCompatibleToNodeList( FirstParameterNode, Params.FoundProc^.ExprInputList, fdfIgnoreMissingParams in Params.Flags, @@ -5108,7 +5187,7 @@ begin FoundContext.Tool.GetFirstParameterNode(FoundContext.Node); Params.Save(OldInput); ParamCompatibility:= - FoundContext.Tool.IsParamListCompatible( + FoundContext.Tool.IsParamExprListCompatibleToNodeList( FirstParameterNode, Params.FoundProc^.ExprInputList, fdfIgnoreMissingParams in Params.Flags, @@ -5423,8 +5502,8 @@ var TargetNode, ExprNode: TCodeTreeNode; begin {$IFDEF ShowExprEval} writeln('[TFindDeclarationTool.IsBaseCompatible] B ', - ' TargetType=',ExpressionTypeDescNames[TargetType.Desc], - ' ExpressionType=',ExpressionTypeDescNames[ExpressionType.Desc]); + ' TargetType=',ExprTypeToString(TargetType), + ' ExpressionType=',ExprTypeToString(ExpressionType)); {$ENDIF} Result:=tcIncompatible; if (TargetType.Desc=ExpressionType.Desc) then begin @@ -5472,12 +5551,21 @@ begin Result:=tcExact; end; + end else if ((TargetType.Desc=xtPointer) + and (ExpressionType.Desc=xtContext) + and (ExpressionType.Context.Node.Desc in [ctnClass,ctnClassInterface])) + then begin + // assigning a class to a pointer + Result:=tcExact; + end else begin // check, if ExpressionType can be auto converted into TargetType if ((TargetType.Desc in xtAllRealTypes) and (ExpressionType.Desc in xtAllRealConvertibles)) or ((TargetType.Desc in xtAllStringTypes) and (ExpressionType.Desc in xtAllStringConvertibles)) + or ((TargetType.Desc in xtAllWideStringTypes) + and (ExpressionType.Desc in xtAllWideStringCompatibleTypes)) or ((TargetType.Desc in xtAllIntegerTypes) and (ExpressionType.Desc in xtAllIntegerConvertibles)) or ((TargetType.Desc in xtAllBooleanTypes) diff --git a/ide/main.pp b/ide/main.pp index 88bb008088..27787ae3e8 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -2359,7 +2359,6 @@ Begin then exit; if DoCreateProjectForProgram(PreReadBuf)=mrOk then begin - exit; end; end; @@ -4596,7 +4595,7 @@ begin // check for special files if ([ofRegularFile,ofRevert,ofProjectLoading]*Flags=[]) and FilenameIsAbsolute(AFilename) and FileExists(AFilename) then begin - // check for project information files (.lpi) + // check if file is a lazarus project (.lpi) if (CompareFileExt(AFilename,'.lpi',false)=0) then begin if MessageDlg(lisOpenProject, Format(lisOpenTheProjectAnswerNoToLoadItAsXmlFile, [AFilename, #13]), @@ -4606,6 +4605,7 @@ begin exit; end; end; + // check if file is a lazarus package (.lpi) if (CompareFileExt(AFilename,'.lpk',false)=0) then begin if MessageDlg(lisOpenPackage, Format(lisOpenThePackageAnswerNoToLoadItAsXmlFile, [AFilename, #13]), @@ -10267,6 +10267,9 @@ end. { ============================================================================= $Log$ + Revision 1.696 2004/01/08 16:13:47 mattias + implemented class to Pointer assignment compatibility check + Revision 1.695 2004/01/05 15:22:41 mattias improved debugger: saved log, error handling in initialization, better reinitialize diff --git a/ideintf/propedits.pp b/ideintf/propedits.pp index 4176f6a537..7f3d57c965 100644 --- a/ideintf/propedits.pp +++ b/ideintf/propedits.pp @@ -5069,6 +5069,84 @@ begin inherited Destroy; end; + +{ TBackupComponentList } + +function TBackupComponentList.GetComponents(Index: integer): TComponent; +begin + Result:=TComponent(FComponentList[Index]); +end; + +procedure TBackupComponentList.SetComponents(Index: integer; + const AValue: TComponent); +begin + FComponentList[Index]:=AValue; +end; + +procedure TBackupComponentList.SetLookupRoot(const AValue: TPersistent); +var + i: Integer; +begin + FLookupRoot:=AValue; + FComponentList.Clear; + if (FLookupRoot<>nil) and (FLookupRoot is TComponent) then + for i:=0 to TComponent(FLookupRoot).ComponentCount-1 do + FComponentList.Add(TComponent(FLookupRoot).Components[i]); + FSelection.Clear; +end; + +procedure TBackupComponentList.SetSelection( + const AValue: TPersistentSelectionList); +begin + if FSelection=AValue then exit; + FSelection.Assign(AValue); +end; + +constructor TBackupComponentList.Create; +begin + FSelection:=TPersistentSelectionList.Create; + FComponentList:=TList.Create; +end; + +destructor TBackupComponentList.Destroy; +begin + FreeAndNil(FSelection); + FreeAndNil(FComponentList); + inherited Destroy; +end; + +function TBackupComponentList.IndexOf(AComponent: TComponent): integer; +begin + Result:=FComponentList.IndexOf(AComponent); +end; + +procedure TBackupComponentList.Clear; +begin + LookupRoot:=nil; +end; + +function TBackupComponentList.ComponentCount: integer; +begin + Result:=FComponentList.Count; +end; + +function TBackupComponentList.IsEqual(ALookupRoot: TPersistent; + ASelection: TPersistentSelectionList): boolean; +var + i: Integer; +begin + Result:=false; + if ALookupRoot<>LookupRoot then exit; + if not FSelection.IsEqual(ASelection) then exit; + if (ALookupRoot<>nil) and (FLookupRoot is TComponent) then begin + if ComponentCount<>TComponent(ALookupRoot).ComponentCount then exit; + for i:=0 to FComponentList.Count-1 do + if TComponent(FComponentList[i])<>TComponent(ALookupRoot).Components[i] + then exit; + end; + Result:=true; +end; + //****************************************************************************** // XXX // workaround for missing typeinfo function @@ -5185,84 +5263,6 @@ begin DummyClassForPropTypes.Free; end; - -{ TBackupComponentList } - -function TBackupComponentList.GetComponents(Index: integer): TComponent; -begin - Result:=TComponent(FComponentList[Index]); -end; - -procedure TBackupComponentList.SetComponents(Index: integer; - const AValue: TComponent); -begin - FComponentList[Index]:=AValue; -end; - -procedure TBackupComponentList.SetLookupRoot(const AValue: TPersistent); -var - i: Integer; -begin - FLookupRoot:=AValue; - FComponentList.Clear; - if (FLookupRoot<>nil) and (FLookupRoot is TComponent) then - for i:=0 to TComponent(FLookupRoot).ComponentCount-1 do - FComponentList.Add(TComponent(FLookupRoot).Components[i]); - FSelection.Clear; -end; - -procedure TBackupComponentList.SetSelection( - const AValue: TPersistentSelectionList); -begin - if FSelection=AValue then exit; - FSelection.Assign(AValue); -end; - -constructor TBackupComponentList.Create; -begin - FSelection:=TPersistentSelectionList.Create; - FComponentList:=TList.Create; -end; - -destructor TBackupComponentList.Destroy; -begin - FreeAndNil(FSelection); - FreeAndNil(FComponentList); - inherited Destroy; -end; - -function TBackupComponentList.IndexOf(AComponent: TComponent): integer; -begin - Result:=FComponentList.IndexOf(AComponent); -end; - -procedure TBackupComponentList.Clear; -begin - LookupRoot:=nil; -end; - -function TBackupComponentList.ComponentCount: integer; -begin - Result:=FComponentList.Count; -end; - -function TBackupComponentList.IsEqual(ALookupRoot: TPersistent; - ASelection: TPersistentSelectionList): boolean; -var - i: Integer; -begin - Result:=false; - if ALookupRoot<>LookupRoot then exit; - if not FSelection.IsEqual(ASelection) then exit; - if (ALookupRoot<>nil) and (FLookupRoot is TComponent) then begin - if ComponentCount<>TComponent(ALookupRoot).ComponentCount then exit; - for i:=0 to FComponentList.Count-1 do - if TComponent(FComponentList[i])<>TComponent(ALookupRoot).Components[i] - then exit; - end; - Result:=true; -end; - initialization InitPropEdits;