paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 20:50:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed event assignment completion with existing @name

Browse Source
This commit is contained in:
mattias 2023-03-31 15:36:20 +02:00
parent 2e461dcd05
commit 454f272551
2 changed files with 65 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/codetools/codecompletiontool.pas
View File

@ -2033,6 +2033,8 @@ function TCodeCompletionCodeTool.CompleteEventAssignment(CleanCursorPos,
while (CleanCursorPos<SrcLen)
and (Src[CleanCursorPos] in [':','=',' ',#9]) do
inc(CleanCursorPos);
if (CleanCursorPos<=SrcLen) and (Src[CleanCursorPos]='@') then
inc(CleanCursorPos);
GetIdentStartEndAtPosition(Src,CleanCursorPos,
UserEventAtom.StartPos,UserEventAtom.EndPos);
MoveCursorToAtomPos(UserEventAtom);
@ -2167,15 +2169,14 @@ function TCodeCompletionCodeTool.CompleteEventAssignment(CleanCursorPos,
end;
RValue:=AnEventName+';';
if (AddrOperatorPos<1)
and not (Scanner.CompilerMode in [cmDelphi,cmDELPHIUNICODE])
then
if not (Scanner.CompilerMode in [cmDelphi,cmDELPHIUNICODE]) then
RValue:='@'+RValue;
if (AddrOperatorPos>0) or (UserEventAtom.StartPos>0) then begin
// left := |SomeName -> keep assignment and space behind
if AddrOperatorPos>0 then begin
// left := |@SomeName -> keep value and space behind
StartInsertPos:=AddrOperatorPos;
if StartInsertPos<1 then
StartInsertPos:=UserEventAtom.StartPos;
end else if UserEventAtom.StartPos>0 then begin
// left := |SomeName -> keep value and space behind
StartInsertPos:=UserEventAtom.StartPos;
end else begin
// left :=|
RValue:=':='+RValue;
@ -2277,7 +2278,12 @@ begin
{$ENDIF}
// create a nice event name
FullEventName:=CreateEventFullName(AClassNode,UserEventAtom,PropVarAtom);
if FullEventName='' then exit;
{$IFDEF VerboseCompleteEventAssign}
DebugLn(' CompleteEventAssignment: FullEventName="',FullEventName,'"');
{$ENDIF}
if FullEventName='' then begin
exit;
end;
// add published method and method body and right side of assignment
if not AddMethodCompatibleToProcType(AClassNode,FullEventName,ProcContext,

51
components/codetools/tests/testcodecompletion.pas
View File

@ -44,6 +44,7 @@ type
procedure TestCompleteMethodSignature_Without_Parentheses;
procedure TestCompleteEventAssignmentDelphi;
procedure TestCompleteEventAssignmentObjFPC;
procedure TestCompleteEventAssignmentObjFPC_AtName;
procedure TestCompleteClass_Unit_NewClass;
procedure TestCompleteClass_Unit_NewClass_BehindOldClass;
procedure TestCompleteClass_Unit_NewClass_InFrontOfOldClass;
@ -1007,6 +1008,56 @@ begin
,'end.']);
end;
procedure TTestCodeCompletion.TestCompleteEventAssignmentObjFPC_AtName;
begin
Test('TestCompleteEventAssignmentDelphi',
['unit SomeUnit;'
,'{$MODE ObjFPC}'
,'interface'
,'type'
,' TNotifyEvent = procedure(Sender: TObject) of object;'
,' TBird = class'
,' private'
,' public'
,' Eagle: TBird;'
,' OnClick: TNotifyEvent;'
,' procedure Fly;'
,' end;'
,'implementation'
,'procedure TBird.Fly;'
,'begin;'
,' Eagle.OnClick:=@OnEagled'
,'end;'
,'end.'],
16,18,
['unit SomeUnit;'
,'{$MODE ObjFPC}'
,'interface'
,'type'
,' TNotifyEvent = procedure(Sender: TObject) of object;'
,' { TBird }'
,' TBird = class'
,' private'
,' procedure OnEagled(Sender: TObject);'
,' public'
,' Eagle: TBird;'
,' OnClick: TNotifyEvent;'
,' procedure Fly;'
,' end;'
,'implementation'
,''
,'procedure TBird.OnEagled(Sender: TObject);'
,'begin'
,''
,'end;'
,''
,'procedure TBird.Fly;'
,'begin;'
,' Eagle.OnClick:=@OnEagled;'
,'end;'
,'end.']);
end;
procedure TTestCodeCompletion.TestCompleteClass_Unit_NewClass;
// test creating the first method body of a class
begin