tcfiler.pas 81 KB

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