← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to test/codetoolstests/testcompleteblock.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/codetoolstests/testcompleteblock.pas
 
1
{
 
2
 Test all with:
 
3
     ./runtests --format=plain --suite=TTestCodetoolsCompleteBlock
 
4
 
 
5
 Test specific with:
 
6
     ./runtests --format=plain --suite=TestCompleteBlockClassStart
 
7
     ./runtests --format=plain --suite=TestCompleteBlockBegin
 
8
     ./runtests --format=plain --suite=TestCompleteBlockRepeat
 
9
     ./runtests --format=plain --suite=TestCompleteBlockCase
 
10
     ./runtests --format=plain --suite=TestCompleteBlockTry
 
11
     ./runtests --format=plain --suite=TestCompleteBlockAsm
 
12
     ./runtests --format=plain --suite=TestCompleteBlockIf
 
13
}
1
14
unit TestCompleteBlock;
2
15
 
3
16
{$mode objfpc}{$H+}
5
18
interface
6
19
 
7
20
uses
8
 
  fpcunit, Classes, SysUtils;
 
21
  Classes, SysUtils, fpcunit, testglobals, FileProcs, CodeToolManager,
 
22
  CodeCache, CustomCodeTool;
9
23
 
10
24
type
11
 
  { TCodeBlocksTest }
12
 
 
13
 
  TCodeBlocksTest = class(TTestCase)
14
 
  protected
15
 
    function CompareComplete(const InputDefines, ResultFile: String): Boolean;
 
25
 
 
26
  { TTestCodetoolsCompleteBlock }
 
27
 
 
28
  TTestCodetoolsCompleteBlock = class(TTestCase)
 
29
  private
 
30
    function CreateFullSrc(Src: string; out Cursor: integer): string;
 
31
    procedure TestCompleteBlocks;
 
32
  public
 
33
    procedure CompleteBlock(Src, ExpectedSrc: string;
 
34
                OnlyIfCursorBlockIndented: boolean = false);
 
35
    procedure CompleteBlock(Src: string; OnlyIfCursorBlockIndented: boolean = false);
 
36
    procedure CompleteBlockFail(Src: string;
 
37
                OnlyIfCursorBlockIndented: boolean = false);
16
38
  published
17
 
    procedure TestCompleteBlocks;
 
39
    procedure TestCompleteBlockClassStart;
 
40
    procedure TestCompleteBlockBegin;
 
41
    procedure TestCompleteBlockRepeat;
 
42
    procedure TestCompleteBlockCase;
 
43
    procedure TestCompleteBlockTry;
 
44
    procedure TestCompleteBlockAsm;
 
45
    procedure TestCompleteBlockIf;
18
46
  end;
19
47
 
20
48
implementation
21
49
 
22
 
{ TCodeBlocksTest }
23
 
 
24
 
function TCodeBlocksTest.CompareComplete(const InputFile, InputDefines, ResultFile: String): Boolean;
25
 
var
26
 
  st : TStringList;
27
 
  rs : TStringList;
28
 
 
29
 
  function StripSpaceChars(const s: string): String;
 
50
{ TTestCodetoolsCompleteBlock }
 
51
 
 
52
procedure TTestCodetoolsCompleteBlock.TestCompleteBlocks;
 
53
 
 
54
  procedure CompareComplete(a,b,c: string);
30
55
  begin
31
 
    // removes all [#10,#13,#9, #32] chars, giving a line: "beginwriteln('helloworld');end."
32
 
    Result:=s;
33
 
    for i:=length(Result) downto 1 do
34
 
      if Result[i] in [#10,#13,#9,' '] then
35
 
        System.Delete(Result,i,1);
 
56
    writeln('CompareComplete ',a,',',b,',',c);
36
57
  end;
37
 
begin
38
 
  // ToDo: fix path to completeblock, InputFile nd ResultFile
39
 
  st := GetProcessOutput('completeblock '+InputFile+' '+inputdefines); // reads all output from blockcompleted file
40
 
  // remove debugging output and take only the new source
41
 
  while (st.Count>0) and (st[0]<>'{%MainUnit unit1.pas}') do st.Delete(0);
42
 
  // reads the correct result file
43
 
  rs.LoadFromFile(resultfile);
44
 
  // check result
45
 
  AssertEquals(StripSpaceChars(st.text), StripSpaceChars(rs.text)); // compares resulting strings
46
 
end;
47
58
 
48
 
procedure TCodeBlocksTest.TestCompleteBlocks;
49
59
begin
50
60
  CompareComplete('ifbeginelse1.inc','6 28 ifbeginelse fpcunit', 'ifbeginelse1_result.inc');
51
61
  CompareComplete('whilebegin1.inc','5 10 whilebegin fpcunit', 'whilebegin1_result.inc');
65
75
  CompareComplete('tryif1.inc','4 6 tryif fpcunit', 'tryif1_result.inc');
66
76
end;
67
77
 
 
78
function TTestCodetoolsCompleteBlock.CreateFullSrc(Src: string;
 
79
  out Cursor: integer): string;
 
80
begin
 
81
  Result:=Src;
 
82
  {Result:='unit testcompleteblock;'+LineEnding
 
83
         +'interface'+LineEnding
 
84
         +Src;}
 
85
  if not (Result[length(Result)] in [#10,#13]) then
 
86
    Result:=Result+LineEnding;
 
87
  Cursor:=System.Pos('|',Result);
 
88
  System.Delete(Result,Cursor,1);
 
89
end;
 
90
 
 
91
procedure TTestCodetoolsCompleteBlock.CompleteBlock(Src, ExpectedSrc: string;
 
92
  OnlyIfCursorBlockIndented: boolean);
 
93
var
 
94
  Code: TCodeBuffer;
 
95
  p: integer;
 
96
  Y: integer;
 
97
  X: integer;
 
98
  NewCode: TCodeBuffer;
 
99
  NewX: integer;
 
100
  NewY: integer;
 
101
  NewTopLine: integer;
 
102
  ExpectedCode: TCodeBuffer;
 
103
  ep: integer;
 
104
  eY: integer;
 
105
  eX: integer;
 
106
  FullSrc: String;
 
107
  FullExpectedSrc: String;
 
108
  TrimExpected: String;
 
109
  TrimResult: String;
 
110
begin
 
111
  AssertEquals('Src is empty',Trim(Src)<>'',true);
 
112
  AssertEquals('ExpectedSrc is empty',Trim(ExpectedSrc)<>'',true);
 
113
 
 
114
  ExpectedCode:=TCodeBuffer.Create;
 
115
  try
 
116
    // replace cursor | marker in Src
 
117
    Code:=CodeToolBoss.CreateFile('TestCompleteBlock.pas');
 
118
    FullSrc:=CreateFullSrc(Src,p);
 
119
    if p<1 then
 
120
      AssertEquals('missing cursor | in test source: "'+dbgstr(Src)+'"',true,false);
 
121
    Code.Source:=FullSrc;
 
122
    Code.AbsoluteToLineCol(p,Y,X);
 
123
 
 
124
    // replace cursor | marker in ExpectedSrc
 
125
    FullExpectedSrc:=CreateFullSrc(ExpectedSrc,ep);
 
126
    if ep<1 then
 
127
      AssertEquals('missing cursor | in expected source: "'+dbgstr(ExpectedSrc)+'"',true,false);
 
128
    ExpectedCode.Source:=FullExpectedSrc;
 
129
    ExpectedCode.AbsoluteToLineCol(ep,eY,eX);
 
130
 
 
131
    if not CodeToolBoss.CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
 
132
      NewCode,NewX,NewY,NewTopLine)
 
133
    then begin
 
134
      AssertEquals('CodeToolBoss.CompleteBlock returned false for src="'+dbgstr(Src)+'"',true,false);
 
135
      exit;
 
136
    end;
 
137
    TrimExpected:=dbgstr(Trim(FullExpectedSrc));
 
138
    TrimResult:=dbgstr(Trim(Code.Source));
 
139
    if TrimExpected<>TrimResult then begin
 
140
      debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED Expected:']);
 
141
      debugln(FullExpectedSrc);
 
142
      debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED Found:']);
 
143
      debugln(Code.Source);
 
144
      debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED end']);
 
145
    end;
 
146
    AssertEquals('CompleteBlock did no or the wrong completion: ',TrimExpected,TrimResult);
 
147
 
 
148
  finally
 
149
    ExpectedCode.Free;
 
150
  end;
 
151
end;
 
152
 
 
153
procedure TTestCodetoolsCompleteBlock.CompleteBlock(Src: string;
 
154
  OnlyIfCursorBlockIndented: boolean);
 
155
begin
 
156
  CompleteBlock(Src,Src,OnlyIfCursorBlockIndented);
 
157
end;
 
158
 
 
159
procedure TTestCodetoolsCompleteBlock.CompleteBlockFail(Src: string;
 
160
  OnlyIfCursorBlockIndented: boolean);
 
161
var
 
162
  Code: TCodeBuffer;
 
163
  p: integer;
 
164
  FullSrc: String;
 
165
  Y: integer;
 
166
  X: integer;
 
167
  NewCode: TCodeBuffer;
 
168
  NewX: integer;
 
169
  NewY: integer;
 
170
  NewTopLine: integer;
 
171
begin
 
172
  AssertEquals('Src is empty',Trim(Src)<>'',true);
 
173
 
 
174
  // replace cursor | marker in Src
 
175
  Code:=CodeToolBoss.CreateFile('TestCompleteBlock.pas');
 
176
  FullSrc:=CreateFullSrc(Src,p);
 
177
  if p<1 then
 
178
    AssertEquals('missing cursor | in test source: "'+dbgstr(Src)+'"',true,false);
 
179
  Code.Source:=FullSrc;
 
180
  Code.AbsoluteToLineCol(p,Y,X);
 
181
 
 
182
  if CodeToolBoss.CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
 
183
    NewCode,NewX,NewY,NewTopLine)
 
184
  then begin
 
185
    debugln(['TTestCodetoolsCompleteBlock.CompleteBlockFail completion: ',dbgstr(Code.Source)]);
 
186
    AssertEquals('CodeToolBoss.CompleteBlock returned true for incompletable src="'+dbgstr(Src)+'"',true,false);
 
187
  end;
 
188
end;
 
189
 
 
190
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockClassStart;
 
191
begin
 
192
  CompleteBlock('type'+LineEnding
 
193
               +'  TTestClass = class(TObject)|',
 
194
                'type'+LineEnding
 
195
               +'  TTestClass = class(TObject)'+LineEnding
 
196
               +'  |end;');
 
197
  CompleteBlock('type'+LineEnding
 
198
               +'  TTestClass = class(TObject)|'+LineEnding
 
199
               +'  TSecondClass =',
 
200
                'type'+LineEnding
 
201
               +'  TTestClass = class(TObject)'+LineEnding
 
202
               +'  |end;'+LineEnding
 
203
               +LineEnding
 
204
               +'  TSecondClass =');
 
205
  CompleteBlock('type'+LineEnding
 
206
               +'  TTestClass = class(TObject)|'+LineEnding
 
207
               +'implementation',
 
208
                'type'+LineEnding
 
209
               +'  TTestClass = class(TObject)'+LineEnding
 
210
               +'  |end;'+LineEnding
 
211
               +LineEnding
 
212
               +'implementation');
 
213
end;
 
214
 
 
215
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockBegin;
 
216
begin
 
217
  CompleteBlock('begin'+LineEnding
 
218
               +'  begin|'+LineEnding
 
219
               +'end.',
 
220
                'begin'+LineEnding
 
221
               +'  begin|'+LineEnding
 
222
               +'  end;'+LineEnding
 
223
               +'end.');
 
224
  CompleteBlock('begin'+LineEnding
 
225
               +'  while do begin|'+LineEnding
 
226
               +'end.',
 
227
                'begin'+LineEnding
 
228
               +'  while do begin|'+LineEnding
 
229
               +'  end;'+LineEnding
 
230
               +'end.');
 
231
  CompleteBlock('begin'+LineEnding
 
232
               +'  while do'+LineEnding
 
233
               +'    begin|'+LineEnding
 
234
               +'end.',
 
235
                'begin'+LineEnding
 
236
               +'  while do'+LineEnding
 
237
               +'    begin|'+LineEnding
 
238
               +'    end;'+LineEnding
 
239
               +'end.');
 
240
  CompleteBlock('begin'+LineEnding
 
241
               +'  begin|'+LineEnding
 
242
               +'    writeln;'+LineEnding
 
243
               +'end.',
 
244
                'begin'+LineEnding
 
245
               +'  begin|'+LineEnding
 
246
               +'    writeln;'+LineEnding
 
247
               +'  end;'+LineEnding
 
248
               +'end.');
 
249
  CompleteBlock('begin'+LineEnding
 
250
               +'  begin|'+LineEnding
 
251
               +'  writeln;'+LineEnding
 
252
               +'end.',
 
253
                'begin'+LineEnding
 
254
               +'  begin|'+LineEnding
 
255
               +'  end;'+LineEnding
 
256
               +'  writeln;'+LineEnding
 
257
               +'end.');
 
258
  { Not implemented yet:
 
259
  CompleteBlock('procedure a;'+LineEnding
 
260
               +'begin|'+LineEnding
 
261
               +'begin'+LineEnding
 
262
               +'end.',
 
263
                'procedure a;'+LineEnding
 
264
               +'begin|'+LineEnding
 
265
               +'end;'+LineEnding
 
266
               +'begin'+LineEnding
 
267
               +'end.');}
 
268
end;
 
269
 
 
270
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockRepeat;
 
271
begin
 
272
  CompleteBlock('begin'+LineEnding
 
273
               +'  repeat|'+LineEnding
 
274
               +'end.',
 
275
                'begin'+LineEnding
 
276
               +'  repeat|'+LineEnding
 
277
               +'  until ;'+LineEnding
 
278
               +'end.');
 
279
  CompleteBlock(
 
280
     'begin'+LineEnding
 
281
    +'  if FindFirstUTF8(Dir+FileMask,faAnyFile,FileInfo)=0 then begin'+LineEnding
 
282
    +'    repeat'+LineEnding
 
283
    +'      // check if special file'+LineEnding
 
284
    +'      if (FileInfo.Name=''.'') or (FileInfo.Name=''..'') or (FileInfo.Name='''')'+LineEnding
 
285
    +'      then'+LineEnding
 
286
    +'        continue;'+LineEnding
 
287
    +'      |'+LineEnding
 
288
    +'      if FilenameIsPascalUnit(FileInfo.Name,false) then begin'+LineEnding
 
289
    +'        List.Add(Dir+FileInfo.Name);'+LineEnding
 
290
    +'      end else if (FileInfo.Attr and faDirectory)>0 then begin'+LineEnding
 
291
    +'        CollectUnits(Dir+);'+LineEnding
 
292
    +'      end;'+LineEnding
 
293
    +'    until FindNextUTF8(FileInfo)<>0;'+LineEnding
 
294
    +'  end;'+LineEnding
 
295
    +'  FindCloseUTF8(FileInfo);'+LineEnding);
 
296
end;
 
297
 
 
298
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockCase;
 
299
begin
 
300
  CompleteBlock('begin'+LineEnding
 
301
               +'  case of|'+LineEnding
 
302
               +'end.',
 
303
                'begin'+LineEnding
 
304
                +'  case of|'+LineEnding
 
305
                +'  end;'+LineEnding
 
306
               +'end.');
 
307
  CompleteBlock('begin'+LineEnding
 
308
               +'  case of|'+LineEnding
 
309
               +'end.',
 
310
                'begin'+LineEnding
 
311
                +'  case of|'+LineEnding
 
312
                +'  end;'+LineEnding
 
313
               +'end.');
 
314
end;
 
315
 
 
316
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockTry;
 
317
begin
 
318
  CompleteBlock('begin'+LineEnding
 
319
               +'  try|'+LineEnding
 
320
               +'end.',
 
321
                'begin'+LineEnding
 
322
               +'  try|'+LineEnding
 
323
               +'  finally'+LineEnding
 
324
               +'  end;'+LineEnding
 
325
               +'end.');
 
326
  CompleteBlock('begin'+LineEnding
 
327
               +'  try'+LineEnding
 
328
               +'  finally|'+LineEnding
 
329
               +'end.',
 
330
                'begin'+LineEnding
 
331
               +'  try'+LineEnding
 
332
               +'  finally|'+LineEnding
 
333
               +'  end;'+LineEnding
 
334
               +'end.');
 
335
  CompleteBlock('begin'+LineEnding
 
336
               +'  try'+LineEnding
 
337
               +'  except|'+LineEnding
 
338
               +'end.',
 
339
                'begin'+LineEnding
 
340
               +'  try'+LineEnding
 
341
               +'  except|'+LineEnding
 
342
               +'  end;'+LineEnding
 
343
               +'end.');
 
344
end;
 
345
 
 
346
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockAsm;
 
347
begin
 
348
  CompleteBlock('begin'+LineEnding
 
349
               +'  asm|'+LineEnding
 
350
               +'end.',
 
351
                'begin'+LineEnding
 
352
               +'  asm|'+LineEnding
 
353
               +'  end;'+LineEnding
 
354
               +'end.');
 
355
end;
 
356
 
 
357
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockIf;
 
358
begin
 
359
  CompleteBlock('begin'+LineEnding
 
360
               +'  if then begin|'+LineEnding
 
361
               +'end.',
 
362
                'begin'+LineEnding
 
363
               +'  if then begin|'+LineEnding
 
364
               +'  end;'+LineEnding
 
365
               +'end.');
 
366
  CompleteBlock('begin'+LineEnding
 
367
               +'  if then begin|'+LineEnding
 
368
               +'  else'+LineEnding
 
369
               +'end.',
 
370
                'begin'+LineEnding
 
371
               +'  if then begin|'+LineEnding
 
372
               +'  end'+LineEnding
 
373
               +'  else'+LineEnding
 
374
               +'end.');
 
375
  CompleteBlockFail('begin'+LineEnding
 
376
                   +'  try'+LineEnding
 
377
                   +'    if|'+LineEnding
 
378
                   +'  finally'+LineEnding
 
379
                   +'  end;'+LineEnding
 
380
                   +'end.');
 
381
end;
 
382
 
 
383
initialization
 
384
  AddToCodetoolsTestSuite(TTestCodetoolsCompleteBlock);
 
385
 
68
386
end.
69
387