tcfiler.pas 75 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 2018 by Michael Van Canneyt
  4. Unit tests for Pascal-to-Javascript precompile class.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Examples:
  12. ./testpas2js --suite=TTestPrecompile.TestPC_EmptyUnit
  13. }
  14. unit tcfiler;
  15. {$mode objfpc}{$H+}
  16. interface
  17. uses
  18. Classes, SysUtils, fpcunit, testregistry,
  19. PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
  20. FPPas2Js, Pas2JsFiler, Pas2jsPParser,
  21. tcmodules, jstree;
  22. type
  23. { TCustomTestPrecompile }
  24. TCustomTestPrecompile = Class(TCustomTestModule)
  25. private
  26. FAnalyzer: TPasAnalyzer;
  27. FInitialFlags: TPCUInitialFlags;
  28. FPCUReader: TPCUReader;
  29. FPCUWriter: TPCUWriter;
  30. FRestAnalyzer: TPasAnalyzer;
  31. procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
  32. out Count: integer);
  33. function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
  34. function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
  35. function OnRestConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
  36. function OnRestConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
  37. function OnRestResolverFindUnit(const aUnitName: String): TPasModule;
  38. protected
  39. procedure SetUp; override;
  40. procedure TearDown; override;
  41. function CreateConverter: TPasToJSConverter; override;
  42. procedure ParseUnit; override;
  43. procedure WriteReadUnit; virtual;
  44. procedure StartParsing; override;
  45. function CheckRestoredObject(const Path: string; Orig, Rest: TObject): boolean; virtual;
  46. procedure CheckRestoredJS(const Path, Orig, Rest: string); virtual;
  47. // check restored parser+resolver
  48. procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual;
  49. procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual;
  50. procedure CheckRestoredSection(const Path: string; Orig, Rest: TPasSection); virtual;
  51. procedure CheckRestoredModule(const Path: string; Orig, Rest: TPasModule); virtual;
  52. procedure CheckRestoredScopeReference(const Path: string; Orig, Rest: TPasScope); virtual;
  53. procedure CheckRestoredElementBase(const Path: string; Orig, Rest: TPasElementBase); virtual;
  54. procedure CheckRestoredResolveData(const Path: string; Orig, Rest: TResolveData); virtual;
  55. procedure CheckRestoredPasScope(const Path: string; Orig, Rest: TPasScope); virtual;
  56. procedure CheckRestoredModuleScope(const Path: string; Orig, Rest: TPas2JSModuleScope); virtual;
  57. procedure CheckRestoredIdentifierScope(const Path: string; Orig, Rest: TPasIdentifierScope); virtual;
  58. procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPas2JSSectionScope); virtual;
  59. procedure CheckRestoredInitialFinalizationScope(const Path: string; Orig, Rest: TPas2JSInitialFinalizationScope); virtual;
  60. procedure CheckRestoredEnumTypeScope(const Path: string; Orig, Rest: TPasEnumTypeScope); virtual;
  61. procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPasRecordScope); virtual;
  62. procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope); virtual;
  63. procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
  64. procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences); virtual;
  65. procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope); virtual;
  66. procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference); virtual;
  67. procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
  68. procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject); virtual;
  69. procedure CheckRestoredReference(const Path: string; Orig, Rest: TPasElement); virtual;
  70. procedure CheckRestoredElOrRef(const Path: string; Orig, OrigProp, Rest, RestProp: TPasElement); virtual;
  71. procedure CheckRestoredAnalyzerElement(const Path: string; Orig, Rest: TPasElement); virtual;
  72. procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
  73. procedure CheckRestoredElementList(const Path: string; Orig, Rest: TFPList); virtual;
  74. procedure CheckRestoredElRefList(const Path: string; OrigParent: TPasElement;
  75. Orig: TFPList; RestParent: TPasElement; Rest: TFPList; AllowInSitu: boolean); virtual;
  76. procedure CheckRestoredPasExpr(const Path: string; Orig, Rest: TPasExpr); virtual;
  77. procedure CheckRestoredUnaryExpr(const Path: string; Orig, Rest: TUnaryExpr); virtual;
  78. procedure CheckRestoredBinaryExpr(const Path: string; Orig, Rest: TBinaryExpr); virtual;
  79. procedure CheckRestoredPrimitiveExpr(const Path: string; Orig, Rest: TPrimitiveExpr); virtual;
  80. procedure CheckRestoredBoolConstExpr(const Path: string; Orig, Rest: TBoolConstExpr); virtual;
  81. procedure CheckRestoredParamsExpr(const Path: string; Orig, Rest: TParamsExpr); virtual;
  82. procedure CheckRestoredRecordValues(const Path: string; Orig, Rest: TRecordValues); virtual;
  83. procedure CheckRestoredPasExprArray(const Path: string; Orig, Rest: TPasExprArray); virtual;
  84. procedure CheckRestoredArrayValues(const Path: string; Orig, Rest: TArrayValues); virtual;
  85. procedure CheckRestoredResString(const Path: string; Orig, Rest: TPasResString); virtual;
  86. procedure CheckRestoredAliasType(const Path: string; Orig, Rest: TPasAliasType); virtual;
  87. procedure CheckRestoredPointerType(const Path: string; Orig, Rest: TPasPointerType); virtual;
  88. procedure CheckRestoredSpecializedType(const Path: string; Orig, Rest: TPasSpecializeType); virtual;
  89. procedure CheckRestoredInlineSpecializedExpr(const Path: string; Orig, Rest: TInlineSpecializeExpr); virtual;
  90. procedure CheckRestoredRangeType(const Path: string; Orig, Rest: TPasRangeType); virtual;
  91. procedure CheckRestoredArrayType(const Path: string; Orig, Rest: TPasArrayType); virtual;
  92. procedure CheckRestoredFileType(const Path: string; Orig, Rest: TPasFileType); virtual;
  93. procedure CheckRestoredEnumValue(const Path: string; Orig, Rest: TPasEnumValue); virtual;
  94. procedure CheckRestoredEnumType(const Path: string; Orig, Rest: TPasEnumType); virtual;
  95. procedure CheckRestoredSetType(const Path: string; Orig, Rest: TPasSetType); virtual;
  96. procedure CheckRestoredVariant(const Path: string; Orig, Rest: TPasVariant); virtual;
  97. procedure CheckRestoredRecordType(const Path: string; Orig, Rest: TPasRecordType); virtual;
  98. procedure CheckRestoredClassType(const Path: string; Orig, Rest: TPasClassType); virtual;
  99. procedure CheckRestoredArgument(const Path: string; Orig, Rest: TPasArgument); virtual;
  100. procedure CheckRestoredProcedureType(const Path: string; Orig, Rest: TPasProcedureType); virtual;
  101. procedure CheckRestoredResultElement(const Path: string; Orig, Rest: TPasResultElement); virtual;
  102. procedure CheckRestoredFunctionType(const Path: string; Orig, Rest: TPasFunctionType); virtual;
  103. procedure CheckRestoredStringType(const Path: string; Orig, Rest: TPasStringType); virtual;
  104. procedure CheckRestoredVariable(const Path: string; Orig, Rest: TPasVariable); virtual;
  105. procedure CheckRestoredExportSymbol(const Path: string; Orig, Rest: TPasExportSymbol); virtual;
  106. procedure CheckRestoredConst(const Path: string; Orig, Rest: TPasConst); virtual;
  107. procedure CheckRestoredProperty(const Path: string; Orig, Rest: TPasProperty); virtual;
  108. procedure CheckRestoredMethodResolution(const Path: string; Orig, Rest: TPasMethodResolution); virtual;
  109. procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
  110. procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
  111. public
  112. property Analyzer: TPasAnalyzer read FAnalyzer;
  113. property RestAnalyzer: TPasAnalyzer read FRestAnalyzer;
  114. property PCUWriter: TPCUWriter read FPCUWriter write FPCUWriter;
  115. property PCUReader: TPCUReader read FPCUReader write FPCUReader;
  116. property InitialFlags: TPCUInitialFlags read FInitialFlags;
  117. end;
  118. { TTestPrecompile }
  119. TTestPrecompile = class(TCustomTestPrecompile)
  120. published
  121. procedure Test_Base256VLQ;
  122. procedure TestPC_EmptyUnit;
  123. procedure TestPC_Const;
  124. procedure TestPC_Var;
  125. procedure TestPC_Enum;
  126. procedure TestPC_Set;
  127. procedure TestPC_SetOfAnonymousEnumType;
  128. procedure TestPC_Record;
  129. procedure TestPC_JSValue;
  130. procedure TestPC_Array;
  131. procedure TestPC_ArrayOfAnonymous;
  132. procedure TestPC_Proc;
  133. procedure TestPC_Proc_Nested;
  134. procedure TestPC_Proc_LocalConst;
  135. procedure TestPC_Proc_UTF8;
  136. procedure TestPC_Proc_Arg;
  137. procedure TestPC_ProcType;
  138. procedure TestPC_Class;
  139. procedure TestPC_ClassForward;
  140. procedure TestPC_ClassConstructor;
  141. procedure TestPC_Initialization;
  142. procedure TestPC_BoolSwitches;
  143. procedure TestPC_ClassInterface;
  144. procedure TestPC_IgnoreAttributes;
  145. procedure TestPC_UseUnit;
  146. procedure TestPC_UseUnit_Class;
  147. procedure TestPC_UseIndirectUnit;
  148. end;
  149. function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
  150. implementation
  151. function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
  152. var
  153. Ref1: TPasScopeReference absolute Item1;
  154. Ref2: TPasScopeReference absolute Item2;
  155. begin
  156. Result:=CompareText(Ref1.Element.Name,Ref2.Element.Name);
  157. if Result<>0 then exit;
  158. Result:=ComparePointer(Ref1.Element,Ref2.Element);
  159. end;
  160. { TCustomTestPrecompile }
  161. procedure TCustomTestPrecompile.OnFilerGetSrc(Sender: TObject;
  162. aFilename: string; out p: PChar; out Count: integer);
  163. var
  164. i: Integer;
  165. aModule: TTestEnginePasResolver;
  166. Src: String;
  167. begin
  168. for i:=0 to ResolverCount-1 do
  169. begin
  170. aModule:=Resolvers[i];
  171. if aModule.Filename<>aFilename then continue;
  172. Src:=aModule.Source;
  173. p:=PChar(Src);
  174. Count:=length(Src);
  175. end;
  176. end;
  177. function TCustomTestPrecompile.OnConverterIsElementUsed(Sender: TObject;
  178. El: TPasElement): boolean;
  179. begin
  180. Result:=Analyzer.IsUsed(El);
  181. end;
  182. function TCustomTestPrecompile.OnConverterIsTypeInfoUsed(Sender: TObject;
  183. El: TPasElement): boolean;
  184. begin
  185. Result:=Analyzer.IsTypeInfoUsed(El);
  186. end;
  187. function TCustomTestPrecompile.OnRestConverterIsElementUsed(Sender: TObject;
  188. El: TPasElement): boolean;
  189. begin
  190. Result:=RestAnalyzer.IsUsed(El);
  191. end;
  192. function TCustomTestPrecompile.OnRestConverterIsTypeInfoUsed(Sender: TObject;
  193. El: TPasElement): boolean;
  194. begin
  195. Result:=RestAnalyzer.IsTypeInfoUsed(El);
  196. end;
  197. function TCustomTestPrecompile.OnRestResolverFindUnit(const aUnitName: String
  198. ): TPasModule;
  199. function FindRestUnit(Name: string): TPasModule;
  200. var
  201. i: Integer;
  202. CurEngine: TTestEnginePasResolver;
  203. CurUnitName: String;
  204. begin
  205. for i:=0 to ResolverCount-1 do
  206. begin
  207. CurEngine:=Resolvers[i];
  208. CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
  209. {$IFDEF VerbosePCUFiler}
  210. //writeln('TCustomTestPrecompile.FindRestUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
  211. {$ENDIF}
  212. if CompareText(Name,CurUnitName)=0 then
  213. begin
  214. Result:=CurEngine.Module;
  215. if Result<>nil then
  216. begin
  217. {$IFDEF VerbosePCUFiler}
  218. //writeln('TCustomTestPrecompile.FindRestUnit Found parsed module: ',Result.Filename);
  219. {$ENDIF}
  220. exit;
  221. end;
  222. {$IFDEF VerbosePCUFiler}
  223. writeln('TCustomTestPrecompile.FindRestUnit PARSING unit "',CurEngine.Filename,'"');
  224. {$ENDIF}
  225. Fail('not parsed');
  226. end;
  227. end;
  228. end;
  229. var
  230. DefNamespace: String;
  231. begin
  232. if (Pos('.',aUnitName)<1) then
  233. begin
  234. DefNamespace:=GetDefaultNamespace;
  235. if DefNamespace<>'' then
  236. begin
  237. Result:=FindRestUnit(DefNamespace+'.'+aUnitName);
  238. if Result<>nil then exit;
  239. end;
  240. end;
  241. Result:=FindRestUnit(aUnitName);
  242. end;
  243. procedure TCustomTestPrecompile.SetUp;
  244. begin
  245. inherited SetUp;
  246. FInitialFlags:=TPCUInitialFlags.Create;
  247. FAnalyzer:=TPasAnalyzer.Create;
  248. Analyzer.Resolver:=Engine;
  249. Analyzer.Options:=Analyzer.Options+[paoImplReferences];
  250. Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
  251. Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
  252. end;
  253. procedure TCustomTestPrecompile.TearDown;
  254. begin
  255. FreeAndNil(FAnalyzer);
  256. FreeAndNil(FPCUWriter);
  257. FreeAndNil(FPCUReader);
  258. FreeAndNil(FInitialFlags);
  259. inherited TearDown;
  260. end;
  261. function TCustomTestPrecompile.CreateConverter: TPasToJSConverter;
  262. begin
  263. Result:=inherited CreateConverter;
  264. Result.Options:=Result.Options+[coStoreImplJS];
  265. end;
  266. procedure TCustomTestPrecompile.ParseUnit;
  267. begin
  268. inherited ParseUnit;
  269. Analyzer.AnalyzeModule(Module);
  270. end;
  271. procedure TCustomTestPrecompile.WriteReadUnit;
  272. var
  273. ms: TMemoryStream;
  274. PCU, RestJSSrc, OrigJSSrc: string;
  275. // restored classes:
  276. RestResolver: TTestEnginePasResolver;
  277. RestFileResolver: TFileResolver;
  278. RestScanner: TPas2jsPasScanner;
  279. RestParser: TPasParser;
  280. RestConverter: TPasToJSConverter;
  281. RestJSModule: TJSSourceElements;
  282. begin
  283. ConvertUnit;
  284. FPCUWriter:=TPCUWriter.Create;
  285. FPCUReader:=TPCUReader.Create;
  286. ms:=TMemoryStream.Create;
  287. RestParser:=nil;
  288. RestScanner:=nil;
  289. RestResolver:=nil;
  290. RestFileResolver:=nil;
  291. RestConverter:=nil;
  292. RestJSModule:=nil;
  293. try
  294. try
  295. PCUWriter.OnGetSrc:=@OnFilerGetSrc;
  296. PCUWriter.OnIsElementUsed:=@OnConverterIsElementUsed;
  297. PCUWriter.WritePCU(Engine,Converter,InitialFlags,ms,false);
  298. except
  299. on E: Exception do
  300. begin
  301. {$IFDEF VerbosePas2JS}
  302. writeln('TCustomTestPrecompile.WriteReadUnit WRITE failed');
  303. {$ENDIF}
  304. Fail('Write failed('+E.ClassName+'): '+E.Message);
  305. end;
  306. end;
  307. try
  308. PCU:='';
  309. SetLength(PCU,ms.Size);
  310. System.Move(ms.Memory^,PCU[1],length(PCU));
  311. writeln('TCustomTestPrecompile.WriteReadUnit PCU START-----');
  312. writeln(PCU);
  313. writeln('TCustomTestPrecompile.WriteReadUnit PCU END-------');
  314. RestFileResolver:=TFileResolver.Create;
  315. RestScanner:=TPas2jsPasScanner.Create(RestFileResolver);
  316. InitScanner(RestScanner);
  317. RestResolver:=TTestEnginePasResolver.Create;
  318. RestResolver.Filename:=Engine.Filename;
  319. RestResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
  320. RestResolver.OnFindUnit:=@OnRestResolverFindUnit;
  321. RestParser:=TPasParser.Create(RestScanner,RestFileResolver,RestResolver);
  322. RestParser.Options:=po_tcmodules;
  323. RestResolver.CurrentParser:=RestParser;
  324. ms.Position:=0;
  325. PCUReader.ReadPCU(RestResolver,ms);
  326. if not PCUReader.ReadContinue then
  327. Fail('ReadContinue=false, pending used interfaces');
  328. except
  329. on E: Exception do
  330. begin
  331. {$IFDEF VerbosePas2JS}
  332. writeln('TCustomTestPrecompile.WriteReadUnit READ failed');
  333. {$ENDIF}
  334. Fail('Read failed('+E.ClassName+'): '+E.Message);
  335. end;
  336. end;
  337. // analyze
  338. FRestAnalyzer:=TPasAnalyzer.Create;
  339. FRestAnalyzer.Resolver:=RestResolver;
  340. try
  341. RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
  342. except
  343. on E: Exception do
  344. begin
  345. {$IFDEF VerbosePas2JS}
  346. writeln('TCustomTestPrecompile.WriteReadUnit ANALYZEMODULE failed');
  347. {$ENDIF}
  348. Fail('AnalyzeModule precompiled failed('+E.ClassName+'): '+E.Message);
  349. end;
  350. end;
  351. // check parser+resolver+analyzer
  352. CheckRestoredResolver(Engine,RestResolver);
  353. // convert using the precompiled procs
  354. RestConverter:=CreateConverter;
  355. RestConverter.Options:=Converter.Options;
  356. RestConverter.OnIsElementUsed:=@OnRestConverterIsElementUsed;
  357. RestConverter.OnIsTypeInfoUsed:=@OnRestConverterIsTypeInfoUsed;
  358. try
  359. RestJSModule:=RestConverter.ConvertPasElement(RestResolver.RootElement,RestResolver) as TJSSourceElements;
  360. except
  361. on E: Exception do
  362. begin
  363. {$IFDEF VerbosePas2JS}
  364. writeln('TCustomTestPrecompile.WriteReadUnit CONVERTER failed');
  365. {$ENDIF}
  366. Fail('Convert precompiled failed('+E.ClassName+'): '+E.Message);
  367. end;
  368. end;
  369. OrigJSSrc:=JSToStr(JSModule);
  370. RestJSSrc:=JSToStr(RestJSModule);
  371. if OrigJSSrc<>RestJSSrc then
  372. begin
  373. writeln('TCustomTestPrecompile.WriteReadUnit OrigJSSrc:---------START');
  374. writeln(OrigJSSrc);
  375. writeln('TCustomTestPrecompile.WriteReadUnit OrigJSSrc:---------END');
  376. writeln('TCustomTestPrecompile.WriteReadUnit RestJSSrc:---------START');
  377. writeln(RestJSSrc);
  378. writeln('TCustomTestPrecompile.WriteReadUnit RestJSSrc:---------END');
  379. CheckDiff('WriteReadUnit JS diff',OrigJSSrc,RestJSSrc);
  380. end;
  381. finally
  382. RestJSModule.Free;
  383. RestConverter.Free;
  384. FreeAndNil(FRestAnalyzer);
  385. RestParser.Free;
  386. RestScanner.Free;
  387. if (RestResolver<>nil) and (RestResolver.RootElement<>nil) then
  388. begin
  389. RestResolver.RootElement.ReleaseUsedUnits;
  390. RestResolver.RootElement.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  391. end;
  392. RestResolver.Free; // free parser before resolver
  393. RestFileResolver.Free;
  394. ms.Free;
  395. end;
  396. end;
  397. procedure TCustomTestPrecompile.StartParsing;
  398. begin
  399. inherited StartParsing;
  400. FInitialFlags.ParserOptions:=Parser.Options;
  401. FInitialFlags.ModeSwitches:=Scanner.CurrentModeSwitches;
  402. FInitialFlags.BoolSwitches:=Scanner.CurrentBoolSwitches;
  403. FInitialFlags.ConverterOptions:=Converter.Options;
  404. FInitialFlags.TargetPlatform:=Converter.TargetPlatform;
  405. FInitialFlags.TargetProcessor:=Converter.TargetProcessor;
  406. // ToDo: defines
  407. end;
  408. function TCustomTestPrecompile.CheckRestoredObject(const Path: string; Orig,
  409. Rest: TObject): boolean;
  410. begin
  411. if Orig=nil then
  412. begin
  413. if Rest<>nil then
  414. Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
  415. exit(false);
  416. end
  417. else if Rest=nil then
  418. Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
  419. if Orig.ClassType<>Rest.ClassType then
  420. Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
  421. Result:=true;
  422. end;
  423. procedure TCustomTestPrecompile.CheckRestoredJS(const Path, Orig, Rest: string);
  424. var
  425. OrigList, RestList: TStringList;
  426. i: Integer;
  427. begin
  428. if Orig=Rest then exit;
  429. writeln('TCustomTestPrecompile.CheckRestoredJS ORIG START--------------');
  430. writeln(Orig);
  431. writeln('TCustomTestPrecompile.CheckRestoredJS ORIG END----------------');
  432. writeln('TCustomTestPrecompile.CheckRestoredJS REST START--------------');
  433. writeln(Rest);
  434. writeln('TCustomTestPrecompile.CheckRestoredJS REST END----------------');
  435. OrigList:=TStringList.Create;
  436. RestList:=TStringList.Create;
  437. try
  438. OrigList.Text:=Orig;
  439. RestList.Text:=Rest;
  440. for i:=0 to OrigList.Count-1 do
  441. begin
  442. if i>=RestList.Count then
  443. Fail(Path+' missing: '+OrigList[i]);
  444. writeln(' ',i,': '+OrigList[i]);
  445. end;
  446. if OrigList.Count<RestList.Count then
  447. Fail(Path+' too much: '+RestList[OrigList.Count]);
  448. finally
  449. OrigList.Free;
  450. RestList.Free;
  451. end;
  452. end;
  453. procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
  454. Restored: TPas2JSResolver);
  455. var
  456. OrigParser, RestParser: TPasParser;
  457. begin
  458. AssertNotNull('CheckRestoredResolver Original',Original);
  459. AssertNotNull('CheckRestoredResolver Restored',Restored);
  460. if Original.ClassType<>Restored.ClassType then
  461. Fail('CheckRestoredResolver Original='+Original.ClassName+' Restored='+Restored.ClassName);
  462. CheckRestoredElement('RootElement',Original.RootElement,Restored.RootElement);
  463. OrigParser:=Original.CurrentParser;
  464. RestParser:=Restored.CurrentParser;
  465. if OrigParser.Options<>RestParser.Options then
  466. Fail('CheckRestoredResolver Parser.Options');
  467. if OrigParser.Scanner.CurrentBoolSwitches<>RestParser.Scanner.CurrentBoolSwitches then
  468. Fail('CheckRestoredResolver Scanner.BoolSwitches');
  469. if OrigParser.Scanner.CurrentModeSwitches<>RestParser.Scanner.CurrentModeSwitches then
  470. Fail('CheckRestoredResolver Scanner.ModeSwitches');
  471. end;
  472. procedure TCustomTestPrecompile.CheckRestoredDeclarations(const Path: string;
  473. Orig, Rest: TPasDeclarations);
  474. var
  475. i: Integer;
  476. OrigDecl, RestDecl: TPasElement;
  477. SubPath: String;
  478. begin
  479. for i:=0 to Orig.Declarations.Count-1 do
  480. begin
  481. OrigDecl:=TPasElement(Orig.Declarations[i]);
  482. if i>=Rest.Declarations.Count then
  483. AssertEquals(Path+'.Declarations.Count',Orig.Declarations.Count,Rest.Declarations.Count);
  484. RestDecl:=TPasElement(Rest.Declarations[i]);
  485. SubPath:=Path+'['+IntToStr(i)+']';
  486. if OrigDecl.Name<>'' then
  487. SubPath:=SubPath+'"'+OrigDecl.Name+'"'
  488. else
  489. SubPath:=SubPath+'?noname?';
  490. CheckRestoredElement(SubPath,OrigDecl,RestDecl);
  491. end;
  492. AssertEquals(Path+'.Declarations.Count',Orig.Declarations.Count,Rest.Declarations.Count);
  493. end;
  494. procedure TCustomTestPrecompile.CheckRestoredSection(const Path: string; Orig,
  495. Rest: TPasSection);
  496. begin
  497. if length(Orig.UsesClause)>0 then
  498. ; // ToDo
  499. CheckRestoredDeclarations(Path,Orig,Rest);
  500. end;
  501. procedure TCustomTestPrecompile.CheckRestoredModule(const Path: string; Orig,
  502. Rest: TPasModule);
  503. procedure CheckInitFinal(const Path: string; OrigBlock, RestBlock: TPasImplBlock);
  504. begin
  505. CheckRestoredObject(Path,OrigBlock,RestBlock);
  506. if OrigBlock=nil then exit;
  507. CheckRestoredCustomData(Path+'.CustomData',RestBlock,OrigBlock.CustomData,RestBlock.CustomData);
  508. end;
  509. begin
  510. if not (Orig.CustomData is TPas2JSModuleScope) then
  511. Fail(Path+'.CustomData is not TPasModuleScope'+GetObjName(Orig.CustomData));
  512. CheckRestoredElement(Path+'.InterfaceSection',Orig.InterfaceSection,Rest.InterfaceSection);
  513. CheckRestoredElement(Path+'.ImplementationSection',Orig.ImplementationSection,Rest.ImplementationSection);
  514. if Orig is TPasProgram then
  515. CheckRestoredElement(Path+'.ProgramSection',TPasProgram(Orig).ProgramSection,TPasProgram(Rest).ProgramSection)
  516. else if Orig is TPasLibrary then
  517. CheckRestoredElement(Path+'.LibrarySection',TPasLibrary(Orig).LibrarySection,TPasLibrary(Rest).LibrarySection);
  518. CheckInitFinal(Path+'.InitializationSection',Orig.InitializationSection,Rest.InitializationSection);
  519. CheckInitFinal(Path+'.FnializationSection',Orig.FinalizationSection,Rest.FinalizationSection);
  520. end;
  521. procedure TCustomTestPrecompile.CheckRestoredScopeReference(const Path: string;
  522. Orig, Rest: TPasScope);
  523. begin
  524. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  525. CheckRestoredReference(Path+'.Element',Orig.Element,Rest.Element);
  526. end;
  527. procedure TCustomTestPrecompile.CheckRestoredElementBase(const Path: string;
  528. Orig, Rest: TPasElementBase);
  529. begin
  530. CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
  531. end;
  532. procedure TCustomTestPrecompile.CheckRestoredResolveData(const Path: string;
  533. Orig, Rest: TResolveData);
  534. begin
  535. CheckRestoredElementBase(Path,Orig,Rest);
  536. end;
  537. procedure TCustomTestPrecompile.CheckRestoredPasScope(const Path: string; Orig,
  538. Rest: TPasScope);
  539. begin
  540. CheckRestoredReference(Path+'.VisibilityContext',Orig.VisibilityContext,Rest.VisibilityContext);
  541. CheckRestoredResolveData(Path,Orig,Rest);
  542. end;
  543. procedure TCustomTestPrecompile.CheckRestoredModuleScope(const Path: string;
  544. Orig, Rest: TPas2JSModuleScope);
  545. begin
  546. AssertEquals(Path+'.FirstName',Orig.FirstName,Rest.FirstName);
  547. if Orig.Flags<>Rest.Flags then
  548. Fail(Path+'.Flags');
  549. if Orig.BoolSwitches<>Rest.BoolSwitches then
  550. Fail(Path+'.BoolSwitches');
  551. CheckRestoredReference(Path+'.AssertClass',Orig.AssertClass,Rest.AssertClass);
  552. CheckRestoredReference(Path+'.AssertDefConstructor',Orig.AssertDefConstructor,Rest.AssertDefConstructor);
  553. CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
  554. CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
  555. CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
  556. CheckRestoredPasScope(Path,Orig,Rest);
  557. end;
  558. procedure TCustomTestPrecompile.CheckRestoredIdentifierScope(
  559. const Path: string; Orig, Rest: TPasIdentifierScope);
  560. var
  561. OrigList: TFPList;
  562. i: Integer;
  563. OrigIdentifier, RestIdentifier: TPasIdentifier;
  564. begin
  565. OrigList:=nil;
  566. try
  567. OrigList:=Orig.GetLocalIdentifiers;
  568. for i:=0 to OrigList.Count-1 do
  569. begin
  570. OrigIdentifier:=TPasIdentifier(OrigList[i]);
  571. RestIdentifier:=Rest.FindLocalIdentifier(OrigIdentifier.Identifier);
  572. if RestIdentifier=nil then
  573. Fail(Path+'.Local['+OrigIdentifier.Identifier+'] Missing RestIdentifier Orig='+OrigIdentifier.Identifier);
  574. repeat
  575. AssertEquals(Path+'.Local.Identifier',OrigIdentifier.Identifier,RestIdentifier.Identifier);
  576. CheckRestoredReference(Path+'.Local',OrigIdentifier.Element,RestIdentifier.Element);
  577. if OrigIdentifier.Kind<>RestIdentifier.Kind then
  578. Fail(Path+'.Local['+OrigIdentifier.Identifier+'] Orig='+PCUIdentifierKindNames[OrigIdentifier.Kind]+' Rest='+PCUIdentifierKindNames[RestIdentifier.Kind]);
  579. if OrigIdentifier.NextSameIdentifier=nil then
  580. begin
  581. if RestIdentifier.NextSameIdentifier<>nil then
  582. Fail(Path+'.Local['+OrigIdentifier.Identifier+'] Too many RestIdentifier.NextSameIdentifier='+GetObjName(RestIdentifier.Element));
  583. break;
  584. end
  585. else begin
  586. if RestIdentifier.NextSameIdentifier=nil then
  587. Fail(Path+'.Local['+OrigIdentifier.Identifier+'] Missing RestIdentifier.NextSameIdentifier Orig='+GetObjName(OrigIdentifier.NextSameIdentifier.Element));
  588. end;
  589. if CompareText(OrigIdentifier.Identifier,OrigIdentifier.NextSameIdentifier.Identifier)<>0 then
  590. Fail(Path+'.Local['+OrigIdentifier.Identifier+'] Cur.Identifier<>Next.Identifier '+OrigIdentifier.Identifier+'<>'+OrigIdentifier.NextSameIdentifier.Identifier);
  591. OrigIdentifier:=OrigIdentifier.NextSameIdentifier;
  592. RestIdentifier:=RestIdentifier.NextSameIdentifier;
  593. until false;
  594. end;
  595. finally
  596. OrigList.Free;
  597. end;
  598. CheckRestoredPasScope(Path,Orig,Rest);
  599. end;
  600. procedure TCustomTestPrecompile.CheckRestoredSectionScope(const Path: string;
  601. Orig, Rest: TPas2JSSectionScope);
  602. var
  603. i: Integer;
  604. OrigUses, RestUses: TPas2JSSectionScope;
  605. begin
  606. if Orig.BoolSwitches<>Rest.BoolSwitches then
  607. Fail(Path+'.BoolSwitches Orig='+BoolSwitchesToStr(Orig.BoolSwitches)+' Rest='+BoolSwitchesToStr(Rest.BoolSwitches));
  608. if Orig.ModeSwitches<>Rest.ModeSwitches then
  609. Fail(Path+'.ModeSwitches');
  610. AssertEquals(Path+' UsesScopes.Count',Orig.UsesScopes.Count,Rest.UsesScopes.Count);
  611. for i:=0 to Orig.UsesScopes.Count-1 do
  612. begin
  613. OrigUses:=TPas2JSSectionScope(Orig.UsesScopes[i]);
  614. if not (TObject(Rest.UsesScopes[i]) is TPas2JSSectionScope) then
  615. Fail(Path+'.UsesScopes['+IntToStr(i)+'] Rest='+GetObjName(TObject(Rest.UsesScopes[i])));
  616. RestUses:=TPas2JSSectionScope(Rest.UsesScopes[i]);
  617. if OrigUses.ClassType<>RestUses.ClassType then
  618. Fail(Path+'.UsesScopes['+IntToStr(i)+'] Orig='+GetObjName(OrigUses)+' Rest='+GetObjName(RestUses));
  619. CheckRestoredReference(Path+'.UsesScopes['+IntToStr(i)+']',OrigUses.Element,RestUses.Element);
  620. end;
  621. AssertEquals(Path+'.Finished',Orig.Finished,Rest.Finished);
  622. CheckRestoredIdentifierScope(Path,Orig,Rest);
  623. end;
  624. procedure TCustomTestPrecompile.CheckRestoredInitialFinalizationScope(
  625. const Path: string; Orig, Rest: TPas2JSInitialFinalizationScope);
  626. begin
  627. CheckRestoredScopeRefs(Path+'.References',Orig.References,Rest.References);
  628. if Orig.JS<>Rest.JS then
  629. CheckRestoredJS(Path+'.JS',Orig.JS,Rest.JS);
  630. end;
  631. procedure TCustomTestPrecompile.CheckRestoredEnumTypeScope(const Path: string;
  632. Orig, Rest: TPasEnumTypeScope);
  633. begin
  634. CheckRestoredReference(Path+'.CanonicalSet',Orig.CanonicalSet,Rest.CanonicalSet);
  635. CheckRestoredIdentifierScope(Path,Orig,Rest);
  636. end;
  637. procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
  638. Orig, Rest: TPasRecordScope);
  639. begin
  640. CheckRestoredIdentifierScope(Path,Orig,Rest);
  641. end;
  642. procedure TCustomTestPrecompile.CheckRestoredClassScope(const Path: string;
  643. Orig, Rest: TPas2JSClassScope);
  644. var
  645. i, j: Integer;
  646. OrigObj, RestObj: TObject;
  647. OrigMap, RestMap: TPasClassIntfMap;
  648. SubPath: String;
  649. begin
  650. CheckRestoredScopeReference(Path+'.AncestorScope',Orig.AncestorScope,Rest.AncestorScope);
  651. CheckRestoredElement(Path+'.CanonicalClassOf',Orig.CanonicalClassOf,Rest.CanonicalClassOf);
  652. CheckRestoredReference(Path+'.DirectAncestor',Orig.DirectAncestor,Rest.DirectAncestor);
  653. CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
  654. if Orig.Flags<>Rest.Flags then
  655. Fail(Path+'.Flags');
  656. AssertEquals(Path+'.AbstractProcs.length',length(Orig.AbstractProcs),length(Rest.AbstractProcs));
  657. for i:=0 to length(Orig.AbstractProcs)-1 do
  658. CheckRestoredReference(Path+'.AbstractProcs['+IntToStr(i)+']',Orig.AbstractProcs[i],Rest.AbstractProcs[i]);
  659. CheckRestoredReference(Path+'.NewInstanceFunction',Orig.NewInstanceFunction,Rest.NewInstanceFunction);
  660. AssertEquals(Path+'.GUID',Orig.GUID,Rest.GUID);
  661. CheckRestoredObject('.Interfaces',Orig.Interfaces,Rest.Interfaces);
  662. if Orig.Interfaces<>nil then
  663. begin
  664. AssertEquals(Path+'.Interfaces.Count',Orig.Interfaces.Count,Rest.Interfaces.Count);
  665. for i:=0 to Orig.Interfaces.Count-1 do
  666. begin
  667. SubPath:=Path+'.Interfaces['+IntToStr(i)+']';
  668. OrigObj:=TObject(Orig.Interfaces[i]);
  669. RestObj:=TObject(Rest.Interfaces[i]);
  670. CheckRestoredObject(SubPath,OrigObj,RestObj);
  671. if OrigObj is TPasProperty then
  672. CheckRestoredReference(SubPath+'(TPasProperty)',
  673. TPasProperty(OrigObj),TPasProperty(RestObj))
  674. else if OrigObj is TPasClassIntfMap then
  675. begin
  676. OrigMap:=TPasClassIntfMap(OrigObj);
  677. RestMap:=TPasClassIntfMap(RestObj);
  678. repeat
  679. AssertNotNull(SubPath+'.Intf Orig',OrigMap.Intf);
  680. CheckRestoredObject(SubPath+'.Intf',OrigMap.Intf,RestMap.Intf);
  681. SubPath:=SubPath+'.Map('+OrigMap.Intf.Name+')';
  682. CheckRestoredObject(SubPath+'.Element',OrigMap.Element,RestMap.Element);
  683. CheckRestoredObject(SubPath+'.Procs',OrigMap.Procs,RestMap.Procs);
  684. if OrigMap.Procs=nil then
  685. begin
  686. if OrigMap.Intf.Members.Count>0 then
  687. Fail(SubPath+' expected '+IntToStr(OrigMap.Intf.Members.Count)+' procs, but Procs=nil');
  688. end
  689. else
  690. for j:=0 to OrigMap.Procs.Count-1 do
  691. begin
  692. OrigObj:=TObject(OrigMap.Procs[j]);
  693. RestObj:=TObject(RestMap.Procs[j]);
  694. CheckRestoredReference(SubPath+'.Procs['+IntToStr(j)+']',TPasElement(OrigObj),TPasElement(RestObj));
  695. end;
  696. AssertEquals(Path+'.Procs.Count',OrigMap.Procs.Count,RestMap.Procs.Count);
  697. CheckRestoredObject(SubPath+'.AncestorMap',OrigMap.AncestorMap,RestMap.AncestorMap);
  698. OrigMap:=OrigMap.AncestorMap;
  699. RestMap:=RestMap.AncestorMap;
  700. until OrigMap=nil;
  701. end
  702. else
  703. Fail(SubPath+' unknown class '+GetObjName(OrigObj));
  704. end;
  705. end;
  706. CheckRestoredIdentifierScope(Path,Orig,Rest);
  707. end;
  708. procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string;
  709. Orig, Rest: TPas2JSProcedureScope);
  710. var
  711. i: Integer;
  712. begin
  713. CheckRestoredReference(Path+'.DeclarationProc',Orig.DeclarationProc,Rest.DeclarationProc);
  714. CheckRestoredReference(Path+'.ImplProc',Orig.ImplProc,Rest.ImplProc);
  715. CheckRestoredScopeRefs(Path+'.References',Orig.References,Rest.References);
  716. if Orig.BodyJS<>Rest.BodyJS then
  717. CheckRestoredJS(Path+'.BodyJS',Orig.BodyJS,Rest.BodyJS);
  718. CheckRestoredObject(Path+'.GlobalJS',Orig.GlobalJS,Rest.GlobalJS);
  719. if Orig.GlobalJS<>nil then
  720. begin
  721. for i:=0 to Orig.GlobalJS.Count-1 do
  722. begin
  723. if i>=Rest.GlobalJS.Count then
  724. Fail(Path+'.GlobalJS['+IntToStr(i)+'] missing: '+Orig.GlobalJS[i]);
  725. CheckRestoredJS(Path+'.GlobalJS['+IntToStr(i)+']',Orig.GlobalJS[i],Rest.GlobalJS[i]);
  726. end;
  727. if Orig.GlobalJS.Count<Rest.GlobalJS.Count then
  728. Fail(Path+'.GlobalJS['+IntToStr(i)+'] too much: '+Rest.GlobalJS[Orig.GlobalJS.Count]);
  729. end;
  730. if Rest.DeclarationProc=nil then
  731. begin
  732. AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
  733. CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
  734. CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassScope,Rest.ClassScope);
  735. CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
  736. if Orig.Flags<>Rest.Flags then
  737. Fail(Path+'.Flags');
  738. if Orig.BoolSwitches<>Rest.BoolSwitches then
  739. Fail(Path+'.BoolSwitches');
  740. if Orig.ModeSwitches<>Rest.ModeSwitches then
  741. Fail(Path+'.ModeSwitches');
  742. //CheckRestoredIdentifierScope(Path,Orig,Rest);
  743. end
  744. else
  745. begin
  746. // ImplProc
  747. end;
  748. end;
  749. procedure TCustomTestPrecompile.CheckRestoredScopeRefs(const Path: string;
  750. Orig, Rest: TPasScopeReferences);
  751. var
  752. OrigList, RestList: TFPList;
  753. i: Integer;
  754. OrigRef, RestRef: TPasScopeReference;
  755. begin
  756. CheckRestoredObject(Path,Orig,Rest);
  757. if Orig=nil then exit;
  758. OrigList:=nil;
  759. RestList:=nil;
  760. try
  761. OrigList:=Orig.GetList;
  762. RestList:=Rest.GetList;
  763. OrigList.Sort(@CompareListOfProcScopeRef);
  764. RestList.Sort(@CompareListOfProcScopeRef);
  765. for i:=0 to OrigList.Count-1 do
  766. begin
  767. OrigRef:=TPasScopeReference(OrigList[i]);
  768. if i>=RestList.Count then
  769. Fail(Path+'['+IntToStr(i)+'] Missing in Rest: "'+OrigRef.Element.Name+'"');
  770. RestRef:=TPasScopeReference(RestList[i]);
  771. CheckRestoredReference(Path+'['+IntToStr(i)+'].Name="'+OrigRef.Element.Name+'"',OrigRef.Element,RestRef.Element);
  772. if OrigRef.Access<>RestRef.Access then
  773. AssertEquals(Path+'['+IntToStr(i)+']"'+OrigRef.Element.Name+'".Access',
  774. PCUPSRefAccessNames[OrigRef.Access],PCUPSRefAccessNames[RestRef.Access]);
  775. end;
  776. if RestList.Count>OrigList.Count then
  777. begin
  778. i:=OrigList.Count;
  779. RestRef:=TPasScopeReference(RestList[i]);
  780. Fail(Path+'['+IntToStr(i)+'] Too many in Rest: "'+RestRef.Element.Name+'"');
  781. end;
  782. finally
  783. OrigList.Free;
  784. RestList.Free;
  785. end;
  786. end;
  787. procedure TCustomTestPrecompile.CheckRestoredPropertyScope(const Path: string;
  788. Orig, Rest: TPasPropertyScope);
  789. begin
  790. CheckRestoredReference(Path+'.AncestorProp',Orig.AncestorProp,Rest.AncestorProp);
  791. CheckRestoredIdentifierScope(Path,Orig,Rest);
  792. end;
  793. procedure TCustomTestPrecompile.CheckRestoredResolvedReference(
  794. const Path: string; Orig, Rest: TResolvedReference);
  795. var
  796. C: TClass;
  797. begin
  798. if Orig.Flags<>Rest.Flags then
  799. Fail(Path+'.Flags');
  800. if Orig.Access<>Rest.Access then
  801. AssertEquals(Path+'.Access',PCUResolvedRefAccessNames[Orig.Access],PCUResolvedRefAccessNames[Rest.Access]);
  802. if not CheckRestoredObject(Path+'.Context',Orig.Context,Rest.Context) then exit;
  803. if Orig.Context<>nil then
  804. begin
  805. C:=Orig.Context.ClassType;
  806. if C=TResolvedRefCtxConstructor then
  807. CheckRestoredReference(Path+'.Context[TResolvedRefCtxConstructor].Typ',
  808. TResolvedRefCtxConstructor(Orig.Context).Typ,
  809. TResolvedRefCtxConstructor(Rest.Context).Typ);
  810. end;
  811. CheckRestoredScopeReference(Path+'.WithExprScope',Orig.WithExprScope,Rest.WithExprScope);
  812. CheckRestoredReference(Path+'.Declaration',Orig.Declaration,Rest.Declaration);
  813. CheckRestoredResolveData(Path,Orig,Rest);
  814. end;
  815. procedure TCustomTestPrecompile.CheckRestoredEvalValue(const Path: string;
  816. Orig, Rest: TResEvalValue);
  817. var
  818. i: Integer;
  819. begin
  820. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  821. if Orig.Kind<>Rest.Kind then
  822. Fail(Path+'.Kind');
  823. if not CheckRestoredObject(Path+'.Element',Orig.Element,Rest.Element) then exit;
  824. CheckRestoredReference(Path+'.IdentEl',Orig.IdentEl,Rest.IdentEl);
  825. case Orig.Kind of
  826. revkNone: Fail(Path+'.Kind=revkNone');
  827. revkCustom: Fail(Path+'.Kind=revkNone');
  828. revkNil: ;
  829. revkBool: AssertEquals(Path+'.B',TResEvalBool(Orig).B,TResEvalBool(Rest).B);
  830. revkInt: AssertEquals(Path+'.Int',TResEvalInt(Orig).Int,TResEvalInt(Rest).Int);
  831. revkUInt:
  832. if TResEvalUInt(Orig).UInt<>TResEvalUInt(Rest).UInt then
  833. Fail(Path+'.UInt');
  834. revkFloat: AssertEquals(Path+'.FloatValue',TResEvalFloat(Orig).FloatValue,TResEvalFloat(Rest).FloatValue);
  835. revkString: AssertEquals(Path+'.S,Raw',TResEvalString(Orig).S,TResEvalString(Rest).S);
  836. revkUnicodeString: AssertEquals(Path+'.S,UTF16',String(TResEvalUTF16(Orig).S),String(TResEvalUTF16(Rest).S));
  837. revkEnum:
  838. begin
  839. AssertEquals(Path+'.Index',TResEvalEnum(Orig).Index,TResEvalEnum(Rest).Index);
  840. CheckRestoredReference(Path+'.ElType',TResEvalEnum(Orig).ElType,TResEvalEnum(Rest).ElType);
  841. end;
  842. revkRangeInt:
  843. begin
  844. if TResEvalRangeInt(Orig).ElKind<>TResEvalRangeInt(Rest).ElKind then
  845. Fail(Path+'.Int/ElKind');
  846. CheckRestoredReference(Path+'.Int/ElType',TResEvalRangeInt(Orig).ElType,TResEvalRangeInt(Rest).ElType);
  847. AssertEquals(Path+'.Int/RangeStart',TResEvalRangeInt(Orig).RangeStart,TResEvalRangeInt(Rest).RangeStart);
  848. AssertEquals(Path+'.Int/RangeEnd',TResEvalRangeInt(Orig).RangeEnd,TResEvalRangeInt(Rest).RangeEnd);
  849. end;
  850. revkRangeUInt:
  851. begin
  852. if TResEvalRangeUInt(Orig).RangeStart<>TResEvalRangeUInt(Rest).RangeStart then
  853. Fail(Path+'.UInt/RangeStart');
  854. if TResEvalRangeUInt(Orig).RangeEnd<>TResEvalRangeUInt(Rest).RangeEnd then
  855. Fail(Path+'.UInt/RangeEnd');
  856. end;
  857. revkSetOfInt:
  858. begin
  859. if TResEvalSet(Orig).ElKind<>TResEvalSet(Rest).ElKind then
  860. Fail(Path+'.SetInt/ElKind');
  861. CheckRestoredReference(Path+'.SetInt/ElType',TResEvalSet(Orig).ElType,TResEvalSet(Rest).ElType);
  862. AssertEquals(Path+'.SetInt/RangeStart',TResEvalSet(Orig).RangeStart,TResEvalSet(Rest).RangeStart);
  863. AssertEquals(Path+'.SetInt/RangeEnd',TResEvalSet(Orig).RangeEnd,TResEvalSet(Rest).RangeEnd);
  864. AssertEquals(Path+'.SetInt/length(Items)',length(TResEvalSet(Orig).Ranges),length(TResEvalSet(Rest).Ranges));
  865. for i:=0 to length(TResEvalSet(Orig).Ranges)-1 do
  866. begin
  867. AssertEquals(Path+'.SetInt/Items['+IntToStr(i)+'].RangeStart',
  868. TResEvalSet(Orig).Ranges[i].RangeStart,TResEvalSet(Rest).Ranges[i].RangeStart);
  869. AssertEquals(Path+'.SetInt/Items['+IntToStr(i)+'].RangeEnd',
  870. TResEvalSet(Orig).Ranges[i].RangeEnd,TResEvalSet(Rest).Ranges[i].RangeEnd);
  871. end;
  872. end;
  873. end;
  874. end;
  875. procedure TCustomTestPrecompile.CheckRestoredCustomData(const Path: string;
  876. RestoredEl: TPasElement; Orig, Rest: TObject);
  877. var
  878. C: TClass;
  879. begin
  880. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  881. C:=Orig.ClassType;
  882. if C=TResolvedReference then
  883. CheckRestoredResolvedReference(Path+'[TResolvedReference]',TResolvedReference(Orig),TResolvedReference(Rest))
  884. else if C=TPas2JSModuleScope then
  885. CheckRestoredModuleScope(Path+'[TPas2JSModuleScope]',TPas2JSModuleScope(Orig),TPas2JSModuleScope(Rest))
  886. else if C=TPas2JSSectionScope then
  887. CheckRestoredSectionScope(Path+'[TPas2JSSectionScope]',TPas2JSSectionScope(Orig),TPas2JSSectionScope(Rest))
  888. else if C=TPas2JSInitialFinalizationScope then
  889. CheckRestoredInitialFinalizationScope(Path+'[TPas2JSInitialFinalizationScope]',TPas2JSInitialFinalizationScope(Orig),TPas2JSInitialFinalizationScope(Rest))
  890. else if C=TPasEnumTypeScope then
  891. CheckRestoredEnumTypeScope(Path+'[TPasEnumTypeScope]',TPasEnumTypeScope(Orig),TPasEnumTypeScope(Rest))
  892. else if C=TPasRecordScope then
  893. CheckRestoredRecordScope(Path+'[TPasRecordScope]',TPasRecordScope(Orig),TPasRecordScope(Rest))
  894. else if C=TPas2JSClassScope then
  895. CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest))
  896. else if C=TPas2JSProcedureScope then
  897. CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest))
  898. else if C=TPasPropertyScope then
  899. CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest))
  900. else if C.InheritsFrom(TResEvalValue) then
  901. CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
  902. else
  903. Fail(Path+': unknown CustomData "'+GetObjName(Orig)+'" El='+GetObjName(RestoredEl));
  904. end;
  905. procedure TCustomTestPrecompile.CheckRestoredReference(const Path: string;
  906. Orig, Rest: TPasElement);
  907. begin
  908. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  909. AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
  910. if Orig is TPasUnresolvedSymbolRef then
  911. exit; // compiler types and procs are the same in every unit -> skip checking unit
  912. CheckRestoredReference(Path+'.Parent',Orig.Parent,Rest.Parent);
  913. end;
  914. procedure TCustomTestPrecompile.CheckRestoredElOrRef(const Path: string; Orig,
  915. OrigProp, Rest, RestProp: TPasElement);
  916. begin
  917. if not CheckRestoredObject(Path,OrigProp,RestProp) then exit;
  918. if Orig<>OrigProp.Parent then
  919. begin
  920. if Rest=RestProp.Parent then
  921. Fail(Path+' Orig "'+GetObjName(OrigProp)+'" is reference Orig.Parent='+GetObjName(Orig)+', Rest "'+GetObjName(RestProp)+'" is insitu');
  922. CheckRestoredReference(Path,OrigProp,RestProp);
  923. end
  924. else
  925. CheckRestoredElement(Path,OrigProp,RestProp);
  926. end;
  927. procedure TCustomTestPrecompile.CheckRestoredAnalyzerElement(
  928. const Path: string; Orig, Rest: TPasElement);
  929. var
  930. OrigUsed, RestUsed: TPAElement;
  931. begin
  932. //writeln('TCustomTestPrecompile.CheckRestoredAnalyzerElement ',GetObjName(RestAnalyzer));
  933. if RestAnalyzer=nil then exit;
  934. if Orig.ClassType=TPasArgument then exit;
  935. OrigUsed:=Analyzer.FindUsedElement(Orig);
  936. //writeln('TCustomTestPrecompile.CheckRestoredAnalyzerElement ',GetObjName(Orig),'=',OrigUsed<>nil,' ',GetObjName(Rest),'=',RestAnalyzer.FindUsedElement(Rest)<>nil);
  937. if OrigUsed<>nil then
  938. begin
  939. RestUsed:=RestAnalyzer.FindUsedElement(Rest);
  940. if RestUsed=nil then
  941. Fail(Path+': used in OrigAnalyzer, but not used in RestAnalyzer');
  942. if OrigUsed.Access<>RestUsed.Access then
  943. AssertEquals(Path+'->Analyzer.Access',dbgs(OrigUsed.Access),dbgs(RestUsed.Access));
  944. end
  945. else if RestAnalyzer.IsUsed(Rest) then
  946. begin
  947. Fail(Path+': not used in OrigAnalyzer, but used in RestAnalyzer');
  948. end;
  949. end;
  950. procedure TCustomTestPrecompile.CheckRestoredElement(const Path: string; Orig,
  951. Rest: TPasElement);
  952. var
  953. C: TClass;
  954. AModule: TPasModule;
  955. begin
  956. //writeln('TCustomTestPrecompile.CheckRestoredElement START Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
  957. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  958. //writeln('TCustomTestPrecompile.CheckRestoredElement CheckRestoredObject Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
  959. AModule:=Orig.GetModule;
  960. if AModule<>Module then
  961. Fail(Path+' wrong module: Orig='+GetObjName(AModule)+' '+GetObjName(Module));
  962. AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
  963. AssertEquals(Path+'.SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
  964. AssertEquals(Path+'.SourceLinenumber',Orig.SourceLinenumber,Rest.SourceLinenumber);
  965. //AssertEquals(Path+'.SourceEndLinenumber',Orig.SourceEndLinenumber,Rest.SourceEndLinenumber);
  966. if Orig.Visibility<>Rest.Visibility then
  967. Fail(Path+'.Visibility '+PCUMemberVisibilityNames[Orig.Visibility]+' '+PCUMemberVisibilityNames[Rest.Visibility]);
  968. if Orig.Hints<>Rest.Hints then
  969. Fail(Path+'.Hints');
  970. AssertEquals(Path+'.HintMessage',Orig.HintMessage,Rest.HintMessage);
  971. //writeln('TCustomTestPrecompile.CheckRestoredElement Checking Parent... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
  972. CheckRestoredReference(Path+'.Parent',Orig.Parent,Rest.Parent);
  973. //writeln('TCustomTestPrecompile.CheckRestoredElement Checking CustomData... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
  974. CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData);
  975. C:=Orig.ClassType;
  976. if C=TUnaryExpr then
  977. CheckRestoredUnaryExpr(Path,TUnaryExpr(Orig),TUnaryExpr(Rest))
  978. else if C=TBinaryExpr then
  979. CheckRestoredBinaryExpr(Path,TBinaryExpr(Orig),TBinaryExpr(Rest))
  980. else if C=TPrimitiveExpr then
  981. CheckRestoredPrimitiveExpr(Path,TPrimitiveExpr(Orig),TPrimitiveExpr(Rest))
  982. else if C=TBoolConstExpr then
  983. CheckRestoredBoolConstExpr(Path,TBoolConstExpr(Orig),TBoolConstExpr(Rest))
  984. else if (C=TNilExpr)
  985. or (C=TInheritedExpr)
  986. or (C=TSelfExpr) then
  987. CheckRestoredPasExpr(Path,TPasExpr(Orig),TPasExpr(Rest))
  988. else if C=TParamsExpr then
  989. CheckRestoredParamsExpr(Path,TParamsExpr(Orig),TParamsExpr(Rest))
  990. else if C=TRecordValues then
  991. CheckRestoredRecordValues(Path,TRecordValues(Orig),TRecordValues(Rest))
  992. else if C=TArrayValues then
  993. CheckRestoredArrayValues(Path,TArrayValues(Orig),TArrayValues(Rest))
  994. // TPasDeclarations is a base class
  995. // TPasUsesUnit is checked in usesclause
  996. // TPasSection is a base class
  997. else if C=TPasResString then
  998. CheckRestoredResString(Path,TPasResString(Orig),TPasResString(Rest))
  999. // TPasType is a base clas
  1000. else if (C=TPasAliasType)
  1001. or (C=TPasTypeAliasType)
  1002. or (C=TPasClassOfType) then
  1003. CheckRestoredAliasType(Path,TPasAliasType(Orig),TPasAliasType(Rest))
  1004. else if C=TPasPointerType then
  1005. CheckRestoredPointerType(Path,TPasPointerType(Orig),TPasPointerType(Rest))
  1006. else if C=TPasSpecializeType then
  1007. CheckRestoredSpecializedType(Path,TPasSpecializeType(Orig),TPasSpecializeType(Rest))
  1008. else if C=TInlineSpecializeExpr then
  1009. CheckRestoredInlineSpecializedExpr(Path,TInlineSpecializeExpr(Orig),TInlineSpecializeExpr(Rest))
  1010. else if C=TPasRangeType then
  1011. CheckRestoredRangeType(Path,TPasRangeType(Orig),TPasRangeType(Rest))
  1012. else if C=TPasArrayType then
  1013. CheckRestoredArrayType(Path,TPasArrayType(Orig),TPasArrayType(Rest))
  1014. else if C=TPasFileType then
  1015. CheckRestoredFileType(Path,TPasFileType(Orig),TPasFileType(Rest))
  1016. else if C=TPasEnumValue then
  1017. CheckRestoredEnumValue(Path,TPasEnumValue(Orig),TPasEnumValue(Rest))
  1018. else if C=TPasEnumType then
  1019. CheckRestoredEnumType(Path,TPasEnumType(Orig),TPasEnumType(Rest))
  1020. else if C=TPasSetType then
  1021. CheckRestoredSetType(Path,TPasSetType(Orig),TPasSetType(Rest))
  1022. else if C=TPasVariant then
  1023. CheckRestoredVariant(Path,TPasVariant(Orig),TPasVariant(Rest))
  1024. else if C=TPasRecordType then
  1025. CheckRestoredRecordType(Path,TPasRecordType(Orig),TPasRecordType(Rest))
  1026. else if C=TPasClassType then
  1027. CheckRestoredClassType(Path,TPasClassType(Orig),TPasClassType(Rest))
  1028. else if C=TPasArgument then
  1029. CheckRestoredArgument(Path,TPasArgument(Orig),TPasArgument(Rest))
  1030. else if C=TPasProcedureType then
  1031. CheckRestoredProcedureType(Path,TPasProcedureType(Orig),TPasProcedureType(Rest))
  1032. else if C=TPasResultElement then
  1033. CheckRestoredResultElement(Path,TPasResultElement(Orig),TPasResultElement(Rest))
  1034. else if C=TPasFunctionType then
  1035. CheckRestoredFunctionType(Path,TPasFunctionType(Orig),TPasFunctionType(Rest))
  1036. else if C=TPasStringType then
  1037. CheckRestoredStringType(Path,TPasStringType(Orig),TPasStringType(Rest))
  1038. else if C=TPasVariable then
  1039. CheckRestoredVariable(Path,TPasVariable(Orig),TPasVariable(Rest))
  1040. else if C=TPasExportSymbol then
  1041. CheckRestoredExportSymbol(Path,TPasExportSymbol(Orig),TPasExportSymbol(Rest))
  1042. else if C=TPasConst then
  1043. CheckRestoredConst(Path,TPasConst(Orig),TPasConst(Rest))
  1044. else if C=TPasProperty then
  1045. CheckRestoredProperty(Path,TPasProperty(Orig),TPasProperty(Rest))
  1046. else if C=TPasMethodResolution then
  1047. CheckRestoredMethodResolution(Path,TPasMethodResolution(Orig),TPasMethodResolution(Rest))
  1048. else if (C=TPasProcedure)
  1049. or (C=TPasFunction)
  1050. or (C=TPasConstructor)
  1051. or (C=TPasClassConstructor)
  1052. or (C=TPasDestructor)
  1053. or (C=TPasClassDestructor)
  1054. or (C=TPasClassProcedure)
  1055. or (C=TPasClassFunction)
  1056. then
  1057. CheckRestoredProcedure(Path,TPasProcedure(Orig),TPasProcedure(Rest))
  1058. else if (C=TPasOperator)
  1059. or (C=TPasClassOperator) then
  1060. CheckRestoredOperator(Path,TPasOperator(Orig),TPasOperator(Rest))
  1061. else if (C=TPasModule)
  1062. or (C=TPasProgram)
  1063. or (C=TPasLibrary) then
  1064. CheckRestoredModule(Path,TPasModule(Orig),TPasModule(Rest))
  1065. else if C.InheritsFrom(TPasSection) then
  1066. CheckRestoredSection(Path,TPasSection(Orig),TPasSection(Rest))
  1067. else
  1068. Fail(Path+': unknown class '+C.ClassName);
  1069. CheckRestoredAnalyzerElement(Path,Orig,Rest);
  1070. end;
  1071. procedure TCustomTestPrecompile.CheckRestoredElementList(const Path: string;
  1072. Orig, Rest: TFPList);
  1073. var
  1074. OrigItem, RestItem: TObject;
  1075. i: Integer;
  1076. SubPath: String;
  1077. begin
  1078. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  1079. AssertEquals(Path+'.Count',Orig.Count,Rest.Count);
  1080. for i:=0 to Orig.Count-1 do
  1081. begin
  1082. SubPath:=Path+'['+IntToStr(i)+']';
  1083. OrigItem:=TObject(Orig[i]);
  1084. if not (OrigItem is TPasElement) then
  1085. Fail(SubPath+' Orig='+GetObjName(OrigItem));
  1086. RestItem:=TObject(Rest[i]);
  1087. if not (RestItem is TPasElement) then
  1088. Fail(SubPath+' Rest='+GetObjName(RestItem));
  1089. //writeln('TCustomTestPrecompile.CheckRestoredElementList ',GetObjName(OrigItem),' ',GetObjName(RestItem));
  1090. SubPath:=Path+'['+IntToStr(i)+']"'+TPasElement(OrigItem).Name+'"';
  1091. CheckRestoredElement(SubPath,TPasElement(OrigItem),TPasElement(RestItem));
  1092. end;
  1093. end;
  1094. procedure TCustomTestPrecompile.CheckRestoredElRefList(const Path: string;
  1095. OrigParent: TPasElement; Orig: TFPList; RestParent: TPasElement;
  1096. Rest: TFPList; AllowInSitu: boolean);
  1097. var
  1098. OrigItem, RestItem: TObject;
  1099. i: Integer;
  1100. SubPath: String;
  1101. begin
  1102. if not CheckRestoredObject(Path,Orig,Rest) then exit;
  1103. AssertEquals(Path+'.Count',Orig.Count,Rest.Count);
  1104. for i:=0 to Orig.Count-1 do
  1105. begin
  1106. SubPath:=Path+'['+IntToStr(i)+']';
  1107. OrigItem:=TObject(Orig[i]);
  1108. if not (OrigItem is TPasElement) then
  1109. Fail(SubPath+' Orig='+GetObjName(OrigItem));
  1110. RestItem:=TObject(Rest[i]);
  1111. if not (RestItem is TPasElement) then
  1112. Fail(SubPath+' Rest='+GetObjName(RestItem));
  1113. if AllowInSitu then
  1114. CheckRestoredElOrRef(SubPath,OrigParent,TPasElement(OrigItem),RestParent,TPasElement(RestItem))
  1115. else
  1116. CheckRestoredReference(SubPath,TPasElement(OrigItem),TPasElement(RestItem));
  1117. end;
  1118. end;
  1119. procedure TCustomTestPrecompile.CheckRestoredPasExpr(const Path: string; Orig,
  1120. Rest: TPasExpr);
  1121. begin
  1122. if Orig.Kind<>Rest.Kind then
  1123. Fail(Path+'.Kind');
  1124. if Orig.OpCode<>Rest.OpCode then
  1125. Fail(Path+'.OpCode');
  1126. CheckRestoredElement(Path+'.Format1',Orig.format1,Rest.format1);
  1127. CheckRestoredElement(Path+'.Format2',Orig.format2,Rest.format2);
  1128. end;
  1129. procedure TCustomTestPrecompile.CheckRestoredUnaryExpr(const Path: string;
  1130. Orig, Rest: TUnaryExpr);
  1131. begin
  1132. CheckRestoredElement(Path+'.Operand',Orig.Operand,Rest.Operand);
  1133. CheckRestoredPasExpr(Path,Orig,Rest);
  1134. end;
  1135. procedure TCustomTestPrecompile.CheckRestoredBinaryExpr(const Path: string;
  1136. Orig, Rest: TBinaryExpr);
  1137. begin
  1138. CheckRestoredElement(Path+'.left',Orig.left,Rest.left);
  1139. CheckRestoredElement(Path+'.right',Orig.right,Rest.right);
  1140. CheckRestoredPasExpr(Path,Orig,Rest);
  1141. end;
  1142. procedure TCustomTestPrecompile.CheckRestoredPrimitiveExpr(const Path: string;
  1143. Orig, Rest: TPrimitiveExpr);
  1144. begin
  1145. AssertEquals(Path+'.Value',Orig.Value,Rest.Value);
  1146. CheckRestoredPasExpr(Path,Orig,Rest);
  1147. end;
  1148. procedure TCustomTestPrecompile.CheckRestoredBoolConstExpr(const Path: string;
  1149. Orig, Rest: TBoolConstExpr);
  1150. begin
  1151. AssertEquals(Path+'.Value',Orig.Value,Rest.Value);
  1152. CheckRestoredPasExpr(Path,Orig,Rest);
  1153. end;
  1154. procedure TCustomTestPrecompile.CheckRestoredParamsExpr(const Path: string;
  1155. Orig, Rest: TParamsExpr);
  1156. begin
  1157. CheckRestoredElement(Path+'.Value',Orig.Value,Rest.Value);
  1158. CheckRestoredPasExprArray(Path+'.Params',Orig.Params,Rest.Params);
  1159. CheckRestoredPasExpr(Path,Orig,Rest);
  1160. end;
  1161. procedure TCustomTestPrecompile.CheckRestoredRecordValues(const Path: string;
  1162. Orig, Rest: TRecordValues);
  1163. var
  1164. i: Integer;
  1165. begin
  1166. AssertEquals(Path+'.Fields.length',length(Orig.Fields),length(Rest.Fields));
  1167. for i:=0 to length(Orig.Fields)-1 do
  1168. begin
  1169. AssertEquals(Path+'.Field['+IntToStr(i)+'].Name',Orig.Fields[i].Name,Rest.Fields[i].Name);
  1170. CheckRestoredElement(Path+'.Field['+IntToStr(i)+'].ValueExp',Orig.Fields[i].ValueExp,Rest.Fields[i].ValueExp);
  1171. end;
  1172. CheckRestoredPasExpr(Path,Orig,Rest);
  1173. end;
  1174. procedure TCustomTestPrecompile.CheckRestoredPasExprArray(const Path: string;
  1175. Orig, Rest: TPasExprArray);
  1176. var
  1177. i: Integer;
  1178. begin
  1179. AssertEquals(Path+'.length',length(Orig),length(Rest));
  1180. for i:=0 to length(Orig)-1 do
  1181. CheckRestoredElement(Path+'['+IntToStr(i)+']',Orig[i],Rest[i]);
  1182. end;
  1183. procedure TCustomTestPrecompile.CheckRestoredArrayValues(const Path: string;
  1184. Orig, Rest: TArrayValues);
  1185. begin
  1186. CheckRestoredPasExprArray(Path+'.Values',Orig.Values,Rest.Values);
  1187. CheckRestoredPasExpr(Path,Orig,Rest);
  1188. end;
  1189. procedure TCustomTestPrecompile.CheckRestoredResString(const Path: string;
  1190. Orig, Rest: TPasResString);
  1191. begin
  1192. CheckRestoredElement(Path+'.Expr',Orig.Expr,Rest.Expr);
  1193. end;
  1194. procedure TCustomTestPrecompile.CheckRestoredAliasType(const Path: string;
  1195. Orig, Rest: TPasAliasType);
  1196. begin
  1197. CheckRestoredElOrRef(Path+'.DestType',Orig,Orig.DestType,Rest,Rest.DestType);
  1198. CheckRestoredElement(Path+'.Expr',Orig.Expr,Rest.Expr);
  1199. end;
  1200. procedure TCustomTestPrecompile.CheckRestoredPointerType(const Path: string;
  1201. Orig, Rest: TPasPointerType);
  1202. begin
  1203. CheckRestoredElOrRef(Path+'.DestType',Orig,Orig.DestType,Rest,Rest.DestType);
  1204. end;
  1205. procedure TCustomTestPrecompile.CheckRestoredSpecializedType(
  1206. const Path: string; Orig, Rest: TPasSpecializeType);
  1207. begin
  1208. CheckRestoredElementList(Path+'.Params',Orig.Params,Rest.Params);
  1209. CheckRestoredElOrRef(Path+'.DestType',Orig,Orig.DestType,Rest,Rest.DestType);
  1210. end;
  1211. procedure TCustomTestPrecompile.CheckRestoredInlineSpecializedExpr(
  1212. const Path: string; Orig, Rest: TInlineSpecializeExpr);
  1213. begin
  1214. CheckRestoredElOrRef(Path+'.DestType',Orig,Orig.DestType,Rest,Rest.DestType);
  1215. end;
  1216. procedure TCustomTestPrecompile.CheckRestoredRangeType(const Path: string;
  1217. Orig, Rest: TPasRangeType);
  1218. begin
  1219. CheckRestoredElement(Path+'.RangeExpr',Orig.RangeExpr,Rest.RangeExpr);
  1220. end;
  1221. procedure TCustomTestPrecompile.CheckRestoredArrayType(const Path: string;
  1222. Orig, Rest: TPasArrayType);
  1223. begin
  1224. CheckRestoredPasExprArray(Path+'.Ranges',Orig.Ranges,Rest.Ranges);
  1225. if Orig.PackMode<>Rest.PackMode then
  1226. Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
  1227. CheckRestoredElOrRef(Path+'.ElType',Orig,Orig.ElType,Rest,Rest.ElType);
  1228. end;
  1229. procedure TCustomTestPrecompile.CheckRestoredFileType(const Path: string; Orig,
  1230. Rest: TPasFileType);
  1231. begin
  1232. CheckRestoredElOrRef(Path+'.ElType',Orig,Orig.ElType,Rest,Rest.ElType);
  1233. end;
  1234. procedure TCustomTestPrecompile.CheckRestoredEnumValue(const Path: string;
  1235. Orig, Rest: TPasEnumValue);
  1236. begin
  1237. CheckRestoredElement(Path+'.Value',Orig.Value,Rest.Value);
  1238. end;
  1239. procedure TCustomTestPrecompile.CheckRestoredEnumType(const Path: string; Orig,
  1240. Rest: TPasEnumType);
  1241. begin
  1242. CheckRestoredElementList(Path+'.Values',Orig.Values,Rest.Values);
  1243. end;
  1244. procedure TCustomTestPrecompile.CheckRestoredSetType(const Path: string; Orig,
  1245. Rest: TPasSetType);
  1246. begin
  1247. CheckRestoredElOrRef(Path+'.EnumType',Orig,Orig.EnumType,Rest,Rest.EnumType);
  1248. AssertEquals(Path+'.IsPacked',Orig.IsPacked,Rest.IsPacked);
  1249. end;
  1250. procedure TCustomTestPrecompile.CheckRestoredVariant(const Path: string; Orig,
  1251. Rest: TPasVariant);
  1252. begin
  1253. CheckRestoredElementList(Path+'.Values',Orig.Values,Rest.Values);
  1254. CheckRestoredElement(Path+'.Members',Orig.Members,Rest.Members);
  1255. end;
  1256. procedure TCustomTestPrecompile.CheckRestoredRecordType(const Path: string;
  1257. Orig, Rest: TPasRecordType);
  1258. begin
  1259. if Orig.PackMode<>Rest.PackMode then
  1260. Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
  1261. CheckRestoredElementList(Path+'.Members',Orig.Members,Rest.Members);
  1262. CheckRestoredElOrRef(Path+'.VariantEl',Orig,Orig.VariantEl,Rest,Rest.VariantEl);
  1263. CheckRestoredElementList(Path+'.Variants',Orig.Variants,Rest.Variants);
  1264. CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
  1265. end;
  1266. procedure TCustomTestPrecompile.CheckRestoredClassType(const Path: string;
  1267. Orig, Rest: TPasClassType);
  1268. begin
  1269. if Orig.PackMode<>Rest.PackMode then
  1270. Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
  1271. if Orig.ObjKind<>Rest.ObjKind then
  1272. Fail(Path+'.ObjKind Orig='+PCUObjKindNames[Orig.ObjKind]+' Rest='+PCUObjKindNames[Rest.ObjKind]);
  1273. if Orig.InterfaceType<>Rest.InterfaceType then
  1274. Fail(Path+'.ObjKind Orig='+PCUClassInterfaceTypeNames[Orig.InterfaceType]+' Rest='+PCUClassInterfaceTypeNames[Rest.InterfaceType]);
  1275. CheckRestoredReference(Path+'.AncestorType',Orig.AncestorType,Rest.AncestorType);
  1276. CheckRestoredReference(Path+'.HelperForType',Orig.HelperForType,Rest.HelperForType);
  1277. AssertEquals(Path+'.IsForward',Orig.IsForward,Rest.IsForward);
  1278. AssertEquals(Path+'.IsExternal',Orig.IsExternal,Rest.IsExternal);
  1279. // irrelevant: IsShortDefinition
  1280. CheckRestoredElement(Path+'.GUIDExpr',Orig.GUIDExpr,Rest.GUIDExpr);
  1281. CheckRestoredElementList(Path+'.Members',Orig.Members,Rest.Members);
  1282. AssertEquals(Path+'.Modifiers',Orig.Modifiers.Text,Rest.Modifiers.Text);
  1283. CheckRestoredElRefList(Path+'.Interfaces',Orig,Orig.Interfaces,Rest,Rest.Interfaces,false);
  1284. CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
  1285. AssertEquals(Path+'.ExternalNameSpace',Orig.ExternalNameSpace,Rest.ExternalNameSpace);
  1286. AssertEquals(Path+'.ExternalName',Orig.ExternalName,Rest.ExternalName);
  1287. end;
  1288. procedure TCustomTestPrecompile.CheckRestoredArgument(const Path: string; Orig,
  1289. Rest: TPasArgument);
  1290. begin
  1291. if Orig.Access<>Rest.Access then
  1292. Fail(Path+'.Access Orig='+PCUArgumentAccessNames[Orig.Access]+' Rest='+PCUArgumentAccessNames[Rest.Access]);
  1293. CheckRestoredElOrRef(Path+'.ArgType',Orig,Orig.ArgType,Rest,Rest.ArgType);
  1294. CheckRestoredElement(Path+'.ValueExpr',Orig.ValueExpr,Rest.ValueExpr);
  1295. end;
  1296. procedure TCustomTestPrecompile.CheckRestoredProcedureType(const Path: string;
  1297. Orig, Rest: TPasProcedureType);
  1298. begin
  1299. CheckRestoredElementList(Path+'.Args',Orig.Args,Rest.Args);
  1300. if Orig.CallingConvention<>Rest.CallingConvention then
  1301. Fail(Path+'.CallingConvention Orig='+PCUCallingConventionNames[Orig.CallingConvention]+' Rest='+PCUCallingConventionNames[Rest.CallingConvention]);
  1302. if Orig.Modifiers<>Rest.Modifiers then
  1303. Fail(Path+'.Modifiers');
  1304. end;
  1305. procedure TCustomTestPrecompile.CheckRestoredResultElement(const Path: string;
  1306. Orig, Rest: TPasResultElement);
  1307. begin
  1308. CheckRestoredElOrRef(Path+'.ResultType',Orig,Orig.ResultType,Rest,Rest.ResultType);
  1309. end;
  1310. procedure TCustomTestPrecompile.CheckRestoredFunctionType(const Path: string;
  1311. Orig, Rest: TPasFunctionType);
  1312. begin
  1313. CheckRestoredElement(Path+'.ResultEl',Orig.ResultEl,Rest.ResultEl);
  1314. CheckRestoredProcedureType(Path,Orig,Rest);
  1315. end;
  1316. procedure TCustomTestPrecompile.CheckRestoredStringType(const Path: string;
  1317. Orig, Rest: TPasStringType);
  1318. begin
  1319. AssertEquals(Path+'.LengthExpr',Orig.LengthExpr,Rest.LengthExpr);
  1320. end;
  1321. procedure TCustomTestPrecompile.CheckRestoredVariable(const Path: string; Orig,
  1322. Rest: TPasVariable);
  1323. begin
  1324. CheckRestoredElOrRef(Path+'.VarType',Orig,Orig.VarType,Rest,Rest.VarType);
  1325. if Orig.VarModifiers<>Rest.VarModifiers then
  1326. Fail(Path+'.VarModifiers');
  1327. CheckRestoredElement(Path+'.LibraryName',Orig.LibraryName,Rest.LibraryName);
  1328. CheckRestoredElement(Path+'.ExportName',Orig.ExportName,Rest.ExportName);
  1329. CheckRestoredElement(Path+'.AbsoluteExpr',Orig.AbsoluteExpr,Rest.AbsoluteExpr);
  1330. CheckRestoredElement(Path+'.Expr',Orig.Expr,Rest.Expr);
  1331. end;
  1332. procedure TCustomTestPrecompile.CheckRestoredExportSymbol(const Path: string;
  1333. Orig, Rest: TPasExportSymbol);
  1334. begin
  1335. CheckRestoredElement(Path+'.ExportName',Orig.ExportName,Rest.ExportName);
  1336. CheckRestoredElement(Path+'.ExportIndex',Orig.ExportIndex,Rest.ExportIndex);
  1337. end;
  1338. procedure TCustomTestPrecompile.CheckRestoredConst(const Path: string; Orig,
  1339. Rest: TPasConst);
  1340. begin
  1341. AssertEquals(Path+'.IsConst',Orig.IsConst,Rest.IsConst);
  1342. CheckRestoredVariable(Path,Orig,Rest);
  1343. end;
  1344. procedure TCustomTestPrecompile.CheckRestoredProperty(const Path: string; Orig,
  1345. Rest: TPasProperty);
  1346. begin
  1347. CheckRestoredElement(Path+'.IndexExpr',Orig.IndexExpr,Rest.IndexExpr);
  1348. CheckRestoredElement(Path+'.ReadAccessor',Orig.ReadAccessor,Rest.ReadAccessor);
  1349. CheckRestoredElement(Path+'.WriteAccessor',Orig.WriteAccessor,Rest.WriteAccessor);
  1350. CheckRestoredElement(Path+'.DispIDExpr',Orig.DispIDExpr,Rest.DispIDExpr);
  1351. CheckRestoredPasExprArray(Path+'.Implements',Orig.Implements,Rest.Implements);
  1352. CheckRestoredElement(Path+'.StoredAccessor',Orig.StoredAccessor,Rest.StoredAccessor);
  1353. CheckRestoredElement(Path+'.DefaultExpr',Orig.DefaultExpr,Rest.DefaultExpr);
  1354. CheckRestoredElementList(Path+'.Args',Orig.Args,Rest.Args);
  1355. // not needed: ReadAccessorName, WriteAccessorName, ImplementsName, StoredAccessorName
  1356. AssertEquals(Path+'.DispIDReadOnly',Orig.DispIDReadOnly,Rest.DispIDReadOnly);
  1357. AssertEquals(Path+'.IsDefault',Orig.IsDefault,Rest.IsDefault);
  1358. AssertEquals(Path+'.IsNodefault',Orig.IsNodefault,Rest.IsNodefault);
  1359. CheckRestoredVariable(Path,Orig,Rest);
  1360. end;
  1361. procedure TCustomTestPrecompile.CheckRestoredMethodResolution(
  1362. const Path: string; Orig, Rest: TPasMethodResolution);
  1363. begin
  1364. AssertEquals(Path+'.ProcClass',Orig.ProcClass,Rest.ProcClass);
  1365. CheckRestoredElement(Path+'.InterfaceName',Orig.InterfaceName,Rest.InterfaceName);
  1366. CheckRestoredElement(Path+'.InterfaceProc',Orig.InterfaceProc,Rest.InterfaceProc);
  1367. CheckRestoredElement(Path+'.ImplementationProc',Orig.ImplementationProc,Rest.ImplementationProc);
  1368. end;
  1369. procedure TCustomTestPrecompile.CheckRestoredProcedure(const Path: string;
  1370. Orig, Rest: TPasProcedure);
  1371. var
  1372. RestScope, OrigScope: TPas2JSProcedureScope;
  1373. begin
  1374. CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
  1375. OrigScope:=Orig.CustomData as TPas2JSProcedureScope;
  1376. RestScope:=Rest.CustomData as TPas2JSProcedureScope;
  1377. if OrigScope=nil then
  1378. exit; // msIgnoreInterfaces
  1379. CheckRestoredReference(Path+'.CustomData[TPas2JSProcedureScope].DeclarationProc',
  1380. OrigScope.DeclarationProc,RestScope.DeclarationProc);
  1381. AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName',OrigScope.ResultVarName,RestScope.ResultVarName);
  1382. if RestScope.DeclarationProc=nil then
  1383. begin
  1384. CheckRestoredElement(Path+'.ProcType',Orig.ProcType,Rest.ProcType);
  1385. CheckRestoredElement(Path+'.PublicName',Orig.PublicName,Rest.PublicName);
  1386. CheckRestoredElement(Path+'.LibrarySymbolName',Orig.LibrarySymbolName,Rest.LibrarySymbolName);
  1387. CheckRestoredElement(Path+'.LibraryExpr',Orig.LibraryExpr,Rest.LibraryExpr);
  1388. CheckRestoredElement(Path+'.DispIDExpr',Orig.DispIDExpr,Rest.DispIDExpr);
  1389. AssertEquals(Path+'.AliasName',Orig.AliasName,Rest.AliasName);
  1390. if Orig.Modifiers<>Rest.Modifiers then
  1391. Fail(Path+'.Modifiers');
  1392. AssertEquals(Path+'.MessageName',Orig.MessageName,Rest.MessageName);
  1393. if Orig.MessageType<>Rest.MessageType then
  1394. Fail(Path+'.MessageType Orig='+PCUProcedureMessageTypeNames[Orig.MessageType]+' Rest='+PCUProcedureMessageTypeNames[Rest.MessageType]);
  1395. end
  1396. else
  1397. begin
  1398. // ImplProc
  1399. end;
  1400. // ToDo: Body
  1401. end;
  1402. procedure TCustomTestPrecompile.CheckRestoredOperator(const Path: string; Orig,
  1403. Rest: TPasOperator);
  1404. begin
  1405. if Orig.OperatorType<>Rest.OperatorType then
  1406. Fail(Path+'.OperatorType Orig='+PCUOperatorTypeNames[Orig.OperatorType]+' Rest='+PCUOperatorTypeNames[Rest.OperatorType]);
  1407. AssertEquals(Path+'.TokenBased',Orig.TokenBased,Rest.TokenBased);
  1408. CheckRestoredProcedure(Path,Orig,Rest);
  1409. end;
  1410. { TTestPrecompile }
  1411. procedure TTestPrecompile.Test_Base256VLQ;
  1412. procedure Test(i: TMaxPrecInt);
  1413. var
  1414. s: String;
  1415. p: PByte;
  1416. j: TMaxPrecInt;
  1417. begin
  1418. s:=EncodeVLQ(i);
  1419. p:=PByte(s);
  1420. j:=DecodeVLQ(p);
  1421. if i<>j then
  1422. Fail('Encode/DecodeVLQ OrigIndex='+IntToStr(i)+' Code="'+s+'" NewIndex='+IntToStr(j));
  1423. end;
  1424. procedure TestStr(i: TMaxPrecInt; Expected: string);
  1425. var
  1426. Actual: String;
  1427. begin
  1428. Actual:=EncodeVLQ(i);
  1429. AssertEquals('EncodeVLQ('+IntToStr(i)+')',Expected,Actual);
  1430. end;
  1431. var
  1432. i: Integer;
  1433. begin
  1434. TestStr(0,#0);
  1435. TestStr(1,#2);
  1436. TestStr(-1,#3);
  1437. for i:=-8200 to 8200 do
  1438. Test(i);
  1439. Test(High(TMaxPrecInt));
  1440. Test(High(TMaxPrecInt)-1);
  1441. Test(Low(TMaxPrecInt)+2);
  1442. Test(Low(TMaxPrecInt)+1);
  1443. //Test(Low(TMaxPrecInt)); such a high number is not needed by pastojs
  1444. end;
  1445. procedure TTestPrecompile.TestPC_EmptyUnit;
  1446. begin
  1447. StartUnit(false);
  1448. Add([
  1449. 'interface',
  1450. 'implementation']);
  1451. WriteReadUnit;
  1452. end;
  1453. procedure TTestPrecompile.TestPC_Const;
  1454. begin
  1455. StartUnit(false);
  1456. Add([
  1457. 'interface',
  1458. 'const',
  1459. ' Three = 3;',
  1460. ' FourPlusFive: longint = 4+5 deprecated ''deprtext'';',
  1461. ' Four: byte = +6-2*2 platform;',
  1462. ' Affirmative = true;',
  1463. ' BFalse = false;', // bool lit
  1464. ' NotBFalse = not BFalse;', // boolconst
  1465. ' UnaryMinus = -3;', // unary minus
  1466. ' FloatA = -31.678E-012;', // float lit
  1467. ' HighInt = High(longint);', // func params, built-in function
  1468. ' s = ''abc'';', // string lit
  1469. ' c: char = s[1];', // array params
  1470. ' a: array[1..2] of longint = (3,4);', // anonymous array, range, array values
  1471. 'resourcestring',
  1472. ' rs = ''rs'';',
  1473. 'implementation']);
  1474. WriteReadUnit;
  1475. end;
  1476. procedure TTestPrecompile.TestPC_Var;
  1477. begin
  1478. StartUnit(false);
  1479. Add([
  1480. 'interface',
  1481. 'var',
  1482. ' FourPlusFive: longint = 4+5 deprecated ''deprtext'';',
  1483. ' e: double external name ''Math.e'';',
  1484. ' AnoArr: array of longint = (1,2,3);',
  1485. ' s: string = ''aaaäö'';',
  1486. ' s2: string = ''😊'';', // 1F60A
  1487. ' a,b: array of longint;',
  1488. 'implementation']);
  1489. WriteReadUnit;
  1490. end;
  1491. procedure TTestPrecompile.TestPC_Enum;
  1492. begin
  1493. StartUnit(false);
  1494. Add([
  1495. 'interface',
  1496. 'type',
  1497. ' TEnum = (red,green,blue);',
  1498. ' TEnumRg = green..blue;',
  1499. ' TArrOfEnum = array of TEnum;',
  1500. ' TArrOfEnumRg = array of TEnumRg;',
  1501. ' TArrEnumOfInt = array[TEnum] of longint;',
  1502. 'var',
  1503. ' HighEnum: TEnum = high(TEnum);',
  1504. 'implementation']);
  1505. WriteReadUnit;
  1506. end;
  1507. procedure TTestPrecompile.TestPC_Set;
  1508. begin
  1509. StartUnit(false);
  1510. Add([
  1511. 'interface',
  1512. 'type',
  1513. ' TEnum = (red,green,blue);',
  1514. ' TEnumRg = green..blue;',
  1515. ' TEnumAlias = TEnum;', // alias
  1516. ' TSetOfEnum = set of TEnum;',
  1517. ' TSetOfEnumRg = set of TEnumRg;',
  1518. ' TSetOfDir = set of (west,east);',
  1519. 'var',
  1520. ' Empty: TSetOfEnum = [];', // empty set lit
  1521. ' All: TSetOfEnum = [low(TEnum)..pred(high(TEnum)),high(TEnum)];', // full set lit, range in set
  1522. 'implementation']);
  1523. WriteReadUnit;
  1524. end;
  1525. procedure TTestPrecompile.TestPC_SetOfAnonymousEnumType;
  1526. begin
  1527. StartUnit(false);
  1528. Add([
  1529. 'interface',
  1530. 'type',
  1531. ' TSetOfDir = set of (west,east);',
  1532. 'implementation']);
  1533. WriteReadUnit;
  1534. end;
  1535. procedure TTestPrecompile.TestPC_Record;
  1536. begin
  1537. StartUnit(false);
  1538. Add([
  1539. 'interface',
  1540. 'type',
  1541. ' TRec = record',
  1542. ' i: longint;',
  1543. ' s: string;',
  1544. ' end;',
  1545. ' P = pointer;', // alias type to built-in type
  1546. ' TArrOfRec = array of TRec;',
  1547. 'var',
  1548. ' r: TRec;', // full set lit, range in set
  1549. 'implementation']);
  1550. WriteReadUnit;
  1551. end;
  1552. procedure TTestPrecompile.TestPC_JSValue;
  1553. begin
  1554. StartUnit(false);
  1555. Add([
  1556. 'interface',
  1557. 'var',
  1558. ' p: pointer = nil;', // pointer, nil lit
  1559. ' js: jsvalue = 13 div 4;', // jsvalue
  1560. 'implementation']);
  1561. WriteReadUnit;
  1562. end;
  1563. procedure TTestPrecompile.TestPC_Array;
  1564. begin
  1565. StartUnit(false);
  1566. Add([
  1567. 'interface',
  1568. 'type',
  1569. ' TEnum = (red,green);',
  1570. ' TArrInt = array of longint;',
  1571. ' TArrInt2 = array[1..2] of longint;',
  1572. ' TArrEnum1 = array[red..green] of longint;',
  1573. ' TArrEnum2 = array[TEnum] of longint;',
  1574. 'implementation']);
  1575. WriteReadUnit;
  1576. end;
  1577. procedure TTestPrecompile.TestPC_ArrayOfAnonymous;
  1578. begin
  1579. StartUnit(false);
  1580. Add([
  1581. 'interface',
  1582. 'var',
  1583. ' a: array of pointer;',
  1584. 'implementation']);
  1585. WriteReadUnit;
  1586. end;
  1587. procedure TTestPrecompile.TestPC_Proc;
  1588. begin
  1589. StartUnit(false);
  1590. Add([
  1591. 'interface',
  1592. ' function Abs(d: double): double; external name ''Math.Abs'';',
  1593. ' function GetIt(d: double): double;',
  1594. ' procedure DoArgs(const a; var b: array of char; out c: jsvalue); inline;',
  1595. ' procedure DoMulti(a,b: byte);',
  1596. 'implementation',
  1597. 'var k: double;',
  1598. 'function GetIt(d: double): double;',
  1599. 'var j: double;',
  1600. 'begin',
  1601. ' j:=Abs(d+k);',
  1602. ' Result:=j;',
  1603. 'end;',
  1604. 'procedure DoArgs(const a; var b: array of char; out c: jsvalue); inline;',
  1605. 'begin',
  1606. 'end;',
  1607. 'procedure DoMulti(a,b: byte);',
  1608. 'begin',
  1609. 'end;',
  1610. 'procedure NotUsed;',
  1611. 'begin',
  1612. 'end;',
  1613. '']);
  1614. WriteReadUnit;
  1615. end;
  1616. procedure TTestPrecompile.TestPC_Proc_Nested;
  1617. begin
  1618. StartUnit(false);
  1619. Add([
  1620. 'interface',
  1621. ' function GetIt(d: longint): longint;',
  1622. 'implementation',
  1623. 'var k: double;',
  1624. 'function GetIt(d: longint): longint;',
  1625. 'var j: double;',
  1626. ' function GetSum(a,b: longint): longint; forward;',
  1627. ' function GetMul(a,b: longint): longint; ',
  1628. ' begin',
  1629. ' Result:=a*b;',
  1630. ' end;',
  1631. ' function GetSum(a,b: longint): longint;',
  1632. ' begin',
  1633. ' Result:=a+b;',
  1634. ' end;',
  1635. ' procedure NotUsed;',
  1636. ' begin',
  1637. ' end;',
  1638. 'begin',
  1639. ' Result:=GetMul(GetSum(d,2),3);',
  1640. 'end;',
  1641. 'procedure NotUsed;',
  1642. 'begin',
  1643. 'end;',
  1644. '']);
  1645. WriteReadUnit;
  1646. end;
  1647. procedure TTestPrecompile.TestPC_Proc_LocalConst;
  1648. begin
  1649. StartUnit(false);
  1650. Add([
  1651. 'interface',
  1652. 'function GetIt(d: double): double;',
  1653. 'implementation',
  1654. 'function GetIt(d: double): double;',
  1655. 'const',
  1656. ' c: double = 3.3;',
  1657. ' e: double = 2.7;', // e is not used
  1658. 'begin',
  1659. ' Result:=d+c;',
  1660. 'end;',
  1661. '']);
  1662. WriteReadUnit;
  1663. end;
  1664. procedure TTestPrecompile.TestPC_Proc_UTF8;
  1665. begin
  1666. StartUnit(false);
  1667. Add([
  1668. 'interface',
  1669. 'function DoIt: string;',
  1670. 'implementation',
  1671. 'function DoIt: string;',
  1672. 'const',
  1673. ' c = ''äöü😊'';',
  1674. 'begin',
  1675. ' Result:=''ÄÖÜ😊''+c;',
  1676. 'end;',
  1677. '']);
  1678. WriteReadUnit;
  1679. end;
  1680. procedure TTestPrecompile.TestPC_Proc_Arg;
  1681. begin
  1682. StartUnit(false);
  1683. Add([
  1684. 'interface',
  1685. 'procedure DoIt(var a; out b,c: longint; const e,f: array of byte; g: boolean = true);',
  1686. 'implementation',
  1687. 'procedure DoIt(var a; out b,c: longint; const e,f: array of byte; g: boolean = true);',
  1688. 'begin',
  1689. 'end;',
  1690. '']);
  1691. WriteReadUnit;
  1692. end;
  1693. procedure TTestPrecompile.TestPC_ProcType;
  1694. begin
  1695. StartUnit(false);
  1696. Add([
  1697. '{$modeswitch arrayoperators}',
  1698. 'interface',
  1699. 'type',
  1700. ' TProc = procedure;',
  1701. ' TArrProc = array of tproc;',
  1702. 'procedure Mark;',
  1703. 'procedure DoIt(const a: TArrProc);',
  1704. 'implementation',
  1705. 'procedure Mark;',
  1706. 'var',
  1707. ' p: TProc;',
  1708. ' a: TArrProc;',
  1709. 'begin',
  1710. ' DoIt([@Mark,p]+a);',
  1711. 'end;',
  1712. 'procedure DoIt(const a: TArrProc);',
  1713. 'begin',
  1714. 'end;',
  1715. '']);
  1716. WriteReadUnit;
  1717. end;
  1718. procedure TTestPrecompile.TestPC_Class;
  1719. begin
  1720. StartUnit(false);
  1721. Add([
  1722. 'interface',
  1723. 'type',
  1724. ' TObject = class',
  1725. ' protected',
  1726. ' FInt: longint;',
  1727. ' procedure SetInt(Value: longint); virtual; abstract;',
  1728. ' public',
  1729. ' property Int: longint read FInt write SetInt default 3;',
  1730. ' end;',
  1731. ' TBird = class',
  1732. ' protected',
  1733. ' procedure SetInt(Value: longint); override;',
  1734. ' published',
  1735. ' property Int;',
  1736. ' end;',
  1737. 'var',
  1738. ' o: tobject;',
  1739. 'implementation',
  1740. 'procedure TBird.SetInt(Value: longint);',
  1741. 'begin',
  1742. 'end;'
  1743. ]);
  1744. WriteReadUnit;
  1745. end;
  1746. procedure TTestPrecompile.TestPC_ClassForward;
  1747. begin
  1748. Converter.Options:=Converter.Options-[coNoTypeInfo];
  1749. StartUnit(false);
  1750. Add([
  1751. 'interface',
  1752. 'type',
  1753. ' TObject = class end;',
  1754. ' TFish = class;',
  1755. ' TBird = class;',
  1756. ' TBirdClass = class of TBird;',
  1757. ' TFish = class',
  1758. ' B: TBird;',
  1759. ' end;',
  1760. ' TBird = class',
  1761. ' F: TFish;',
  1762. ' end;',
  1763. ' TFishClass = class of TFish;',
  1764. 'var',
  1765. ' b: tbird;',
  1766. ' f: tfish;',
  1767. ' bc: TBirdClass;',
  1768. ' fc: TFishClass;',
  1769. 'implementation',
  1770. 'end.'
  1771. ]);
  1772. WriteReadUnit;
  1773. end;
  1774. procedure TTestPrecompile.TestPC_ClassConstructor;
  1775. begin
  1776. StartUnit(false);
  1777. Add([
  1778. 'interface',
  1779. 'type',
  1780. ' TObject = class',
  1781. ' constructor Create; virtual;',
  1782. ' end;',
  1783. ' TBird = class',
  1784. ' constructor Create; override;',
  1785. ' end;',
  1786. 'procedure DoIt;',
  1787. 'implementation',
  1788. 'constructor TObject.Create;',
  1789. 'begin',
  1790. 'end;',
  1791. 'constructor TBird.Create;',
  1792. 'begin',
  1793. ' inherited;',
  1794. 'end;',
  1795. 'procedure DoIt;',
  1796. 'var b: TBird;',
  1797. 'begin',
  1798. ' b:=TBird.Create;',
  1799. 'end;',
  1800. 'end.'
  1801. ]);
  1802. WriteReadUnit;
  1803. end;
  1804. procedure TTestPrecompile.TestPC_Initialization;
  1805. begin
  1806. StartUnit(false);
  1807. Add([
  1808. 'interface',
  1809. 'implementation',
  1810. 'type',
  1811. ' TCaption = string;',
  1812. ' TRec = record h: string; end;',
  1813. 'var',
  1814. ' s: TCaption;',
  1815. ' r: TRec;',
  1816. 'initialization',
  1817. ' s:=''ö😊'';',
  1818. ' r.h:=''Ä😊'';',
  1819. 'end.',
  1820. '']);
  1821. WriteReadUnit;
  1822. end;
  1823. procedure TTestPrecompile.TestPC_BoolSwitches;
  1824. begin
  1825. StartUnit(false);
  1826. Add([
  1827. 'interface',
  1828. '{$R+}',
  1829. '{$C+}',
  1830. 'type',
  1831. ' TObject = class',
  1832. '{$C-}',
  1833. ' procedure DoIt;',
  1834. ' end;',
  1835. '{$C+}',
  1836. 'implementation',
  1837. '{$R-}',
  1838. 'procedure TObject.DoIt;',
  1839. 'begin',
  1840. 'end;',
  1841. '{$C-}',
  1842. 'initialization',
  1843. '{$R+}',
  1844. 'end.',
  1845. '']);
  1846. WriteReadUnit;
  1847. end;
  1848. procedure TTestPrecompile.TestPC_ClassInterface;
  1849. begin
  1850. StartUnit(false);
  1851. Add([
  1852. 'interface',
  1853. '{$interfaces corba}',
  1854. 'type',
  1855. ' IUnknown = interface',
  1856. ' end;',
  1857. ' IFlying = interface',
  1858. ' procedure SetItems(Index: longint; Value: longint);',
  1859. ' end;',
  1860. ' IBird = interface(IFlying)',
  1861. ' [''{D44C1F80-44F9-4E88-8443-C518CCDC1FE8}'']',
  1862. ' function GetItems(Index: longint): longint;',
  1863. ' property Items[Index: longint]: longint read GetItems write SetItems;',
  1864. ' end;',
  1865. ' TObject = class',
  1866. ' end;',
  1867. ' TBird = class(TObject,IBird)',
  1868. ' strict private',
  1869. ' function IBird.GetItems = RetItems;',
  1870. ' function RetItems(Index: longint): longint; virtual; abstract;',
  1871. ' procedure SetItems(Index: longint; Value: longint); virtual; abstract;',
  1872. ' end;',
  1873. ' TEagle = class(TObject,IBird)',
  1874. ' strict private',
  1875. ' FBird: IBird;',
  1876. ' property Bird: IBird read FBird implements IBird;',
  1877. ' end;',
  1878. 'implementation',
  1879. 'end.',
  1880. '']);
  1881. WriteReadUnit;
  1882. end;
  1883. procedure TTestPrecompile.TestPC_IgnoreAttributes;
  1884. begin
  1885. StartUnit(false);
  1886. Add([
  1887. 'interface',
  1888. '{$modeswitch ignoreattributes}',
  1889. 'type',
  1890. ' [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
  1891. ' TObject = class',
  1892. ' [custom5()] FS: string;',
  1893. ' [customProp] property S: string read FS;',
  1894. ' end;',
  1895. 'var',
  1896. ' [custom6]',
  1897. ' o: TObject;',
  1898. 'implementation',
  1899. 'end.',
  1900. '']);
  1901. WriteReadUnit;
  1902. end;
  1903. procedure TTestPrecompile.TestPC_UseUnit;
  1904. begin
  1905. AddModuleWithIntfImplSrc('unit2.pp',
  1906. LinesToStr([
  1907. 'type',
  1908. ' TColor = longint;',
  1909. ' TRec = record h: TColor; end;',
  1910. ' TEnum = (red,green);',
  1911. 'var',
  1912. ' c: TColor;',
  1913. ' r: TRec;',
  1914. ' e: TEnum;']),
  1915. LinesToStr([
  1916. '']));
  1917. StartUnit(true);
  1918. Add([
  1919. 'interface',
  1920. 'uses unit2;',
  1921. 'var',
  1922. ' i: system.longint;',
  1923. ' e2: TEnum;',
  1924. 'implementation',
  1925. 'initialization',
  1926. ' c:=1;',
  1927. ' r.h:=2;',
  1928. ' e:=red;',
  1929. 'end.',
  1930. '']);
  1931. WriteReadUnit;
  1932. end;
  1933. procedure TTestPrecompile.TestPC_UseUnit_Class;
  1934. begin
  1935. AddModuleWithIntfImplSrc('unit2.pp',
  1936. LinesToStr([
  1937. 'type',
  1938. ' TObject = class',
  1939. ' private',
  1940. ' FA: longint;',
  1941. ' public',
  1942. ' type',
  1943. ' TEnum = (red,green);',
  1944. ' public',
  1945. ' i: longint;',
  1946. ' e: TEnum;',
  1947. ' procedure DoIt; virtual; abstract;',
  1948. ' property A: longint read FA write FA;',
  1949. ' end;',
  1950. 'var',
  1951. ' o: TObject;']),
  1952. LinesToStr([
  1953. '']));
  1954. StartUnit(true);
  1955. Add([
  1956. 'interface',
  1957. 'uses unit2;',
  1958. 'var',
  1959. ' b: TObject;',
  1960. 'implementation',
  1961. 'initialization',
  1962. ' o.DoIt;',
  1963. ' o.i:=b.A;',
  1964. ' o.e:=red;',
  1965. 'end.',
  1966. '']);
  1967. WriteReadUnit;
  1968. end;
  1969. procedure TTestPrecompile.TestPC_UseIndirectUnit;
  1970. begin
  1971. AddModuleWithIntfImplSrc('unit2.pp',
  1972. LinesToStr([
  1973. 'type',
  1974. ' TObject = class',
  1975. ' public',
  1976. ' i: longint;',
  1977. ' end;']),
  1978. LinesToStr([
  1979. '']));
  1980. AddModuleWithIntfImplSrc('unit1.pp',
  1981. LinesToStr([
  1982. 'uses unit2;',
  1983. 'var o: TObject;']),
  1984. LinesToStr([
  1985. '']));
  1986. StartUnit(true);
  1987. Add([
  1988. 'interface',
  1989. 'uses unit1;',
  1990. 'implementation',
  1991. 'initialization',
  1992. ' o.i:=3;',
  1993. 'end.',
  1994. '']);
  1995. WriteReadUnit;
  1996. end;
  1997. Initialization
  1998. RegisterTests([TTestPrecompile]);
  1999. end.