1 {
2 Test all with:
3 ./runtests --format=plain --suite=TTestPas2js
4
5 Test specific with:
6 ./runtests --format=plain --suite=TestPas2js_ReadSettings
7 }
8 unit TestCTPas2js;
9
10 {$mode objfpc}{$H+}
11
12 interface
13
14 uses
15 Classes, SysUtils, CodeToolManager, FileProcs, DefineTemplates, LinkScanner,
16 CodeCache, ExprEval, TestGlobals, LazLogger, LazFileUtils, LazUTF8, fpcunit,
17 testregistry, TestFindDeclaration;
18
19 type
20
21 { TCustomTestPas2js }
22
23 TCustomTestPas2js = class(TCustomTestFindDeclaration)
24 private
25 FAutoSearchPas2js: boolean;
26 FBaseDir: string;
27 FCode: TCodeBuffer;
28 FPas2jsFilename: string;
29 FUnitSetCache: TFPCUnitSetCache;
30 FVirtualDirDefines: TDefineTemplate;
31 protected
32 procedure SetUp; override;
33 procedure TearDown; override;
34 procedure DoParseModule(aCode: TCodeBuffer; out Tool: TCodeTool); virtual;
35 public
36 constructor Create; override;
37 procedure Add(const s: string);
38 procedure Add(Args: array of const);
FindPas2jsnull39 function FindPas2js: string;
StartProgramnull40 function StartProgram: boolean; override;
41 procedure ParseModule; virtual;
42 procedure WriteSource(CleanPos: integer; Tool: TCodeTool);
43 procedure WriteSource(const CursorPos: TCodeXYPosition);
44 property AutoSearchPas2js: boolean read FAutoSearchPas2js write FAutoSearchPas2js;
45 property Code: TCodeBuffer read FCode;
46 property Pas2jsFilename: string read FPas2jsFilename write FPas2jsFilename; // compiler filename
47 property UnitSetCache: TFPCUnitSetCache read FUnitSetCache write FUnitSetCache;
48 property VirtualDirDefines: TDefineTemplate read FVirtualDirDefines write FVirtualDirDefines;
49 property BaseDir: string read FBaseDir write FBaseDir;
50 end;
51
52 { TTestPas2js }
53
54 TTestPas2js = class(TCustomTestPas2js)
55 published
56 procedure TestPas2js_ReadSettings;
57 procedure TestPas2js_FindDeclaration;
58 procedure TestPas2js_FindDeclaration_AWait;
59 end;
60
61 implementation
62
63 { TCustomTestPas2js }
64
65 procedure TCustomTestPas2js.SetUp;
66 var
67 CurUnitSet: TFPCUnitSetCache;
68 UnitSetID: String;
69 CompilerDefines: TDefineTemplate;
70 begin
71 inherited SetUp;
72 if (Pas2jsFilename='') and AutoSearchPas2js then begin
73 FPas2jsFilename:=FindPas2js;
74 AutoSearchPas2js:=false;
75 end;
76 if FPas2jsFilename<>'' then begin
77 if UnitSetCache=nil then begin
78 UnitSetCache:=CodeToolBoss.CompilerDefinesCache.FindUnitSet(Pas2jsFilename,
79 '','','','',true);
80 // parse compiler settings
81 UnitSetCache.Init;
82 end;
83 UnitSetID:=UnitSetCache.GetUnitSetID;
84
85 // set pas2js for virtual directory
86 if VirtualDirDefines=nil then begin
87 VirtualDirDefines:=TDefineTemplate.Create(
88 'VirtualDirPas2js', 'set pas2js as compiler for virtual directory',
89 '',VirtualDirectory,da_Directory);
90 VirtualDirDefines.AddChild(TDefineTemplate.Create('Reset','','','',da_UndefineAll));
91 // create template for Pas2js settings
92 CompilerDefines:=CreateFPCTemplate(UnitSetCache,nil);
93 VirtualDirDefines.AddChild(CompilerDefines);
94 end;
95 CodeToolBoss.DefineTree.Add(VirtualDirDefines);
96
97 // check
98 CurUnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
99 if CurUnitSet=nil then
100 Fail('CodeToolBoss.GetUnitSetForDirectory=nil');
101 if CurUnitSet<>UnitSetCache then
102 AssertEquals('UnitSet VirtualDirectory should be pas2js',UnitSetID,CurUnitSet.GetUnitSetID);
103
104 if CodeToolBoss.GetPascalCompilerForDirectory('')<>pcPas2js then
105 AssertEquals('VirtualDirectory compiler should be pas2js',
106 PascalCompilerNames[pcPas2js],
107 PascalCompilerNames[CodeToolBoss.GetPascalCompilerForDirectory('')]);
108 end;
109 FCode:=CodeToolBoss.CreateFile('test1.pas');
110 end;
111
112 procedure TCustomTestPas2js.TearDown;
113 begin
114 FCode:=nil;
115 CodeToolBoss.DefineTree.RemoveDefineTemplate(VirtualDirDefines);
116
117 inherited TearDown;
118 end;
119
120 procedure TCustomTestPas2js.DoParseModule(aCode: TCodeBuffer; out
121 Tool: TCodeTool);
122 var
123 i: Integer;
124 Line: String;
125 begin
126 if not CodeToolBoss.Explore(aCode,Tool,true) then begin
127 debugln(aCode.Filename+'------------------------------------------');
128 for i:=1 to aCode.LineCount do begin
129 Line:=aCode.GetLine(i-1,false);
130 if i=CodeToolBoss.ErrorLine then
131 System.Insert('|',Line,CodeToolBoss.ErrorColumn);
132 debugln(Format('%:4d: ',[i]),Line);
133 end;
134 debugln('Error: '+CodeToolBoss.ErrorDbgMsg);
135 Fail('PascalParser failed: '+CodeToolBoss.ErrorMessage);
136 end;
137 end;
138
139 constructor TCustomTestPas2js.Create;
140 begin
141 inherited Create;
142 FAutoSearchPas2js:=true;
143 FBaseDir:='pas2js';
144 end;
145
146 procedure TCustomTestPas2js.Add(const s: string);
147 begin
148 FCode.Source:=FCode.Source+s+LineEnding;
149 end;
150
151 procedure TCustomTestPas2js.Add(Args: array of const);
152 begin
153 FCode.Source:=FCode.Source+LinesToStr(Args);
154 end;
155
TCustomTestPas2js.FindPas2jsnull156 function TCustomTestPas2js.FindPas2js: string;
157 var
158 ShortFilename: String;
159 begin
160 Result:=GetEnvironmentVariable('PAS2JS');
161 if Result<>'' then begin
162 if not FileExistsUTF8(Result) then
163 Fail('Environment variable PAS2JS is non existing file "'+Result+'"');
164 exit;
165 end;
166 ShortFilename:='pas2js'+ExeExt;
167 Result:=SearchFileInPath(ShortFilename,'',
168 GetEnvironmentVariableUTF8('PATH'),PathSeparator,ctsfcDefault);
169 end;
170
StartProgramnull171 function TCustomTestPas2js.StartProgram: boolean;
172 begin
173 if FPas2jsFilename='' then exit(false);
174 Result:=true;
175 AssertEquals('compiler kind',PascalCompilerNames[pcPas2js],PascalCompilerNames[UnitSetCache.GetCompilerKind]);
176 end;
177
178 procedure TCustomTestPas2js.ParseModule;
179 var
180 Tool: TCodeTool;
181 begin
182 Add('end.');
183 DoParseModule(Code,Tool);
184 end;
185
186 procedure TCustomTestPas2js.WriteSource(CleanPos: integer; Tool: TCodeTool);
187 var
188 Caret: TCodeXYPosition;
189 begin
190 if Tool=nil then
191 Fail('TCustomTestPas2js.WriteSource: missing Tool');
192 if not Tool.CleanPosToCaret(CleanPos,Caret) then
193 Fail('TCustomTestPas2js.WriteSource: invalid cleanpos '+IntToStr(CleanPos)+' Tool='+Tool.MainFilename);
194 WriteSource(Caret);
195 end;
196
197 procedure TCustomTestPas2js.WriteSource(const CursorPos: TCodeXYPosition);
198 var
199 CurCode: TCodeBuffer;
200 i: Integer;
201 Line: String;
202 begin
203 CurCode:=CursorPos.Code;
204 if CurCode=nil then
205 Fail('TCustomTestPas2js.WriteSource CurCode=nil');
206 for i:=1 to CurCode.LineCount do begin
207 Line:=CurCode.GetLine(i-1,false);
208 if (i=CursorPos.Y) then begin
209 write('*');
210 Line:=LeftStr(Line,CursorPos.X-1)+'|'+copy(Line,CursorPos.X,length(Line));
211 end;
212 writeln(Format('%:4d: ',[i]),Line);
213 end;
214 end;
215
216 { TTestPas2js }
217
218 procedure TTestPas2js.TestPas2js_ReadSettings;
219 var
220 Cfg: TPCTargetConfigCache;
221 aFilename, AnUnitName, InFilename, SystemUnit: String;
222 begin
223 if Pas2jsFilename='' then exit;
224
225 AssertEquals('compiler kind',PascalCompilerNames[pcPas2js],PascalCompilerNames[UnitSetCache.GetCompilerKind]);
226 Cfg:=UnitSetCache.GetConfigCache(false);
227 if not Cfg.Defines.Contains('PAS2JS_FULLVERSION') then
228 Fail('macro PAS2JS_FULLVERSION is misssing');
229 SystemUnit:=Cfg.Units['system'];
230 if SystemUnit='' then
231 Fail('pas2js.cfg is missing path to system unit');
232
233 AnUnitName:='system';
234 InFilename:='';
235 aFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath('',AnUnitName,InFilename,true);
236 if aFilename='' then
237 Fail('system unit not found from virtual directory');
238 if CompareFilenames(aFilename,SystemUnit)<>0 then
239 AssertEquals('pas2js system unit',SystemUnit,aFilename);
240 end;
241
242 procedure TTestPas2js.TestPas2js_FindDeclaration;
243 begin
244 if not StartProgram then exit;
245 Add([
246 'var Cow: longint;',
247 'begin',
248 ' cow{declaration:Cow}:=3;',
249 ' test1{declaration:Test1}.cow{declaration:Cow}:=3;',
250 'end.',
251 '']);
252 ParseModule;
253 //FindDeclarations(Code);
254 end;
255
256 procedure TTestPas2js.TestPas2js_FindDeclaration_AWait;
257 begin
258 if not StartProgram then exit;
259 Add([
260 '{$modeswitch externalclass}',
261 'type',
262 ' TJSPromise = class external name ''Promise''',
263 ' end;',
264 'function Crawl(d: double = 1.3): word; ',
265 'begin',
266 'end;',
267 'function Run(d: double): word; async;',
268 'var',
269 ' p: TJSPromise;',
270 'begin',
271 ' Result:=await(word,p{declaration:Run.p});',
272 ' Result:=await(1);',
273 ' Result:=await(Crawl{declaration:Crawl});',
274 ' Result:=await(Crawl{declaration:Crawl}(4.5));',
275 'end;',
276 'begin',
277 ' Run{declaration:run}(3);',
278 'end.']);
279 FindDeclarations(Code);
280 end;
281
282 initialization
283 RegisterTest(TTestPas2js);
284 end.
285
286