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

git-svn-id: trunk@54976 -

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=""');

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;
+  FirstParamStartPos := -1;
-  StartFlags:=Params.Flags;
+  FuncParamList := nil;
-  StartNode:=Params.ContextNode;
+  try
-  {$IFDEF ShowExprEval}
+    Result:=CleanExpressionType;
-  DebugLn(['[TFindDeclarationTool.FindExpressionTypeOfTerm] START',
+    StartFlags:=Params.Flags;
-    ' Flags=[',dbgs(Params.Flags),']',
+    StartNode:=Params.ContextNode;
-    ' 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
     {$IFDEF ShowExprEval}
-    DebugLn(['  FindExpressionTypeOfTerm ATOM CurAtomType=',
+    DebugLn(['[TFindDeclarationTool.FindExpressionTypeOfTerm] START',
-      VariableAtomTypeNames[CurAtomType],' CurAtom="',GetAtom(CurAtom),'"',
+      ' Flags=[',dbgs(Params.Flags),']',
-      ' ExprType=',ExprTypeToString(ExprType)]);
+      ' 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
+    if not InitAtomQueue then exit;
-    ResolveChildren;
+    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 fdfFunctionResult in StartFlags then
-  if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags)) then
+      ResolveChildren;
-    Result:=Result.Context.Tool.ConvertNodeToExpressionType(
+
-                 Result.Context.Node,Params);
+    Result:=ExprType;
-  {$IFDEF ShowExprEval}
+    if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags)) then
-  DebugLn('  FindExpressionTypeOfTerm Result=',ExprTypeToString(Result));
+      Result:=Result.Context.Tool.ConvertNodeToExpressionType(
-  {$ENDIF}
+                   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;

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;

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;

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

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;

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';