tcfiler.pas 82 KB

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