1 {
2 Test with:
3 ./runtests --format=plain --suite=TTestCTStdCodetools
4 ./runtests --format=plain --suite=TestCTStdFindBlockStart
5 ./runtests --format=plain --suite=TestCTRemoveUnitFromAllUsesSections
6 }
7 unit TestStdCodetools;
8
9 {$mode objfpc}{$H+}
10
11 interface
12
13 uses
14 Classes, SysUtils, LazLoggerBase, fpcunit, testregistry,
15 CodeToolManager, StdCodeTools, CodeCache, LinkScanner, SourceChanger;
16
17 type
18
19 { TCustomTestCTStdCodetools }
20
21 TCustomTestCTStdCodetools = class(TTestCase)
22 private
GetCTMarkernull23 function GetCTMarker(Code: TCodeBuffer; Comment: string; out Position: TPoint): boolean;
24 protected
25 procedure CheckDiff(Msg, Expected, Actual: string);
26 procedure WriteSource(aFilename: string; Line, Col: integer);
27 end;
28
29 { TTestCTStdCodetools }
30
31 TTestCTStdCodetools = class(TCustomTestCTStdCodetools)
32 private
33 procedure DoTestAddUnitWarn(Title: string; Src, Expected: array of string;
34 WarnID, Comment: string; TurnOn: boolean);
35 procedure DoTestAddUnitToMainUses(NewUnitName, NewUnitInFilename,
36 UsesSrc, ExpectedUsesSrc: string; const Flags: TAddUsesFlags);
37 published
38 procedure TestCTStdFindBlockStart;
39 procedure TestCTUses_AddUses_Start;
40 procedure TestCTUses_AddUses_Append;
41 procedure TestCTUses_AddUses_AppendKeepSpaces;
42 procedure TestCTUses_AddUses_AppendKeepComment; // ToDo
43 procedure TestCTUses_AddUses_Append_DottedNoBreak;
44 procedure TestCTUses_RemoveFromAllUsesSections;
45 procedure TestCTAddWarn5025_Program;
46 procedure TestCTAddWarn5025_ProgramNoName;
47 procedure TestCTAddWarn5025_Unit;
48 end;
49
50 implementation
51
52 { TTestCTStdCodetools }
53
TCustomTestCTStdCodetools.GetCTMarkernull54 function TCustomTestCTStdCodetools.GetCTMarker(Code: TCodeBuffer; Comment: string;
55 out Position: TPoint): boolean;
56 var
57 p: SizeInt;
58 begin
59 Result:=false;
60 Position:=Point(0,0);
61 if Comment[1]<>'{' then
62 Comment:='{'+Comment+'}';
63 p:=System.Pos(Comment,Code.Source);
64 if p<1 then
65 AssertEquals('searching marker: '+Comment,true,p>=1);
66 Code.AbsoluteToLineCol(p+length(Comment),Position.Y,Position.X);
67 if Position.Y<1 then
68 AssertEquals('Code.AbsoluteToLineCol: '+Comment,true,Position.Y>=1)
69 else
70 Result:=true;
71 end;
72
73 procedure TCustomTestCTStdCodetools.CheckDiff(Msg, Expected, Actual: string);
74 // search diff, ignore changes in spaces
75 const
76 SpaceChars = [#9,#10,#13,' '];
77 var
78 ExpectedP, ActualP: PChar;
79
FindLineEndnull80 function FindLineEnd(p: PChar): PChar;
81 begin
82 Result:=p;
83 while not (Result^ in [#0,#10,#13]) do inc(Result);
84 end;
85
FindLineStartnull86 function FindLineStart(p, MinP: PChar): PChar;
87 begin
88 while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
89 Result:=p;
90 end;
91
92 procedure DiffFound;
93 var
94 ActLineStartP, ActLineEndP, p, StartPos: PChar;
95 ExpLine, ActLine: String;
96 i: Integer;
97 begin
98 writeln('Diff found "',Msg,'". Lines:');
99 // write correct lines
100 p:=PChar(Expected);
101 repeat
102 StartPos:=p;
103 while not (p^ in [#0,#10,#13]) do inc(p);
104 ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
105 if p^ in [#10,#13] then begin
106 if (p[1] in [#10,#13]) and (p^<>p[1]) then
107 inc(p,2)
108 else
109 inc(p);
110 end;
111 if (p<=ExpectedP) and (p^<>#0) then begin
112 writeln('= ',ExpLine);
113 end else begin
114 // diff line
115 // write actual line
116 ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
117 ActLineEndP:=FindLineEnd(ActualP);
118 ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
119 writeln('- ',ActLine);
120 // write expected line
121 writeln('+ ',ExpLine);
122 // write empty line with pointer ^
123 for i:=1 to 2+ExpectedP-StartPos do write(' ');
124 writeln('^');
125 AssertEquals(Msg,ExpLine,ActLine);
126 break;
127 end;
128 until p^=#0;
129
130 writeln('DiffFound Actual:-----------------------');
131 writeln(Actual);
132 writeln('DiffFound Expected:---------------------');
133 writeln(Expected);
134 writeln('DiffFound ------------------------------');
135 Fail('diff found, but lines are the same, internal error');
136 end;
137
138 var
139 IsSpaceNeeded: Boolean;
140 LastChar: Char;
141 begin
142 if Expected='' then Expected:=' ';
143 if Actual='' then Actual:=' ';
144 ExpectedP:=PChar(Expected);
145 ActualP:=PChar(Actual);
146 repeat
147 //writeln('TTestCodeCompletion.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
148 case ExpectedP^ of
149 #0:
150 begin
151 // check that rest of Actual has only spaces
152 while ActualP^ in SpaceChars do inc(ActualP);
153 if ActualP^<>#0 then
154 DiffFound;
155 exit;
156 end;
157 ' ',#9,#10,#13:
158 begin
159 // skip space in Expected
160 IsSpaceNeeded:=false;
161 if ExpectedP>PChar(Expected) then
162 LastChar:=ExpectedP[-1]
163 else
164 LastChar:=#0;
165 while ExpectedP^ in SpaceChars do inc(ExpectedP);
166 if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
167 and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
168 IsSpaceNeeded:=true;
169 if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
170 DiffFound;
171 while ActualP^ in SpaceChars do inc(ActualP);
172 end;
173 else
174 while ActualP^ in SpaceChars do inc(ActualP);
175 if ExpectedP^<>ActualP^ then
176 DiffFound;
177 inc(ExpectedP);
178 inc(ActualP);
179 end;
180 until false;
181 end;
182
183 procedure TCustomTestCTStdCodetools.WriteSource(aFilename: string; Line, Col: integer
184 );
185 var
186 Code: TCodeBuffer;
187 s: String;
188 i: Integer;
189 begin
190 writeln('Testcode:-File="',aFilename,'"----------------------------------:');
191
192 Code:=CodeToolBoss.FindFile(aFilename);
193 if Code=nil then
194 Fail('file was not loaded/created: "'+aFilename+'"');
195 for i:=1 to Code.LineCount do begin
196 s:=Code.GetLine(i-1,true);
197 if i=Line then begin
198 write('*');
199 s:=LeftStr(s,Col-1)+'|'+copy(s,Col,length(s));
200 end;
201 if (s='') or not (s[length(s)] in [#10,#13]) then
202 s+=LineEnding;
203 write(Format('%:4d: ',[i]),s);
204 end;
205 end;
206
207 procedure TTestCTStdCodetools.DoTestAddUnitWarn(Title: string; Src,
208 Expected: array of string; WarnID, Comment: string; TurnOn: boolean);
209 var
210 Code: TCodeBuffer;
211 s: String;
212 i: Integer;
213 begin
214 Code:=CodeToolBoss.CreateFile('test1.pas');
215 s:='';
216 for i:=Low(Src) to High(Src) do
217 s+=Src[i]+LineEnding;
218 Code.Source:=s;
219
220 if not CodeToolBoss.AddUnitWarnDirective(Code,WarnID,Comment,TurnOn) then begin
221 WriteSource(Code.Filename,1,1);
222 Fail(Title+'call AddUnitWarnDirective failed: '+CodeToolBoss.ErrorDbgMsg);
223 end;
224
225 //debugln(['TTestCTStdCodetools.DoTestAddUnitWarn NewSrc=',Code.Source]);
226 s:='';
227 for i:=Low(Expected) to High(Expected) do
228 s+=Expected[i]+LineEnding;
229 CheckDiff(Title,s,Code.Source);
230 end;
231
232 procedure TTestCTStdCodetools.DoTestAddUnitToMainUses(NewUnitName, NewUnitInFilename, UsesSrc, ExpectedUsesSrc: string;
233 const Flags: TAddUsesFlags);
234 var
235 Header: String;
236 Footer: String;
237 Code: TCodeBuffer;
238 Src: String;
239 begin
240 Header:='program TestStdCodeTools;'+LineEnding;
241 Footer:=LineEnding
242 +'begin'+LineEnding
243 +'end.'+LineEnding;
244 Code:=CodeToolBoss.CreateFile('TestStdCodeTools.pas');
245 Code.Source:=Header+UsesSrc+Footer;
246 if not CodeToolBoss.AddUnitToMainUsesSectionIfNeeded(Code,NewUnitName,NewUnitInFilename,Flags) then
247 begin
248 AssertEquals('AddUnitToMainUsesSectionIfNeeded failed: '+CodeToolBoss.ErrorMessage,true,false);
249 end else begin
250 Src:=Code.Source;
251 AssertEquals('AddUnitToMainUsesSectionIfNeeded altered header: ',Header,LeftStr(Src,length(Header)));
252 System.Delete(Src,1,length(Header));
253 AssertEquals('AddUnitToMainUsesSectionIfNeeded altered footer: ',Footer,RightStr(Src,length(Footer)));
254 System.Delete(Src,length(Src)-length(Footer)+1,length(Footer));
255 if ExpectedUsesSrc<>Src then
256 debugln(Code.Source);
257 AssertEquals('AddUnitToMainUsesSectionIfNeeded: ',ExpectedUsesSrc,Src);
258 end;
259 end;
260
261 procedure TTestCTStdCodetools.TestCTStdFindBlockStart;
262 var
263 Code: TCodeBuffer;
264
GetSourcenull265 function GetSource: string;
266 begin
267 Result:=
268 'program TestStdCodeTools;'+LineEnding
269 +'begin'+LineEnding
270 +' if true then {begin1}begin'+LineEnding
271 +' {try1}try'+LineEnding
272 +' writeln;'+LineEnding
273 +' {try1finally}finally'+LineEnding
274 +' writeln;'+LineEnding
275 +' {try1end}end;'+LineEnding
276 +' writeln;'+LineEnding
277 +' {begin1end}end;'+LineEnding
278 +'end.'+LineEnding;
279 end;
280
GetInfonull281 function GetInfo(XY: TPoint): string;
282 var
283 Line: String;
284 begin
285 Line:=Code.GetLine(XY.Y-1);
286 Result:=dbgs(XY)+': '+copy(Line,1,XY.X-1)+'|'+copy(Line,XY.X,length(Line));
287 end;
288
289 procedure Test(aTitle, StartMarker,EndMarker: string);
290 var
291 BlockStart: TPoint;
292 BlockEnd: TPoint;
293 NewCode: TCodeBuffer;
294 NewX: integer;
295 NewY: integer;
296 NewTopline: integer;
297 begin
298 if not GetCTMarker(Code,StartMarker,BlockStart) then exit;
299 if not GetCTMarker(Code,EndMarker,BlockEnd) then exit;
300 //debugln(['TTestCTStdCodetools.TestCTStdFindBlockStart BlockStart=',GetInfo(BlockStart),' BlockEnd=',GetInfo(BlockEnd)]);
301 if not CodeToolBoss.FindBlockStart(Code,BlockEnd.X,BlockEnd.Y,NewCode,NewX,NewY,NewTopline)
302 then
303 AssertEquals(aTitle+': '+CodeToolBoss.ErrorMessage,true,false)
304 else
305 AssertEquals(aTitle,GetInfo(BlockStart),GetInfo(Point(NewX,NewY)))
306 end;
307
308 begin
309 Code:=CodeToolBoss.CreateFile('TestStdCodeTools.pas');
310 Code.Source:=GetSource();
311
312 Test('begin,try,finally,end|end','begin1','begin1end');
313 Test('begin,try,finally,|end,end','try1finally','try1end');
314 Test('begin,try,finally,|end,end','try1','try1finally');
315 end;
316
317 procedure TTestCTStdCodetools.TestCTUses_AddUses_Start;
318 begin
319 DoTestAddUnitToMainUses('Foo','',
320 '',
321 LineEnding+'uses Foo;'+LineEnding,
322 []);
323 end;
324
325 procedure TTestCTStdCodetools.TestCTUses_AddUses_Append;
326 begin
327 DoTestAddUnitToMainUses('Foo','',
328 'uses Abc;'+LineEnding,
329 'uses Abc, Foo;'+LineEnding,
330 []);
331 end;
332
333 procedure TTestCTStdCodetools.TestCTUses_AddUses_AppendKeepSpaces;
334 begin
335 DoTestAddUnitToMainUses('Foo','',
336 'uses Go, Bla;'+LineEnding,
337 'uses Go, Bla, Foo;'+LineEnding,
338 []);
339 end;
340
341 procedure TTestCTStdCodetools.TestCTUses_AddUses_AppendKeepComment;
342 begin
343 exit;
344
345 DoTestAddUnitToMainUses('Foo','',
346 'uses Go, {Comment} Bla;'+LineEnding,
347 'uses Go, {Comment} Bla, Foo;'+LineEnding,
348 []);
349 end;
350
351 procedure TTestCTStdCodetools.TestCTUses_AddUses_Append_DottedNoBreak;
352 var
353 Beauty: TBeautifyCodeOptions;
354 OldLineLength: Integer;
355 OldDoNotSplitLineInFront, OldDoNotSplitLineAfter: TAtomTypes;
356 begin
357 Beauty:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions;
358 OldLineLength:=Beauty.LineLength;
359 OldDoNotSplitLineInFront:=Beauty.DoNotSplitLineInFront;
360 OldDoNotSplitLineAfter:=Beauty.DoNotSplitLineAfter;
361 try
362 Beauty.LineLength:=35;
363 Beauty.DoNotSplitLineInFront:=Beauty.DoNotSplitLineInFront-[atPoint];// test that atPoint has no effect
364 Beauty.DoNotSplitLineAfter:=Beauty.DoNotSplitLineAfter-[atPoint];// test that atPoint has no effect
365 DoTestAddUnitToMainUses('System.SysUtils','',
366 'uses System.Classes;'+LineEnding,
367 'uses System.Classes,'+LineEnding
368 +' System.SysUtils;'+LineEnding,
369 []);
370 finally
371 Beauty.LineLength:=OldLineLength;
372 Beauty.DoNotSplitLineInFront:=OldDoNotSplitLineInFront;
373 Beauty.DoNotSplitLineAfter:=OldDoNotSplitLineAfter;
374 end;
375 end;
376
377 procedure TTestCTStdCodetools.TestCTUses_RemoveFromAllUsesSections;
378
GetSourcenull379 function GetSource(UsesSrc: string): string;
380 begin
381 Result:='program TestStdCodeTools;'+LineEnding
382 +UsesSrc;
383 end;
384
385 procedure Test(RemoveUnit, UsesSrc, ExpectedUsesSrc: string);
386 var
387 Header: String;
388 Footer: String;
389 Code: TCodeBuffer;
390 Src: String;
391 begin
392 Header:=GetSource('');
393 Footer:=LineEnding
394 +'begin'+LineEnding
395 +'end.'+LineEnding;
396 Code:=CodeToolBoss.CreateFile('TestStdCodeTools.pas');
397 Code.Source:=Header+UsesSrc+Footer;
398 if not CodeToolBoss.RemoveUnitFromAllUsesSections(Code,RemoveUnit) then
399 begin
400 AssertEquals('RemoveUnitFromAllUsesSections failed: '+CodeToolBoss.ErrorMessage,true,false);
401 end else begin
402 Src:=Code.Source;
403 AssertEquals('RemoveUnitFromAllUsesSections altered header: ',Header,LeftStr(Src,length(Header)));
404 System.Delete(Src,1,length(Header));
405 AssertEquals('RemoveUnitFromAllUsesSections altered footer: ',Footer,RightStr(Src,length(Footer)));
406 System.Delete(Src,length(Src)-length(Footer)+1,length(Footer));
407 AssertEquals('RemoveUnitFromAllUsesSections: ',ExpectedUsesSrc,Src);
408 end;
409 end;
410
411 begin
412 // remove first unit
413 Test('windows',
414 'uses'+LineEnding
415 +' Windows, Messages, Forms,'+LineEnding
416 +' Dialogs, inifiles;'+LineEnding
417 ,
418 'uses'+LineEnding
419 +' Messages, Forms,'+LineEnding
420 +' Dialogs, inifiles;'+LineEnding
421 );
422
423 // remove middle unit
424 Test('shellapi',
425 'uses'+LineEnding
426 +' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,'+LineEnding
427 +' Dialogs, shellAPI, StdCtrls, ExtCtrls, ComCtrls, strutils, Buttons, inifiles;'+LineEnding
428 ,
429 'uses'+LineEnding
430 +' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,'+LineEnding
431 +' Dialogs, StdCtrls, ExtCtrls, ComCtrls, strutils, Buttons, inifiles;'+LineEnding
432 );
433
434 // remove first unit in second line
435 Test('shellapi',
436 'uses'+LineEnding
437 +' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,'+LineEnding
438 +' shellAPI, StdCtrls, ExtCtrls, ComCtrls, strutils, Buttons, inifiles;'+LineEnding
439 ,
440 'uses'+LineEnding
441 +' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,'+LineEnding
442 +' StdCtrls, ExtCtrls, ComCtrls, strutils, Buttons, inifiles;'+LineEnding
443 );
444
445 // remove last unit in first line
446 Test('forms',
447 'uses'+LineEnding
448 +' Windows, Messages, Forms,'+LineEnding
449 +' Dialogs, inifiles;'+LineEnding
450 ,
451 'uses'+LineEnding
452 +' Windows, Messages,'+LineEnding
453 +' Dialogs, inifiles;'+LineEnding
454 );
455
456 // remove last unit
457 Test('inifiles',
458 'uses'+LineEnding
459 +' Windows, Messages, Forms,'+LineEnding
460 +' Dialogs, inifiles;'+LineEnding
461 ,
462 'uses'+LineEnding
463 +' Windows, Messages, Forms,'+LineEnding
464 +' Dialogs;'+LineEnding
465 );
466 end;
467
468 procedure TTestCTStdCodetools.TestCTAddWarn5025_Program;
469 begin
470 DoTestAddUnitWarn(
471 'TestCTAddUnitWarn',
472 ['program test1;'
473 ,'begin'
474 ,'end.'],
475 ['program test1;'
476 ,'{$WARN 5025 off}'
477 ,'begin'
478 ,'end.'],'5025','',false);
479 end;
480
481 procedure TTestCTStdCodetools.TestCTAddWarn5025_ProgramNoName;
482 begin
483 DoTestAddUnitWarn(
484 'TestCTAddUnitWarn',
485 ['begin'
486 ,'end.'],
487 ['{$WARN 5025 off}'
488 ,'begin'
489 ,'end.'],'5025','',false);
490 end;
491
492 procedure TTestCTStdCodetools.TestCTAddWarn5025_Unit;
493 begin
494 DoTestAddUnitWarn(
495 'TestCTAddUnitWarn',
496 ['unit test1;'
497 ,'interface'
498 ,'end.'],
499 ['unit test1;'
500 ,'{$WARN 5025 off}'
501 ,'interface'
502 ,'end.'],'5025','',false);
503 end;
504
505 initialization
506 RegisterTest(TTestCTStdCodetools);
507
508 end.
509
510