1 { Copyright (C) 2004 Vincent Snijders
2
3 This library is free software; you can redistribute it and/or modify it
4 under the terms of the GNU Library General Public License as published by
5 the Free Software Foundation; either version 2 of the License, or (at your
6 option) any later version.
7
8 This program is distributed in the hope that it will be useful, but WITHOUT
9 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
10 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
11 for more details.
12
13 You should have received a copy of the GNU Library General Public License
14 along with this library; if not, write to the Free Software Foundation,
15 Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
16
17
18 Abstract:
19 This unit adds a new project type and a new unit type to the IDE.
20 New Project Type:
21 FPCUnit Application - A Free Pascal program for FPCUnit tests.
22
23 New Unit Type:
24 FPCUnit test - A unit with a unit test.
25
26 See the README file for more information.
27 }
28 unit FPCUnitLazIDEIntf;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, LazIDEIntf, ProjectIntf, Controls, Forms, testcaseopts, strtestcaseopts;
36
37 type
38 { TFPCUnitApplicationDescriptor }
39
40 TFPCUnitApplicationDescriptor = class(TProjectDescriptor)
41 public
42 constructor Create; override;
GetLocalizedNamenull43 function GetLocalizedName: string; override;
GetLocalizedDescriptionnull44 function GetLocalizedDescription: string; override;
InitProjectnull45 function InitProject(AProject: TLazProject): TModalResult; override;
CreateStartFilesnull46 function CreateStartFiles({%H-}AProject: TLazProject): TModalResult; override;
47 end;
48
49 { TFPCUnitConsoleApplicationDescriptor }
50
51 TFPCUnitConsoleApplicationDescriptor = class(TProjectDescriptor)
52 public
53 constructor Create; override;
GetLocalizedNamenull54 function GetLocalizedName: string; override;
GetLocalizedDescriptionnull55 function GetLocalizedDescription: string; override;
InitProjectnull56 function InitProject(AProject: TLazProject): TModalResult; override;
CreateStartFilesnull57 function CreateStartFiles({%H-}AProject: TLazProject): TModalResult; override;
58 end;
59
60 { TFileDescPascalUnitFPCUnitTestCase }
61
62 TFileDescPascalUnitFPCUnitTestCase = class(TFileDescPascalUnit)
63 private
64 FTestCaseName: string;
65 FCreateSetup: boolean;
66 FCreateTearDown: boolean;
67 public
68 constructor Create; override;
CreateSourcenull69 function CreateSource(const Filename, SourceName,
70 ResourceName: string): string; override;
GetInterfaceUsesSectionnull71 function GetInterfaceUsesSection: string; override;
GetLocalizedNamenull72 function GetLocalizedName: string; override;
GetLocalizedDescriptionnull73 function GetLocalizedDescription: string; override;
GetInterfaceSourcenull74 function GetInterfaceSource(const {%H-}Filename, {%H-}SourceName,
75 {%H-}ResourceName: string): string;override;
GetImplementationSourcenull76 function GetImplementationSource(const {%H-}Filename, {%H-}SourceName,
77 {%H-}ResourceName: string): string; override;
78 property TestCaseName: string read FTestCaseName write FTestCaseName;
79 property CreateSetup: boolean read FCreateSetup write FCreateSetup;
80 property CreateTeardown: boolean read FCreateTeardown write FCreateTeardown;
81 end;
82
83 var
84 ProjectDescriptorFPCUnitApplication: TFPCUnitApplicationDescriptor;
85 ProjectDescriptorFPCUnitConsoleApp: TFPCUnitConsoleApplicationDescriptor;
86 FileDescriptorFPCUnitTestCase: TFileDescPascalUnitFPCUnitTestCase;
87
88 procedure Register;
89
90 implementation
91
92 procedure Register;
93 begin
94 FileDescriptorFPCUnitTestCase:=TFileDescPascalUnitFPCUnitTestCase.Create;
95 RegisterProjectFileDescriptor(FileDescriptorFPCUnitTestCase);
96 ProjectDescriptorFPCUnitConsoleApp := TFPCUnitConsoleApplicationDescriptor.Create;
97 RegisterProjectDescriptor(ProjectDescriptorFPCUnitConsoleApp);
98 ProjectDescriptorFPCUnitApplication:=TFPCUnitApplicationDescriptor.Create;
99 RegisterProjectDescriptor(ProjectDescriptorFPCUnitApplication);
100 end;
101
102 { TFPCUnitApplicationDescriptor }
103
104 constructor TFPCUnitApplicationDescriptor.Create;
105 begin
106 inherited Create;
107 Name:='FPCUnit Application';
108 end;
109
TFPCUnitApplicationDescriptor.GetLocalizedNamenull110 function TFPCUnitApplicationDescriptor.GetLocalizedName: string;
111 begin
112 Result:=sFPCUnTestApp;
113 end;
114
GetLocalizedDescriptionnull115 function TFPCUnitApplicationDescriptor.GetLocalizedDescription: string;
116 begin
117 Result:=sFPCUnTestAppDesc;
118 end;
119
InitProjectnull120 function TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
121 var
122 le: string;
123 NewSource: String;
124 MainFile: TLazProjectFile;
125 begin
126 inherited InitProject(AProject);
127
128 MainFile:=AProject.CreateProjectFile('fpcunitproject1.lpr');
129 MainFile.IsPartOfProject:=true;
130 AProject.AddFile(MainFile,false);
131 AProject.MainFileID:=0;
132 AProject.UseAppBundle:=true;
133 AProject.UseManifest:=true;
134 AProject.LoadDefaultIcon;
135
136 // create program source
137 le:=LineEnding;
138 NewSource:='program FPCUnitProject1;'+le
139 +le
140 +'{$mode objfpc}{$H+}'+le
141 +le
142 +'uses'+le
143 +' Interfaces, Forms, GuiTestRunner;'+le
144 +le
145 +'begin'+le
146 +' Application.Initialize;'+le
147 +' Application.CreateForm(TGuiTestRunner, TestRunner);'+le
148 +' Application.Run;'+le
149 +'end.'+le
150 +le;
151 AProject.MainFile.SetSourceText(NewSource);
152
153 // add
154 AProject.AddPackageDependency('FCL');
155 AProject.AddPackageDependency('LCL');
156 AProject.AddPackageDependency('fpcunittestrunner');
157
158 // compiler options
159 AProject.LazCompilerOptions.UseLineInfoUnit:=true;
160 AProject.LazCompilerOptions.Win32GraphicApp:=true;
161 AProject.LazCompilerOptions.TargetFilename:='fpunitproject1';
162 AProject.LazCompilerOptions.UnitOutputDirectory:='lib'+PathDelim+'$(TargetCPU)-$(TargetOS)';
163 Result:=mrOK;
164 end;
165
TFPCUnitApplicationDescriptor.CreateStartFilesnull166 function TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
167 begin
168 LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
169 [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
170 Result:=mrOK;
171 end;
172
173 { TFileDescPascalUnitFPCUnitTestCase }
174
175 constructor TFileDescPascalUnitFPCUnitTestCase.Create;
176 begin
177 inherited Create;
178 Name:='FPCUnit TestCase';
179 DefaultFilename:='testcase.pas';
180 DefaultSourceName:='TestCase1';
181 end;
182
CreateSourcenull183 function TFileDescPascalUnitFPCUnitTestCase.CreateSource(const Filename,
184 SourceName, ResourceName: string): string;
185 var
186 LE: string;
187 begin
188 CreateSetup := false;
189 CreateTeardown := false;
190 LE:=LineEnding;
191 with TTestCaseOptionsForm.Create(nil) do
192 try
193 edDefaultName.Text := 'T' + SourceName;
194 ShowModal;
195 if edDefaultName.Text <> '' then
196 TestCaseName := edDefaultName.Text
197 else
198 TestCaseName:= 'T' + SourceName;
199 if cbSetup.Checked then
200 CreateSetup := True
201 else
202 CreateSetup := False;
203 if cbTeardown.Checked then
204 CreateTeardown := True
205 else
206 CreateTeardown := False;
207 finally
208 Free;
209 end;
210 Result:=
211 'unit '+SourceName+';'+LE
212 +LE
213 +'{$mode objfpc}{$H+}'+LE
214 +LE
215 +'interface'+LE
216 +LE
217 +'uses'+LE
218 +' '+GetInterfaceUsesSection+';'+LE
219 +LE
220 +GetInterfaceSource(Filename,SourceName,ResourceName)
221 +'implementation'+LE
222 +LE
223 +GetImplementationSource(Filename,SourceName,ResourceName)
224 +'end.'+LE
225 +LE;
226 end;
227
TFileDescPascalUnitFPCUnitTestCase.GetInterfaceUsesSectionnull228 function TFileDescPascalUnitFPCUnitTestCase.GetInterfaceUsesSection: string;
229 begin
230 Result:=inherited GetInterfaceUsesSection;
231 Result:=Result+', fpcunit, testutils, testregistry';
232 end;
233
TFileDescPascalUnitFPCUnitTestCase.GetLocalizedNamenull234 function TFileDescPascalUnitFPCUnitTestCase.GetLocalizedName: string;
235 begin
236 Result:=sFPCUnTestCase;
237 end;
238
GetLocalizedDescriptionnull239 function TFileDescPascalUnitFPCUnitTestCase.GetLocalizedDescription: string;
240 begin
241 Result:=sFPCUnTestCaseDesc;
242 end;
243
GetInterfaceSourcenull244 function TFileDescPascalUnitFPCUnitTestCase.GetInterfaceSource(const Filename,
245 SourceName, ResourceName: string): string;
246 var
247 le: string;
248 setupMethod: string;
249 teardownMethod: string;
250 protectedSection: string;
251 begin
252 le:=System.LineEnding;
253 if CreateSetup or CreateTeardown then
254 protectedSection := ' protected' + le;
255 if CreateSetup then
256 setupMethod := ' procedure SetUp; override;' + le;
257 if CreateTeardown then
258 teardownMethod := ' procedure TearDown; override;' + le;
259 Result := 'type' + le
260 + le
261 +' '+TestCaseName+'= class(TTestCase)'+le
262 + protectedSection
263 + setupMethod
264 + teardownMethod
265 +' published'+le
266 +' procedure TestHookUp;'+le
267 +' end;'+le+le;
268 end;
269
GetImplementationSourcenull270 function TFileDescPascalUnitFPCUnitTestCase.GetImplementationSource(
271 const Filename, SourceName, ResourceName: string): string;
272 var
273 le: string;
274 setupMethod: string;
275 teardownMethod: string;
276 begin
277 le:=System.LineEnding;
278 if CreateSetup then
279 setupMethod := 'procedure '+TestCaseName+'.SetUp;'+le
280 +'begin'+le
281 +le
282 +'end;'+le;
283 if CreateTeardown then
284 teardownMethod := 'procedure '+TestCaseName+'.TearDown;'+le
285 +'begin'+le
286 +le
287 +'end;'+le;
288 Result:='procedure '+TestCaseName+'.TestHookUp;'+le
289 +'begin'+le
290 +' Fail('+QuotedStr(sWriteYourOwnTest)+');'+le
291 +'end;'+le
292 +le
293 +setupMethod
294 +le
295 +teardownMethod
296 +le
297 +'Initialization'+le
298 +le
299 +' RegisterTest('+TestCaseName+');'
300 +le;
301 end;
302
303 { TFPCUnitConsoleApplicationDescriptor }
304
305 constructor TFPCUnitConsoleApplicationDescriptor.Create;
306 begin
307 inherited Create;
308 Name:='FPCUnit Console Application';
309 end;
310
TFPCUnitConsoleApplicationDescriptor.GetLocalizedNamenull311 function TFPCUnitConsoleApplicationDescriptor.GetLocalizedName: string;
312 begin
313 Result:=sFPCUnConsoleTestApp;
314 end;
315
GetLocalizedDescriptionnull316 function TFPCUnitConsoleApplicationDescriptor.GetLocalizedDescription: string;
317 begin
318 Result:=sFPCUnConsoleTestDesc;
319 end;
320
InitProjectnull321 function TFPCUnitConsoleApplicationDescriptor.InitProject(
322 AProject: TLazProject): TModalResult;
323 var
324 NewSource: string;
325 MainFile: TLazProjectFile;
326 begin
327 inherited InitProject(AProject);
328
329 MainFile:=AProject.CreateProjectFile('fpcunitproject1.lpr');
330 MainFile.IsPartOfProject:=true;
331 AProject.AddFile(MainFile,false);
332 AProject.MainFileID:=0;
333
334 // create program source
335 {$i fpcunitproject1.inc}
336
337 AProject.MainFile.SetSourceText(NewSource);
338
339 // add FCL dependency
340 AProject.AddPackageDependency('FCL');
341
342 // compiler options
343 AProject.LazCompilerOptions.UseLineInfoUnit:=true;
344 AProject.LazCompilerOptions.TargetFilename:='fpunitproject1';
345 AProject.LazCompilerOptions.UnitOutputDirectory:='lib'+PathDelim+'$(TargetCPU)-$(TargetOS)';
346 Result:=mrOK;
347 end;
348
TFPCUnitConsoleApplicationDescriptor.CreateStartFilesnull349 function TFPCUnitConsoleApplicationDescriptor.CreateStartFiles(
350 AProject: TLazProject): TModalResult;
351 begin
352 LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
353 [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
354 Result:=mrOK;
355 end;
356
357 end.
358
359