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

codetools: added test property completion with specialize type

Browse Source 
git-svn-id: trunk@56524 -
This commit is contained in:
mattias 2017-11-28 14:24:22 +00:00
parent 5b452794dd
commit e6f4323328
2 changed files with 116 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,10 +19,12 @@ type
Expected: array of string);
published
procedure TestIntfProcUpdateArgName;
procedure TestCompleteMethodSignature_GenericObjFPC;
procedure TestCompleteMethodBody_GenericObjFPC;
procedure TestCompleteMethodBody_GenericDelphi;
procedure TestCompleteMethodBody_GenericDelphi; // ToDo
procedure TestCompleteMethodBody_ParamSpecialize;
procedure TestCompleteMethodBody_ParamDelphiSpecialize;
procedure TestCompleteProperty_ObjFPC_SpecializeType;
end;
implementation
@ -45,14 +47,16 @@ begin
if not CodeToolBoss.CompleteCode(Code,Col,Line,Line,NewCode,NewX,NewY,NewTopLine,
BlockTopLine,BlockBottomLine,false) then
begin
NewCode:=Code;
NewY:=Line;
NewX:=Col;
if CodeToolBoss.ErrorLine>0 then begin
if (CodeToolBoss.ErrorCode<>nil) and (CodeToolBoss.ErrorLine>0) then begin
NewY:=CodeToolBoss.ErrorLine;
NewX:=CodeToolBoss.ErrorColumn;
NewCode:=CodeToolBoss.ErrorCode;
end;
WriteSource(Code.Filename,NewY,NewX);
Fail(Title+'call CompleteCode failed: '+CodeToolBoss.ErrorDbgMsg);
WriteSource(NewCode.Filename,NewY,NewX);
Fail(Title+': call CompleteCode failed: "'+CodeToolBoss.ErrorDbgMsg+'"');
end;
s:='';
for i:=Low(Expected) to High(Expected) do
@ -80,6 +84,47 @@ begin
,'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodSignature_GenericObjFPC;
begin
Test('TestCompleteMethodSignature_GenericObjFPC',
['unit test1;',
'{$mode objfpc}{$H+}',
'interface',
'type',
' generic TBird<T: class> = class',
' procedure DoIt(s: string);',
' procedure DoIt;',
' end;',
'implementation',
'procedure TBird.DoIt(s: char);',
'begin',
'end;',
'procedure TBird.DoIt;',
'begin',
'end;',
'end.'],
6,1,
['unit test1;',
'{$mode objfpc}{$H+}',
'interface',
'type',
'',
' { TBird }',
'',
' generic TBird<T: class> = class',
' procedure DoIt(s: string);',
' procedure DoIt;',
' end;',
'implementation',
'procedure TBird.DoIt(s: string);',
'begin',
'end;',
'procedure TBird.DoIt;',
'begin',
'end;',
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericObjFPC;
begin
Test('TestCompleteMethodBody_GenericObjFPC',
@ -114,6 +159,7 @@ end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericDelphi;
begin
exit; // ToDo
Test('TestCompleteMethodBody_GenericObjFPC',
['unit test1;',
'{$mode delphi}',
@ -178,7 +224,7 @@ end;
procedure TTestCodeCompletion.TestCompleteMethodBody_ParamDelphiSpecialize;
begin
Test('TestCompleteMethodBody_ParamSpecialize',
Test('TestCompleteMethodBody_ParamDelphiSpecialize',
['unit test1;',
'{$mode delphi}',
'interface',
@ -208,6 +254,35 @@ begin
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteProperty_ObjFPC_SpecializeType;
begin
Test('TestCompleteMethodBody_ParamDelphiSpecialize',
['unit test1;',
'{$mode objfpc}{$H+}',
'interface',
'type',
' generic TLimb<T> = class end;',
' TBird = class',
' property Wing: specialize TLimb<string>;',
' end;',
'implementation',
'end.'],
7,1,
['unit test1;',
'{$mode objfpc}{$H+}',
'interface',
'type',
'',
' { TBird }',
'',
' TBird = class',
' property Wing: specialize TLimb<string> read FWing write SetWing;',
' end;',
'implementation',
'',
'end.']);
end;
initialization
RegisterTests([TTestCodeCompletion]);
end.

38
components/codetools/tests/testpascalparser.pas
View File

@ -32,6 +32,7 @@ type
procedure StartUnit;
procedure StartProgram;
procedure ParseModule;
procedure CheckParseError(const CursorPos: TCodeXYPosition; Msg: string);
procedure WriteSource(CleanPos: integer; Tool: TCodeTool);
procedure WriteSource(const CursorPos: TCodeXYPosition);
property Code: TCodeBuffer read FCode;
@ -44,6 +45,7 @@ type
procedure TestAtomRing;
procedure TestRecord_ClassOperators;
procedure TestDeprecated;
procedure TestMissingGenericKeywordObjFPCFail;
procedure TestParseGenericsDelphi;
end;
@ -117,6 +119,29 @@ begin
DoParseModule(Code,Tool);
end;
procedure TCustomTestPascalParser.CheckParseError(
const CursorPos: TCodeXYPosition; Msg: string);
var
Tool: TCodeTool;
begin
if CodeToolBoss.Explore(Code,Tool,true) then begin
WriteSource(CursorPos);
Fail('missing parser error "'+Msg+'"');
end;
if Tool=nil then begin
WriteSource(CursorPos);
Fail('missing Tool, Msg="'+Msg+'"');
end;
if CursorPos.Code<>CodeToolBoss.ErrorCode then begin
WriteSource(CursorPos);
Fail('expected parser error "'+Msg+'" in "'+CursorPos.Code.Filename+'", not in "'+CodeToolBoss.ErrorCode.Filename+'"');
end;
if (CursorPos.Y<>CodeToolBoss.ErrorLine) or (CursorPos.X<>CodeToolBoss.ErrorColumn) then begin
WriteSource(CursorPos);
Fail('expected parser error "'+Msg+'" at line='+IntToStr(CursorPos.Y)+' col='+IntToStr(CursorPos.X)+', but got line='+IntToStr(CodeToolBoss.ErrorLine)+' col='+IntToStr(CodeToolBoss.ErrorColumn));
end;
end;
procedure TCustomTestPascalParser.WriteSource(CleanPos: integer; Tool: TCodeTool
);
var
@ -367,10 +392,19 @@ begin
ParseModule;
end;
procedure TTestPascalParser.TestMissingGenericKeywordObjFPCFail;
begin
Add([
'program test1;',
'{$mode objfpc}',
'type',
' TList<T> = class end;',
'begin']);
CheckParseError(CodeXYPosition(8,4,Code),'expected =, but got <');
end;
procedure TTestPascalParser.TestParseGenericsDelphi;
begin
StartProgram;
Code.Source:='';
Add([
'program test1;',
'{$mode delphi}',