tcfiler.pas 86 KB

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