codetools: implement 'Override function result string types with the first parameter expression type' code creation feature

git-svn-id: trunk@54976 -
2025-12-02 18:37:38 +01:00 · 2017-05-18 20:08:13 +00:00 · 2017-05-18 20:08:13 +00:00 · a52a5d0607
commit a52a5d0607
parent cba5c9c545
7 changed files with 146 additions and 49 deletions
--- a/components/codetools/codecompletiontool.pas
+++ b/components/codetools/codecompletiontool.pas
@ -1892,6 +1892,8 @@ begin
    {$ENDIF}
    // find type of term
    Params.ContextNode:=CursorNode;
+    if Beautifier.OverrideStringTypesWithFirstParamType then
+      Params.Flags:=Params.Flags+[fdfOverrideStringTypesWithFirstParamType];
    NewType:=FindTermTypeAsString(TermAtom,Params,ExprType);
    if NewType='' then
      RaiseException(20170421201534,'CompleteLocalVariableAssignment Internal error: NewType=""');
--- a/components/codetools/finddeclarationtool.pas
+++ b/components/codetools/finddeclarationtool.pas
@ -183,14 +183,16 @@ type
    fdfSearchInHelpers,     // search in class/record/type helpers too
    fdfSearchInHelpersInTheEnd, // search in helpers after current class (used with inherited call in helper)
    fdfTypeType,            // do not resolve TMyString = type string;
-    fdfIgnoreOperatorError  // return expression type even if an operator error was found
+    fdfIgnoreOperatorError, // return expression type even if an operator error was found
+    fdfOverrideStringTypesWithFirstParamType  // if you search for an expression result type of a "function A(B: string): string", override the result type with type of B expression
    );
  TFindDeclarationFlags = set of TFindDeclarationFlag;
  
 const
  // masks to pass flags to sub searches
  fdfGlobals = [fdfExceptionOnNotFound, fdfTopLvlResolving,
-                fdfExtractOperand, fdfPropertyResolving];
+                fdfExtractOperand, fdfPropertyResolving,
+                fdfOverrideStringTypesWithFirstParamType];
  fdfGlobalsSameIdent = fdfGlobals+[fdfExceptionOnPredefinedIdent,
                fdfIgnoreMissingParams, fdfIgnoreUsedUnits, fdfDoNotCache,
                fdfOnlyCompatibleProc, fdfSearchInAncestors, fdfCollect, fdfSearchInHelpers];
@ -8684,6 +8686,8 @@ var
  IsIdentEndOfVar: TIsIdentEndOfVar;
  FlagCanBeForwardDefined, FlagCanBeForwardDefinedValid: boolean;
  ExprType: TExpressionType;
+  FirstParamStartPos: Integer;
+  FuncParamList: TExprTypeList;

  procedure RaiseIdentExpected;
  begin
@ -8857,7 +8861,8 @@ var
    ProcNode, FuncResultNode: TCodeTreeNode;
    AtEnd: Boolean;
    CurAliasType: PFindContext;
-    Context: TFindContext;
+    Context, FirstParamAlias: TFindContext;
+    FirstParamExprType: TExpressionType;
  begin
    //DebugLn(['ResolveBaseTypeOfIdentifier ',ExprType.Context.Node<>nil]);
    if ExprType.Desc=xtContext then
@ -8914,6 +8919,49 @@ var
        Include(Params.Flags,fdfFunctionResult);
        ExprType:=ExprType.Context.Tool.ConvertNodeToExpressionType(
                                            ProcNode,Params,CurAliasType);
+
+        if  (ExprType.Desc in [xtAnsiString, xtString, xtShortString])
+        and (FirstParamStartPos>0)
+        and (FuncParamList<>nil) and(FuncParamList.Count>0)
+        and (FuncParamList.Items[0].Desc in [xtAnsiString, xtString, xtShortString]) then
+        begin
+          MoveCursorToCleanPos(FirstParamStartPos);
+          ReadNextAtom;
+          if (CurPos.Flag=cafRoundBracketOpen) then
+          begin
+            ReadNextAtom;
+            FirstParamStartPos := CurPos.StartPos;
+
+            if CurPos.Flag<>cafRoundBracketClose then begin
+              // read first expressions
+              // read til comma or bracket close
+              while GetCurrentAtomType in [vatIdentifier, vatPoint] do
+                ReadNextAtom;
+
+              repeat
+                if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
+                  ReadTilBracketClose(true);
+                end;
+                if (CurPos.StartPos>SrcLen)
+                or (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose,cafComma])
+                then
+                  break;
+              until false;
+
+              // find expression type
+              Params.Flags:=Params.Flags-[fdfExceptionOnNotFound];
+              FillChar(FirstParamAlias{%H-}, SizeOf(FirstParamAlias), 0);
+              //DebugLn('TFindDeclarationTool.CreateParamExprListFromStatement CurIgnoreErrorAfterPos=',dbgs(CurIgnoreErrorAfterPos),' ExprStartPos=',dbgs(ExprStartPos));
+              FirstParamExprType:=FindExpressionResultType(Params,FirstParamStartPos,CurPos.StartPos,@FirstParamAlias);
+              if (FirstParamExprType.Desc in [xtAnsiString, xtString, xtShortString]) then
+              begin
+                ExprType := FirstParamExprType;
+                if AliasType<>nil then
+                  AliasType^ := FirstParamAlias;
+              end;
+            end;
+          end;
+        end;
      end;
    end;
  end;
@ -9682,6 +9730,14 @@ var
          Params.AddOperandPart(')');
        end;
      end;
+      if fdfOverrideStringTypesWithFirstParamType in Params.Flags then begin
+        if (ExprType.Context.Node<>nil)
+        and (ExprType.Context.Node.Desc in [ctnProcedure, ctnProcedureHead])
+        and (FirstParamStartPos<0) then begin
+          FirstParamStartPos := CurAtom.StartPos;
+          FuncParamList := CreateParamExprListFromStatement(FirstParamStartPos, Params);
+        end;
+      end;
    end else begin
      // expression
      {$IFDEF ShowExprEval}
@ -9802,51 +9858,57 @@ var
  end;
  
 begin
-  Result:=CleanExpressionType;
-  StartFlags:=Params.Flags;
-  StartNode:=Params.ContextNode;
-  {$IFDEF ShowExprEval}
-  DebugLn(['[TFindDeclarationTool.FindExpressionTypeOfTerm] START',
-    ' Flags=[',dbgs(Params.Flags),']',
-    ' StartContext=',StartNode.DescAsString,'=',dbgstr(Src,StartNode.StartPos,15),
-    ' Alias=',AliasType<>nil]
-  );
-  {$ENDIF}
-  {$IFDEF CheckNodeTool}
-  CheckNodeTool(StartNode);
-  {$ENDIF}
-
-  if not InitAtomQueue then exit;
-  ExprType:=CleanExpressionType;
-  repeat
+  FirstParamStartPos := -1;
+  FuncParamList := nil;
+  try
+    Result:=CleanExpressionType;
+    StartFlags:=Params.Flags;
+    StartNode:=Params.ContextNode;
    {$IFDEF ShowExprEval}
-    DebugLn(['  FindExpressionTypeOfTerm ATOM CurAtomType=',
-      VariableAtomTypeNames[CurAtomType],' CurAtom="',GetAtom(CurAtom),'"',
-      ' ExprType=',ExprTypeToString(ExprType)]);
+    DebugLn(['[TFindDeclarationTool.FindExpressionTypeOfTerm] START',
+      ' Flags=[',dbgs(Params.Flags),']',
+      ' StartContext=',StartNode.DescAsString,'=',dbgstr(Src,StartNode.StartPos,15),
+      ' Alias=',AliasType<>nil]
+    );
+    {$ENDIF}
+    {$IFDEF CheckNodeTool}
+    CheckNodeTool(StartNode);
    {$ENDIF}
-    case CurAtomType of
-    vatIdentifier, vatPreDefIdentifier: ResolveIdentifier;
-    vatStringConstant,vatNumber: ResolveConstant;
-    vatPoint:             ResolvePoint;
-    vatAS:                ResolveAs;
-    vatUP:                ResolveUp;
-    vatEdgedBracketOpen:  ResolveEdgedBracketOpen;
-    vatRoundBracketOpen:  ResolveRoundBracketOpen;
-    vatINHERITED:         ResolveINHERITED;
-    end;
-    ReadNextExpressionAtom;
-  until CurAtom.EndPos>EndPos;

-  if fdfFunctionResult in StartFlags then
-    ResolveChildren;
+    if not InitAtomQueue then exit;
+    ExprType:=CleanExpressionType;
+    repeat
+      {$IFDEF ShowExprEval}
+      DebugLn(['  FindExpressionTypeOfTerm ATOM CurAtomType=',
+        VariableAtomTypeNames[CurAtomType],' CurAtom="',GetAtom(CurAtom),'"',
+        ' ExprType=',ExprTypeToString(ExprType)]);
+      {$ENDIF}
+      case CurAtomType of
+      vatIdentifier, vatPreDefIdentifier: ResolveIdentifier;
+      vatStringConstant,vatNumber: ResolveConstant;
+      vatPoint:             ResolvePoint;
+      vatAS:                ResolveAs;
+      vatUP:                ResolveUp;
+      vatEdgedBracketOpen:  ResolveEdgedBracketOpen;
+      vatRoundBracketOpen:  ResolveRoundBracketOpen;
+      vatINHERITED:         ResolveINHERITED;
+      end;
+      ReadNextExpressionAtom;
+    until CurAtom.EndPos>EndPos;

-  Result:=ExprType;
-  if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags)) then
-    Result:=Result.Context.Tool.ConvertNodeToExpressionType(
-                 Result.Context.Node,Params);
-  {$IFDEF ShowExprEval}
-  DebugLn('  FindExpressionTypeOfTerm Result=',ExprTypeToString(Result));
-  {$ENDIF}
+    if fdfFunctionResult in StartFlags then
+      ResolveChildren;
+
+    Result:=ExprType;
+    if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags)) then
+      Result:=Result.Context.Tool.ConvertNodeToExpressionType(
+                   Result.Context.Node,Params);
+    {$IFDEF ShowExprEval}
+    DebugLn('  FindExpressionTypeOfTerm Result=',ExprTypeToString(Result));
+    {$ENDIF}
+  finally
+    FuncParamList.Free;
+  end;
 end;

 function TFindDeclarationTool.FindEndOfExpression(StartPos: integer): integer;
@ -12308,7 +12370,8 @@ begin
  end else begin
    ExprType:=CleanExpressionType;
    Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
-                   fdfTopLvlResolving,fdfFunctionResult,fdfIgnoreOperatorError];
+                   fdfTopLvlResolving,fdfFunctionResult,fdfIgnoreOperatorError]
+                  +Params.Flags*[fdfOverrideStringTypesWithFirstParamType];
    ExprType:=FindExpressionResultType(Params,TermPos.StartPos,TermPos.EndPos,
                                       @AliasType);
  end;
--- a/components/codetools/sourcechanger.pas
+++ b/components/codetools/sourcechanger.pas
@ -172,6 +172,7 @@ type
    UpdateMultiProcSignatures: boolean;
    UpdateOtherProcSignaturesCase: boolean; // when updating proc signatures not under cursor, fix case
    GroupLocalVariables: boolean;
+    OverrideStringTypesWithFirstParamType: Boolean;
    // classes, methods, properties
    ClassHeaderComments: boolean;
    ClassImplementationComments: boolean;
@ -1295,6 +1296,7 @@ begin
  UpdateAllMethodSignatures:=true;
  UpdateMultiProcSignatures:=true;
  UpdateOtherProcSignaturesCase:=true;
+  OverrideStringTypesWithFirstParamType:=true;
  GroupLocalVariables:=true;
  MethodInsertPolicy:=mipClassOrder;
  MethodDefaultSection:=DefaultMethodDefaultSection;
--- a/ide/codetoolsoptions.pas
+++ b/ide/codetoolsoptions.pas
@ -90,6 +90,7 @@ type
    FUpdateMultiProcSignatures: boolean;
    FUpdateOtherProcSignaturesCase: boolean;
    FGroupLocalVariables: boolean;
+    FOverrideStringTypesWithFirstParamType: Boolean;
    FWordPolicyExceptions: TStringList;
    FDoNotSplitLineInFront: TAtomTypes;
    FDoNotSplitLineAfter: TAtomTypes;
@ -184,6 +185,8 @@ type
      read FUpdateOtherProcSignaturesCase write FUpdateOtherProcSignaturesCase;
    property GroupLocalVariables: boolean
      read FGroupLocalVariables write FGroupLocalVariables;
+    property OverrideStringTypesWithFirstParamType: Boolean
+      read FOverrideStringTypesWithFirstParamType write FOverrideStringTypesWithFirstParamType;
    property ClassHeaderComments: boolean
      read FClassHeaderComments write FClassHeaderComments;
    property ClassImplementationComments: boolean
@ -460,6 +463,8 @@ begin
      'CodeToolsOptions/UpdateOtherProcSignaturesCase/Value',true);
    FGroupLocalVariables:=XMLConfig.GetValue(
      'CodeToolsOptions/GroupLocalVariables/Value',true);
+    FOverrideStringTypesWithFirstParamType:=XMLConfig.GetValue(
+      'CodeToolsOptions/OverrideStringTypesWithFirstParamType/Value',true);
    FClassHeaderComments:=XMLConfig.GetValue(
      'CodeToolsOptions/ClassHeaderComments/Value',true);
    FClassImplementationComments:=XMLConfig.GetValue(
@ -623,6 +628,9 @@ begin
    XMLConfig.SetDeleteValue(
      'CodeToolsOptions/GroupLocalVariables/Value',FGroupLocalVariables,
      true);
+    XMLConfig.SetDeleteValue(
+      'CodeToolsOptions/OverrideStringTypesWithFirstParamType/Value',FOverrideStringTypesWithFirstParamType,
+      true);
    XMLConfig.SetDeleteValue(
      'CodeToolsOptions/ClassImplementationComments/Value',
      FClassImplementationComments,true);
@ -797,6 +805,7 @@ begin
    FUpdateMultiProcSignatures:=CodeToolsOpts.UpdateMultiProcSignatures;
    FUpdateOtherProcSignaturesCase:=CodeToolsOpts.UpdateOtherProcSignaturesCase;
    FGroupLocalVariables:=CodeToolsOpts.GroupLocalVariables;
+    FOverrideStringTypesWithFirstParamType:=CodeToolsOpts.OverrideStringTypesWithFirstParamType;
    FClassHeaderComments:=CodeToolsOpts.ClassHeaderComments;
    FClassImplementationComments:=CodeToolsOpts.ClassImplementationComments;
    FMethodInsertPolicy:=CodeToolsOpts.FMethodInsertPolicy;
@ -859,6 +868,7 @@ begin
  FUpdateMultiProcSignatures:=true;
  FUpdateOtherProcSignaturesCase:=true;
  FGroupLocalVariables:=true;
+  FOverrideStringTypesWithFirstParamType:=true;
  FClassHeaderComments:=true;
  FClassImplementationComments:=true;
  FMethodInsertPolicy:=mipClassOrder;
@ -940,6 +950,7 @@ begin
    and (FUpdateMultiProcSignatures=CodeToolsOpts.UpdateMultiProcSignatures)
    and (FUpdateOtherProcSignaturesCase=CodeToolsOpts.UpdateOtherProcSignaturesCase)
    and (FGroupLocalVariables=CodeToolsOpts.GroupLocalVariables)
+    and (FOverrideStringTypesWithFirstParamType=CodeToolsOpts.OverrideStringTypesWithFirstParamType)
    and (FClassHeaderComments=CodeToolsOpts.ClassHeaderComments)
    and (FClassImplementationComments=CodeToolsOpts.ClassImplementationComments)
    and (FMethodInsertPolicy=CodeToolsOpts.FMethodInsertPolicy)
@ -1062,6 +1073,7 @@ begin
    Beauty.UpdateMultiProcSignatures:=UpdateMultiProcSignatures;
    Beauty.UpdateOtherProcSignaturesCase:=UpdateOtherProcSignaturesCase;
    Beauty.GroupLocalVariables:=GroupLocalVariables;
+    Beauty.OverrideStringTypesWithFirstParamType:=OverrideStringTypesWithFirstParamType;
    Beauty.ClassHeaderComments:=ClassHeaderComments;
    Beauty.ClassImplementationComments:=ClassImplementationComments;
    Beauty.MethodInsertPolicy:=MethodInsertPolicy;
--- a/ide/frames/codetools_codecreation_options.lfm
+++ b/ide/frames/codetools_codecreation_options.lfm
@ -53,7 +53,7 @@ object CodetoolsCodeCreationOptionsFrame: TCodetoolsCodeCreationOptionsFrame
    AnchorSideTop.Side = asrCenter
    Left = 6
    Height = 15
-    Top = 166
+    Top = 185
    Width = 95
    Caption = 'TemplateFileLabel'
    ParentColor = False
@ -124,13 +124,13 @@ object CodetoolsCodeCreationOptionsFrame: TCodetoolsCodeCreationOptionsFrame
  object TemplateFileEdit: TFileNameEdit
    AnchorSideLeft.Control = TemplateFileLabel
    AnchorSideLeft.Side = asrBottom
-    AnchorSideTop.Control = GroupLocalVariablesCheckBox
+    AnchorSideTop.Control = OverrideStringTypesWithFirstParamTypeCheckBox
    AnchorSideTop.Side = asrBottom
    AnchorSideRight.Control = Owner
    AnchorSideRight.Side = asrBottom
    Left = 107
    Height = 23
-    Top = 162
+    Top = 181
    Width = 453
    FilterIndex = 0
    HideDirectories = False
@ -141,7 +141,19 @@ object CodetoolsCodeCreationOptionsFrame: TCodetoolsCodeCreationOptionsFrame
    BorderSpacing.Top = 6
    BorderSpacing.Right = 6
    MaxLength = 0
-    TabOrder = 6
+    TabOrder = 7
    Text = 'TemplateFileEdit'
  end
+  object OverrideStringTypesWithFirstParamTypeCheckBox: TCheckBox
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = GroupLocalVariablesCheckBox
+    AnchorSideTop.Side = asrBottom
+    Left = 6
+    Height = 19
+    Top = 156
+    Width = 286
+    BorderSpacing.Left = 6
+    Caption = 'OverrideStringTypesWithFirstParamTypeCheckBox'
+    TabOrder = 6
+  end
 end
--- a/ide/frames/codetools_codecreation_options.pas
+++ b/ide/frames/codetools_codecreation_options.pas
@ -34,6 +34,7 @@ type

  TCodetoolsCodeCreationOptionsFrame = class(TAbstractIDEOptionsEditor)
    ForwardProcsInsertPolicyComboBox: TComboBox;
+    OverrideStringTypesWithFirstParamTypeCheckBox: TCheckBox;
    TemplateFileEdit: TFileNameEdit;
    UsesInsertPolicyComboBox: TComboBox;
    ForwardProcsKeepOrderCheckBox: TCheckBox;
@ -98,6 +99,8 @@ begin
    lisUpdateOtherProcedureSignaturesWhenOnlyLetterCaseHa;
  GroupLocalVariablesCheckBox.Caption:=
    lisGroupLocalVariables;
+  OverrideStringTypesWithFirstParamTypeCheckBox.Caption:=
+    lisOverrideStringTypesWithFirstParamType;

  TemplateFileLabel.Caption:=lisTemplateFile;
  {$IFNDEF EnableCodeCompleteTemplates}
@ -138,6 +141,7 @@ begin
    UpdateMultiProcSignaturesCheckBox.Checked:=UpdateMultiProcSignatures;
    UpdateOtherProcSignaturesCaseCheckBox.Checked:=UpdateOtherProcSignaturesCase;
    GroupLocalVariablesCheckBox.Checked:=GroupLocalVariables;
+    OverrideStringTypesWithFirstParamTypeCheckBox.Checked:=OverrideStringTypesWithFirstParamType;

    TemplateFileEdit.Text:=CodeCompletionTemplateFileName;
  end;
@ -167,6 +171,7 @@ begin
    UpdateMultiProcSignatures:=UpdateMultiProcSignaturesCheckBox.Checked;
    UpdateOtherProcSignaturesCase:=UpdateOtherProcSignaturesCaseCheckBox.Checked;
    GroupLocalVariables:=GroupLocalVariablesCheckBox.Checked;
+    OverrideStringTypesWithFirstParamType:=OverrideStringTypesWithFirstParamTypeCheckBox.Checked;

    CodeCompletionTemplateFileName:=TemplateFileEdit.Text;
  end;
--- a/ide/lazarusidestrconsts.pas
+++ b/ide/lazarusidestrconsts.pas
@ -6288,6 +6288,7 @@ resourcestring
  lisCTOUpdateAllMethodSignatures = 'Update all method signatures';
  lisCTOUpdateMultipleProcedureSignatures = 'Update multiple procedure signatures';
  lisGroupLocalVariables = 'Group automatically defined local variables';
+  lisOverrideStringTypesWithFirstParamType = 'Override function result string types with the first parameter expression type';
  lisUpdateOtherProcedureSignaturesWhenOnlyLetterCaseHa = 'Update other '
    +'procedure signatures when only letter case has changed';
  lisTemplateFile = 'Template file';