tcfiler.pas 80 KB

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