tcfiler.pas 85 KB

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