1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
unit TestChangeDeclaration;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeToolManager, CodeCache, PascalParserTool,
LazLogger, LazFileUtils, fpcunit, testregistry,
TestFinddeclaration, TestStdCodetools;
type
TTestChangeDeclaration = class(TCustomTestCTStdCodetools)
published
procedure TestCTAddProcedureModifier;
end;
implementation
procedure TTestChangeDeclaration.TestCTAddProcedureModifier;
procedure Test(ProcCode, aModifier, Expected: string);
var
Code: TCodeBuffer;
Src, ProcHead: String;
begin
Src:='unit TestChangeDeclaration;'+sLineBreak
+'interface'+sLineBreak
+ProcCode+sLineBreak
+'implementation'+sLineBreak
+'end.';
Code:=CodeToolBoss.CreateFile('TestChangeDeclaration.pas');
Code.Source:=Src;
if not CodeToolBoss.AddProcModifier(Code,3,3,aModifier) then
begin
Fail('AddProcModifier failed: '+CodeToolBoss.ErrorMessage);
end else begin
if not CodeToolBoss.ExtractProcedureHeader(Code,3,3,
[phpWithStart,phpWithResultType,phpWithOfObject,phpWithProcModifiers,phpWithComments,phpDoNotAddSemicolon],
ProcHead)
then
Fail('ExtractProcedureHeader failed: '+CodeToolBoss.ErrorMessage);
if ProcHead<>Expected then begin
writeln('Test ProcCode="',ProcCode,'"');
Src:=Code.Source;
writeln('SrcSTART:======================');
writeln(Src);
writeln('SrcEND:========================');
AssertEquals('ProcHead',Expected,ProcHead);
end;
end;
end;
begin
// remove first unit
Test('procedure DoIt;','overload','procedure DoIt; overload;');
Test('procedure DoIt ;','overload','procedure DoIt; overload ;');
Test('procedure DoIt ; ;','overload','procedure DoIt; overload ;');
Test('procedure DoIt; overload;','overload','procedure DoIt; overload;');
Test('procedure DoIt; {$IFDEF FPC}overload{$ENDIF};','overload','procedure DoIt; {$IFDEF FPC}overload{$ENDIF};');
Test('procedure DoIt; procedure Bla;','overload','procedure DoIt; overload;');
Test(' procedure DoIt;'+sLineBreak+' procedure Bla;',
'overload','procedure DoIt; overload;');
Test(' procedure DoIt; external name ''doit'';'+sLineBreak+' procedure Bla;',
'overload','procedure DoIt; external name ''doit''; overload;');
end;
initialization
RegisterTests([TTestChangeDeclaration]);
end.
|
