mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-16 01:00:34 +01:00
codetools: fixed resolving ctnConstant, improved guess type of const enum set
This commit is contained in:
mattias
parent
34575834a5
commit
8281c7c030
@ -6571,7 +6571,7 @@ function TCodeCompletionCodeTool.GuessTypeOfIdentifier(
|
||||
<something>:=aclass.identifier
|
||||
<something>:=<something>+aclass.identifier
|
||||
for identifier in <something>
|
||||
ToDo: <proc>(,,aclass.identifier)
|
||||
<proc>(,,aclass.identifier)
|
||||
|
||||
checks where the identifier is already defined or is a keyword
|
||||
checks if the identifier is a sub identifier (e.g. A.identifier)
|
||||
|
||||
@ -125,7 +125,7 @@ const
|
||||
ctnIdentifier = 70;
|
||||
ctnRangedArrayType = 71;
|
||||
ctnOpenArrayType = 72;
|
||||
ctnOfConstType = 73;
|
||||
ctnOfConstType = 73; // e.g. array of const
|
||||
ctnRecordType = 74;
|
||||
ctnRecordCase = 75; // children: ctnVarDefinition plus 0..n ctnRecordVariant
|
||||
ctnRecordVariant = 76; // children: 0..n ctnVarDefinition plus may be a ctnRecordCase
|
||||
|
||||
@ -379,7 +379,7 @@ type
|
||||
{ TExpressionType is used for compatibility check
|
||||
A compatibility check is done by comparing two TExpressionType
|
||||
|
||||
if Desc = xtConstSet, SubDesc contains the type of the set
|
||||
if Desc = xtConstSet, SubDesc contains the element type of the set
|
||||
if Context.Node<>nil, it contains the corresponding codetree node
|
||||
if Desc = xtPointer then SubDesc contains the type e.g. xtChar
|
||||
}
|
||||
@ -1666,25 +1666,36 @@ function TTypeAliasOrderList.Compare(const Operand1,
|
||||
): TOperand;
|
||||
var
|
||||
xCompRes: Integer;
|
||||
aLeft, aRight, NewLeft, NewRight: String;
|
||||
begin
|
||||
// first check if one of the operands is a constant -> if yes, automatically
|
||||
// return the other
|
||||
// (x := f + 1; should return always type of f)
|
||||
//debugln(['TTypeAliasOrderList.Compare Oper1=',ExprTypeToString(Operand1.Expr),' Oper2=',ExprTypeToString(Operand2.Expr)]);
|
||||
if (Operand1.Expr.Desc in xtAllConstTypes) and not (Operand2.Expr.Desc in xtAllConstTypes) then
|
||||
Exit(Operand2)
|
||||
else
|
||||
if (Operand2.Expr.Desc in xtAllConstTypes) and not (Operand1.Expr.Desc in xtAllConstTypes) then
|
||||
Exit(Operand1);
|
||||
|
||||
aLeft:=Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, nil);
|
||||
aRight:=Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, nil);
|
||||
|
||||
// then compare base types
|
||||
xCompRes := Compare(
|
||||
Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, nil),
|
||||
Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, nil));
|
||||
xCompRes := Compare(aLeft,aRight);
|
||||
// if base types are same, compare aliases
|
||||
if xCompRes = 0 then
|
||||
xCompRes := Compare(
|
||||
Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, @Operand1.AliasType),
|
||||
Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, @Operand2.AliasType));
|
||||
if xCompRes = 0 then begin
|
||||
if Operand1.AliasType.Node<>nil then
|
||||
NewLeft:=Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, @Operand1.AliasType)
|
||||
else
|
||||
NewLeft:=aLeft;
|
||||
if Operand2.AliasType.Node<>nil then
|
||||
NewRight:=Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, @Operand2.AliasType)
|
||||
else
|
||||
NewRight:=aRight;
|
||||
if (aLeft<>NewLeft) or (aRight<>NewRight) then
|
||||
xCompRes := Compare(NewLeft,NewRight);
|
||||
end;
|
||||
if xCompRes > 0 then
|
||||
Result := Operand2
|
||||
else
|
||||
@ -2218,13 +2229,13 @@ var
|
||||
dbgout([' CodePos=',CodePos,' LinkIndex=',LinkIndex]);
|
||||
if LinkIndex>=0 then begin
|
||||
Link:=Scanner.Links[LinkIndex];
|
||||
dbgout([',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(LinkIndex),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind),',CodeSame=',Link.Code=Pointer(CursorPos.Code)]);
|
||||
dbgout([',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(LinkIndex),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind),',CodeSame=',Link.Code=CursorPos.Code]);
|
||||
end else begin
|
||||
dbgout([' LinkCount=',Scanner.LinkCount]);
|
||||
i:=0;
|
||||
while (i<Scanner.LinkCount-1) do begin
|
||||
Link:=Scanner.Links[i];
|
||||
if Link.Code=Pointer(CursorPos.Code) then begin
|
||||
if Link.Code=CursorPos.Code then begin
|
||||
if LinkIndex<0 then
|
||||
dbgout([', First Link of Code: ID=',i,',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(i),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind)]);
|
||||
LinkIndex:=i;
|
||||
@ -11596,8 +11607,6 @@ begin
|
||||
// const -> convert to special expression type
|
||||
// for example: const a: integer = 3;
|
||||
|
||||
// ToDo: ppu, dcu files
|
||||
|
||||
Tool.MoveCursorToNodeStart(Node);
|
||||
|
||||
Tool.ReadNextAtom;
|
||||
@ -11617,9 +11626,6 @@ begin
|
||||
|
||||
ctnIdentifier:
|
||||
begin
|
||||
|
||||
// ToDo: ppu, dcu files
|
||||
|
||||
Tool.MoveCursorToNodeStart(Node);
|
||||
Tool.ReadNextAtom;
|
||||
ConvertIdentifierAtCursor(Tool);
|
||||
@ -11627,9 +11633,6 @@ begin
|
||||
|
||||
ctnProperty,ctnGlobalProperty:
|
||||
begin
|
||||
|
||||
// ToDo: ppu, dcu files
|
||||
|
||||
if Tool.MoveCursorToPropType(Node) then
|
||||
ConvertIdentifierAtCursor(Tool);
|
||||
end;
|
||||
@ -11637,15 +11640,11 @@ begin
|
||||
ctnConstant:
|
||||
begin
|
||||
// for example: const a = 3;
|
||||
|
||||
// ToDo: ppu, dcu files
|
||||
|
||||
Tool.MoveCursorToNodeStart(Node);
|
||||
Params.Save(OldInput);
|
||||
Params.ContextNode:=Node;
|
||||
Result:=Tool.ReadOperandTypeAtCursor(Params,-1,CurAliasType);
|
||||
Result:=Tool.ReadOperandTypeAtCursor(Params,Node.EndPos,CurAliasType);
|
||||
Params.Load(OldInput,true);
|
||||
Result.Context:=CreateFindContext(Tool,Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -11670,12 +11669,26 @@ var EndPos, SubStartPos: integer;
|
||||
RaiseExceptionFmt(20170421200607,ctsStrExpectedButAtomFound,[ctsConstant,GetAtom]);
|
||||
end;
|
||||
|
||||
var
|
||||
aNode: TCodeTreeNode;
|
||||
begin
|
||||
// 'set' constant
|
||||
SubStartPos:=CurPos.StartPos;
|
||||
ReadNextAtom;
|
||||
if not AtomIsChar(']') then begin
|
||||
Result:=ReadOperandTypeAtCursor(Params);
|
||||
if (Result.Desc=xtContext) then begin
|
||||
aNode:=Result.Context.Node;
|
||||
if aNode.Desc in [ctnEnumIdentifier,ctnEnumerationType] then begin
|
||||
// [enum] -> search Set of enum
|
||||
aNode:=Result.Context.Tool.FindSetOfEnumerationType(aNode);
|
||||
if aNode<>nil then begin
|
||||
Result.Context.Node:=aNode;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF ShowExprEval}
|
||||
DebugLn('[TFindDeclarationTool.ReadOperandTypeAtCursor] Set of ',
|
||||
ExpressionTypeDescNames[Result.Desc]);
|
||||
@ -11960,6 +11973,16 @@ begin
|
||||
{$IFDEF CheckNodeTool}
|
||||
CheckNodeTool(Node);
|
||||
{$ENDIF}
|
||||
if Node.Desc=ctnEnumIdentifier then
|
||||
Node:=Node.Parent;
|
||||
if Node.Desc=ctnEnumerationType then begin
|
||||
// return enum type
|
||||
Result.Desc:=xtContext;
|
||||
Result.Context.Tool:=Self;
|
||||
Result.Context.Node:=Node;
|
||||
exit;
|
||||
end;
|
||||
|
||||
MoveCursorToNodeStart(Node);
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafEdgedBracketOpen then
|
||||
@ -12067,21 +12090,22 @@ begin
|
||||
['char',ExpressionTypeDescNames[RightOperand.Expr.Desc]]);
|
||||
end;
|
||||
end else if (Src[BinaryOperator.StartPos] in ['+','-','*'])
|
||||
and (LeftOperand.Expr.Desc=xtContext)
|
||||
and (LeftOperand.Expr.Context.Node<>nil)
|
||||
and (LeftOperand.Expr.Context.Node.Desc=ctnSetType)
|
||||
and (LeftOperand.Expr.Desc=xtContext)
|
||||
and (LeftOperand.Expr.Context.Node<>nil)
|
||||
and (LeftOperand.Expr.Context.Node.Desc=ctnSetType)
|
||||
then begin
|
||||
Result:=LeftOperand;
|
||||
end else begin
|
||||
if (LeftOperand.Expr.Desc in xtAllRealTypes)
|
||||
or (RightOperand.Expr.Desc in xtAllRealTypes) then
|
||||
or (RightOperand.Expr.Desc in xtAllRealTypes)
|
||||
then
|
||||
Result:=RealTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos)
|
||||
else if (LeftOperand.Expr.Desc=xtPointer)
|
||||
or (RightOperand.Expr.Desc=xtPointer)
|
||||
or ((LeftOperand.Expr.Desc=xtContext)
|
||||
and (LeftOperand.Expr.Context.Node.Desc=ctnPointerType))
|
||||
or ((RightOperand.Expr.Desc=xtContext)
|
||||
and (RightOperand.Expr.Context.Node.Desc=ctnPointerType))
|
||||
or (RightOperand.Expr.Desc=xtPointer)
|
||||
or ((LeftOperand.Expr.Desc=xtContext)
|
||||
and (LeftOperand.Expr.Context.Node.Desc=ctnPointerType))
|
||||
or ((RightOperand.Expr.Desc=xtContext)
|
||||
and (RightOperand.Expr.Context.Node.Desc=ctnPointerType))
|
||||
then
|
||||
Result.Expr.Desc:=xtPointer
|
||||
else
|
||||
@ -13197,14 +13221,16 @@ begin
|
||||
Result:=tcCompatible
|
||||
else if (TargetType.Desc=xtContext) then begin
|
||||
TargetNode:=TargetType.Context.Node;
|
||||
if ((TargetNode.Desc in (AllClasses+[ctnProcedure]))
|
||||
and (ExpressionType.Desc=xtNil))
|
||||
or ((TargetNode.Desc in [ctnOpenArrayType,ctnRangedArrayType])
|
||||
and (TargetNode.LastChild<>nil)
|
||||
and (TargetNode.LastChild.Desc=ctnOfConstType)
|
||||
and (ExpressionType.Desc=xtConstSet))
|
||||
if (TargetNode.Desc in (AllClasses+[ctnProcedure]))
|
||||
and (ExpressionType.Desc=xtNil)
|
||||
then
|
||||
Result:=tcCompatible
|
||||
else if (TargetNode.Desc in [ctnOpenArrayType,ctnRangedArrayType])
|
||||
and (TargetNode.LastChild<>nil)
|
||||
and (TargetNode.LastChild.Desc=ctnOfConstType)
|
||||
and (ExpressionType.Desc=xtConstSet)
|
||||
then
|
||||
Result:=tcCompatible;
|
||||
end
|
||||
else if (ExpressionType.Desc=xtContext) then begin
|
||||
ExprNode:=ExpressionType.Context.Node;
|
||||
@ -14247,7 +14273,7 @@ function TFindDeclarationTool.FindForInTypeAsString(TermPos: TAtomPosition;
|
||||
debugln([' ResolveExpr ConstSet Element: ',ExprTypeToString(SubExprType)]);
|
||||
{$ENDIF}
|
||||
if SubExprType.Desc=xtConstSet then
|
||||
RaiseTermHasNoIterator(20170421211222,SubExprType);
|
||||
RaiseTermHasNoIterator(20170421211223,SubExprType);
|
||||
ResolveExpr(SubExprType);
|
||||
end;
|
||||
else
|
||||
@ -15048,7 +15074,8 @@ begin
|
||||
Result:=ExpressionTypeDescNames[xtExtended];
|
||||
xtConstSet:
|
||||
begin
|
||||
// eventually try to find the 'set of ' type
|
||||
DebugLn('TFindDeclarationTool.FindExprTypeAsString ExprType=',
|
||||
ExprTypeToString(ExprType),' Alias=',FindContextToString(AliasType));
|
||||
RaiseTermNotSimple(20170421204658);
|
||||
end;
|
||||
xtConstBoolean:
|
||||
|
||||
@ -152,6 +152,7 @@ type
|
||||
procedure TestFindDeclaration_Arrays;
|
||||
procedure TestFindDeclaration_ArrayMultiDimDot;
|
||||
procedure TestFindDeclaration_GuessType;
|
||||
procedure TestFindDeclaration_GuessType_Set;
|
||||
procedure TestFindDeclaration_Attributes;
|
||||
procedure TestFindDeclaration_BracketOpen;
|
||||
procedure TestFindDeclaration_AnonymProc;
|
||||
@ -1239,6 +1240,22 @@ begin
|
||||
FindDeclarations('moduletests/fdt_guesstype1.pas');
|
||||
end;
|
||||
|
||||
procedure TTestFindDeclaration.TestFindDeclaration_GuessType_Set;
|
||||
begin
|
||||
StartProgram;
|
||||
Add([
|
||||
'type',
|
||||
' TColor = (red,green,blue);',
|
||||
' TColors = set of TColor;',
|
||||
'const',
|
||||
' Tomato = [red];',
|
||||
' TomatoSalad = Tomato+[green];',
|
||||
'begin',
|
||||
' Bla{guesstype:TColors} := TomatoSalad+[blue];',
|
||||
'end.']);
|
||||
FindDeclarations(Code);
|
||||
end;
|
||||
|
||||
procedure TTestFindDeclaration.TestFindDeclaration_Attributes;
|
||||
var
|
||||
Node: TCodeTreeNode;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user