tcjsontocode.pas 79 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414
  1. unit tcjsontocode;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testregistry, fpjsontopas;
  6. type
  7. { TTestGenCode }
  8. TTestGenCode= class(TTestCase)
  9. private
  10. FPos : Integer;
  11. FGen: TJSONToPascal;
  12. procedure AssertDelphiLoadArray(AElementType, AJSONtype: String);
  13. procedure AssertDelphiPropertyAssignmentLoop;
  14. procedure AssertDestructorImplementation(AClassName: String; ObjectFields: array of string);
  15. procedure AssertLine(Msg: String; AExpected: String);
  16. procedure GenCode(AJSON: String);
  17. class function GetDataName(IsDelphi: Boolean): string;
  18. function NextLine: String;
  19. function Pos(const What, Where: String): Integer;
  20. protected
  21. procedure SetUp; override;
  22. procedure TearDown; override;
  23. procedure AssertArrayCreator(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
  24. procedure AssertArraySaver(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
  25. procedure AssertArrayCreatorImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
  26. procedure AssertArraySaverImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
  27. procedure AssertLoadArray(AElementType, AJSONtype: String; IsDelphi : Boolean = False);
  28. procedure AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
  29. procedure AssertPropertyAssignmentLoop;
  30. procedure AssertType;
  31. procedure AssertClassComment(const Msg, AName: String);
  32. procedure AssertLoadConstructorDeclaration(AType: String);
  33. procedure AssertLoaderDeclaration(AType: String);
  34. procedure AssertSaverDeclaration;
  35. procedure AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
  36. procedure AssertLoadConstructorImplementationStart(Const ATypeName, ADataName: String);
  37. procedure AssertLoaderImplementationStart(Const ATypeName, ADataName: String; IsDelphi : Boolean = False);
  38. procedure AssertSaverImplementationStart(Const ATypeName: String; IsDelphi : Boolean = False);
  39. procedure AssertArrayLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
  40. procedure AssertObjectLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
  41. Procedure AssertUnitHeader;
  42. Procedure AssertBegin;
  43. Procedure AssertEnd(Const Msg : String = '');
  44. Procedure AssertUnitEnd;
  45. Procedure AssertImplementation;
  46. procedure AssertProperty(const AName, AType: String; Setter : Boolean = False);
  47. procedure AssertSetter(const AName, AType: String);
  48. Procedure AssertClassHeader(Const AName : String; AParentName : String);
  49. Procedure AssertSetterImplementation(Const AClassType,AName,AType : String; IsObject : Boolean = False);
  50. Procedure AssertVisibility(Const AVisibility : String);
  51. Procedure AssertDestructor;
  52. Procedure AssertField(Const AName,AType : String; Prefix : String = '');
  53. Procedure AssertArrayType(Const AName,AItemType : String);
  54. Procedure AssertPropertyMap(Const APath,ATypeName,APropertyName,AParentTypeName : String);
  55. Property Gen : TJSONToPascal Read FGen;
  56. published
  57. procedure TestEmpty;
  58. Procedure TestSimple;
  59. Procedure TestClassName;
  60. Procedure TestParentClassName;
  61. Procedure TestIntegerProperty;
  62. Procedure Test2IntegersProperty;
  63. Procedure TestBooleanProperty;
  64. Procedure TestStringProperty;
  65. Procedure TestFloatProperty;
  66. Procedure TestInt64Property;
  67. Procedure TestPropertySetter;
  68. Procedure TestObjectProperty;
  69. Procedure TestObjectPropertySetter;
  70. Procedure TestObjectPropertySuffix;
  71. Procedure TestObjectPropertySkip;
  72. Procedure TestObjectPropertyRecurse;
  73. Procedure TestObjectPropertyRecurseSuffix;
  74. Procedure TestObjectPropertyRecurseSkip;
  75. Procedure TestObjectPropertyRecurseSkipB;
  76. Procedure TestStringArrayProperty;
  77. Procedure TestIntegerArrayProperty;
  78. Procedure TestBooleanArrayProperty;
  79. Procedure TestFloatArrayProperty;
  80. Procedure TestInt64ArrayProperty;
  81. Procedure TestStringArrayPropertySuffix;
  82. Procedure TestObjectArrayProperty;
  83. procedure TestObjectArrayPropertySuffix;
  84. procedure TestArrayArrayProperty;
  85. procedure TestObjectArrayArrayProperty;
  86. Procedure TestLoadIntegerProperty;
  87. Procedure TestLoad2IntegersProperty;
  88. Procedure TestLoadIntegerWithErrorProperty;
  89. Procedure TestLoadIntegerCaseInsensitiveProperty;
  90. Procedure TestLoadStringProperty;
  91. Procedure TestLoadBooleanProperty;
  92. Procedure TestLoadInt64Property;
  93. Procedure TestLoadFloatProperty;
  94. Procedure TestLoadObjectProperty;
  95. Procedure TestLoadStringArrayProperty;
  96. Procedure TestLoadBooleanArrayProperty;
  97. Procedure TestLoadIntegerArrayProperty;
  98. Procedure TestLoadInt64ArrayProperty;
  99. Procedure TestLoadFloatArrayProperty;
  100. Procedure TestLoadObjectArrayProperty;
  101. Procedure TestLoadDelphiIntegerProperty;
  102. Procedure TestLoadDelphi2IntegersProperty;
  103. Procedure TestLoadDelphiIntegerWithErrorProperty;
  104. Procedure TestLoadDelphiIntegerCaseInsensitiveProperty;
  105. Procedure TestLoadDelphiStringProperty;
  106. Procedure TestLoadDelphiBooleanProperty;
  107. Procedure TestLoadDelphiInt64Property;
  108. Procedure TestLoadDelphiFloatProperty;
  109. procedure TestLoadDelphiObjectProperty;
  110. Procedure TestLoadDelphiStringArrayProperty;
  111. Procedure TestLoadDelphiBooleanArrayProperty;
  112. Procedure TestLoadDelphiIntegerArrayProperty;
  113. Procedure TestLoadDelphiInt64ArrayProperty;
  114. Procedure TestLoadDelphiFloatArrayProperty;
  115. procedure TestLoadDelphiObjectArrayProperty;
  116. Procedure TestSaveIntegerProperty;
  117. Procedure TestSave2IntegersProperty;
  118. Procedure TestSaveStringProperty;
  119. Procedure TestSaveBooleanProperty;
  120. Procedure TestSaveInt64Property;
  121. Procedure TestSaveFloatProperty;
  122. Procedure TestSaveObjectProperty;
  123. Procedure TestSaveStringArrayProperty;
  124. Procedure TestSaveBooleanArrayProperty;
  125. Procedure TestSaveIntegerArrayProperty;
  126. Procedure TestSaveInt64ArrayProperty;
  127. Procedure TestSaveFloatArrayProperty;
  128. Procedure TestSaveObjectArrayProperty;
  129. Procedure TestSaveDelphiIntegerProperty;
  130. Procedure TestSaveDelphi2IntegersProperty;
  131. Procedure TestSaveDelphiStringProperty;
  132. Procedure TestSaveDelphiBooleanProperty;
  133. Procedure TestSaveDelphiInt64Property;
  134. Procedure TestSaveDelphiFloatProperty;
  135. Procedure TestSaveDelphiObjectProperty;
  136. Procedure TestSaveDelphiStringArrayProperty;
  137. Procedure TestSaveDelphiBooleanArrayProperty;
  138. Procedure TestSaveDelphiIntegerArrayProperty;
  139. Procedure TestSaveDelphiInt64ArrayProperty;
  140. Procedure TestSaveDelphiFloatArrayProperty;
  141. Procedure TestSaveDelphiObjectArrayProperty;
  142. end;
  143. Var
  144. TestUnitDir : String;
  145. implementation
  146. procedure TTestGenCode.SetUp;
  147. begin
  148. FGen:=TJSONToPascal.Create(Nil);
  149. end;
  150. procedure TTestGenCode.TearDown;
  151. begin
  152. FreeAndNil(FGen)
  153. end;
  154. function TTestGenCode.NextLine: String;
  155. begin
  156. Result:='';
  157. While (Result='') do
  158. begin
  159. Inc(FPos);
  160. AssertTrue('In scope',FPos<FGen.Code.Count);
  161. Result:=Trim(FGen.Code[FPos]);
  162. end;
  163. end;
  164. procedure TTestGenCode.AssertUnitHeader;
  165. Var
  166. S: String;
  167. begin
  168. S:=NextLine;
  169. AssertTrue('Have unit',Pos('unit ',S)=1);
  170. S:=NextLine;
  171. AssertTrue('Have interface',Pos('interface',S)=1);
  172. S:=NextLine;
  173. AssertTrue('Have uses',Pos('uses ',S)=1);
  174. S:=NextLine;
  175. AssertTrue('Type line',Pos('Type',S)=1);
  176. end;
  177. procedure TTestGenCode.AssertBegin;
  178. begin
  179. AssertTrue('Have begin',pos('begin',nextline)>0);
  180. end;
  181. procedure TTestGenCode.AssertEnd(const Msg: String);
  182. begin
  183. AssertTrue('Have end:'+Msg,pos('end;',nextline)>0);
  184. end;
  185. procedure TTestGenCode.AssertUnitEnd;
  186. begin
  187. AssertTrue('Have end.',pos('end.',nextline)>0);
  188. end;
  189. procedure TTestGenCode.AssertImplementation;
  190. begin
  191. AssertTrue('Have implementation',CompareText(NextLine,'implementation')=0);
  192. end;
  193. function TTestGenCode.Pos(const What, Where: String): Integer;
  194. begin
  195. Result:=system.Pos(lowercase(what),lowercase(where));
  196. end;
  197. procedure TTestGenCode.AssertClassComment(const Msg,AName: String);
  198. Var
  199. S : String;
  200. begin
  201. S:=NextLine;
  202. AssertTrue(Msg+' ('+AName+'): Class header comment start',Pos('{ --',S)>0);
  203. S:=NextLine;
  204. AssertTrue(Msg+' ('+AName+'): Class header comment class nam',Pos(AName,S)>0);
  205. S:=NextLine;
  206. AssertTrue(Msg+' ('+AName+'): Class header comment end',Pos('}',S)>0);
  207. end;
  208. procedure TTestGenCode.AssertClassHeader(const AName: String; AParentName: String);
  209. Var
  210. P : Integer;
  211. S : String;
  212. begin
  213. AssertClassComment('Class declarationheader for '+AName,AName);
  214. S:=NextLine;
  215. P:=Pos(AName+' = class(',S);
  216. AssertTrue('class type ',P>0);
  217. P:=Pos(AParentName+')',S);
  218. AssertTrue('Class parent type ',P>0);
  219. AssertVisibility('private');
  220. end;
  221. procedure TTestGenCode.AssertSetterImplementation(const AClassType, AName,
  222. AType: String; IsObject: Boolean);
  223. Var
  224. S,PS : String;
  225. P : Integer;
  226. begin
  227. S:=NextLine;
  228. PS:='Procedure '+AClassType+'.Set'+Aname+'(AValue';
  229. AssertTrue('Have declaration start',Pos(PS,S)>0);
  230. Delete(S,1,Length(PS));
  231. P:=Pos(':',S);
  232. AssertTrue('Have colon' ,p>0);
  233. Delete(S,1,P);
  234. AssertTrue('Have type',Pos(AType,S)>0);
  235. AssertTrue('Have );',Pos(');',S)>0);
  236. AssertTrue('Terminated on semicolon',S[Length(S)]=';');
  237. AssertBegin;
  238. AssertTrue('Have change check',Pos('if ('+Gen.FieldPrefix+AName+'=AValue) then exit;',NextLine)>0);
  239. if IsObject then
  240. AssertTrue('Have free of previous value',Pos('FreeAndNil('+Gen.FieldPrefix+AName+');',NextLine)>0);
  241. AssertTrue('Have Assignment',Pos(Gen.FieldPrefix+AName+':=AValue;',NextLine)>0);
  242. AssertEnd;
  243. end;
  244. procedure TTestGenCode.AssertVisibility(const AVisibility: String);
  245. begin
  246. AssertTrue('Have visibility section '+AVisibility,Pos(AVisibility,NextLine)>0);
  247. end;
  248. procedure TTestGenCode.AssertDestructor;
  249. begin
  250. AssertTrue('Have destructor declaration',Pos('Destructor Destroy; override;',NextLine)>0);
  251. end;
  252. procedure TTestGenCode.AssertDestructorImplementation(AClassName: String;
  253. ObjectFields: array of string);
  254. Var
  255. F : String;
  256. begin
  257. AssertTrue('Have destructor implementation',Pos(Format('Destructor %s.Destroy;',[AClassName]),NextLine)>0);
  258. AssertBegin;
  259. For F in ObjectFields do
  260. AssertTrue('Have destructor for F'+F,Pos('FreeAndNil(F'+F+');',NextLine)>0);
  261. AssertTrue('Have inherited call'+F,Pos('Inherited;',NextLine)>0);
  262. AssertEnd;
  263. end;
  264. procedure TTestGenCode.AssertField(const AName, AType: String; Prefix : String = '');
  265. Var
  266. F,S : String;
  267. P : Integer;
  268. begin
  269. F:=Prefix;
  270. if F='' then
  271. F:='F';
  272. S:=NextLine;
  273. AssertTrue('Field Name',Pos(F+AName,S)=1);
  274. P:=Pos(':',S);
  275. AssertTrue('Colon after field name',P>Length(F+AName));
  276. AssertTrue('Field type after colon',Pos(AType,S)>P);
  277. AssertTrue('Terminated on semicolon',S[Length(S)]=';');
  278. end;
  279. procedure TTestGenCode.AssertSetter(const AName, AType: String);
  280. Var
  281. N,S,PD : String;
  282. P,p2 : Integer;
  283. begin
  284. S:=NextLine;
  285. N:='Setter declaration for '+AName+' : ';
  286. PD:='Procedure Set'+AName;
  287. AssertTrue(N+'Setter name',Pos(PD,S)=1);
  288. P:=Pos('(',S);
  289. AssertTrue(N+'( after parameter name',P>Length(PD));
  290. P:=Pos(':',S);
  291. AssertTrue(N+'Colon after parameter name',P>Length(PD));
  292. Delete(S,1,P);
  293. P2:=Pos(AType,S);
  294. AssertTrue(N+'Field type after colon '+AType+' : '+S,P2>0);
  295. P:=Pos(');',S);
  296. AssertTrue(N+'); type after parameter type',P>P2);
  297. P2:=Pos('virtual',S);
  298. AssertTrue(N+'virtual after ); ',P2>P);
  299. AssertTrue(N+'Terminated on semicolon',S[Length(S)]=';');
  300. end;
  301. procedure TTestGenCode.AssertArrayType(const AName, AItemType: String);
  302. Var
  303. P,p2 : Integer;
  304. S : String;
  305. begin
  306. S:=NextLine;
  307. AssertTrue('Type Name',Pos(AName,S)=1);
  308. P:=Pos('=',S);
  309. AssertTrue('Equal token after type Name',P>Pos(AName,S));
  310. P2:=Pos('Array of',S);
  311. AssertTrue('Array of after Equal token after type Name',P2>P);
  312. P:=Pos(AItemType,S);
  313. AssertTrue('Item type name after array of',P>P2);
  314. AssertTrue('Terminated on semicolon',S[Length(S)]=';');
  315. end;
  316. procedure TTestGenCode.AssertPropertyMap(const APath, ATypeName, APropertyName,
  317. AParentTypeName: String);
  318. Var
  319. M : TPropertyMapItem;
  320. begin
  321. M:=Gen.PropertyMap.FindPath(APath);
  322. AssertNotNull('Have property map "'+APath+'"',M);
  323. AssertEquals('Have type name ',ATypeName,M.TypeName);
  324. AssertEquals('Have property name ',APropertyName,M.PropertyName);
  325. AssertEquals('Have parent type name ',AParentTypeName,M.ParentTypeName);
  326. end;
  327. procedure TTestGenCode.AssertProperty(const AName, AType: String; Setter : Boolean = False);
  328. Var
  329. S : String;
  330. P,P2 : Integer;
  331. begin
  332. S:=NextLine;
  333. AssertTrue('Property Name',Pos('Property '+AName,S)=1);
  334. P:=Pos(':',S);
  335. AssertTrue('Colon after property name',P>Length('Property '+AName));
  336. P2:=Pos(AType,S);
  337. AssertTrue('Field type after colon',P2>P);
  338. P:=pos(' read ',S);
  339. AssertTrue('Read specifier after type ',P>P2);
  340. P2:=Pos('F'+AName,S);
  341. AssertTrue('Field name for read specifier',P2>P);
  342. P:=pos(' write ',S);
  343. AssertTrue('Write specifier after type ',P>P2);
  344. if Setter Then
  345. P2:=Pos('write Set'+AName,S)
  346. else
  347. P2:=Pos('write F'+AName,S);
  348. AssertTrue('Field name for write specifier',P2>P);
  349. AssertTrue('Terminated on semicolon',S[Length(S)]=';');
  350. end;
  351. procedure TTestGenCode.GenCode(AJSON : String);
  352. Var
  353. F : Text;
  354. begin
  355. Gen.JSON:=AJSON;
  356. Gen.DestUnitName:='u'+TestName;
  357. Gen.Execute;
  358. if (TestUnitDir<>'') then
  359. begin
  360. Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.pp');
  361. Rewrite(F);
  362. Writeln(F,'// ',Self.TestName);
  363. Writeln(F,Gen.Code.Text);
  364. Close(F);
  365. Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.json');
  366. Rewrite(F);
  367. Writeln(F,AJSON);
  368. Close(F);
  369. end
  370. else
  371. begin
  372. Writeln('// ',Self.TestName);
  373. Writeln('(* JSON: '+AJSON+' *)');
  374. Writeln(Gen.Code.Text);
  375. end;
  376. FPos:=-1;
  377. end;
  378. procedure TTestGenCode.TestEmpty;
  379. begin
  380. AssertNotNull('Have generator',Gen);
  381. AssertNotNull('Generator property map exists',Gen.PropertyMap);
  382. AssertNotNull('Generator property code exists',Gen.Code);
  383. AssertNull('Generator JSON empty',Gen.JSONData);
  384. AssertNull('Generator JSON stream empty',Gen.JSONStream);
  385. AssertEquals('Generator JSON empty','',Gen.JSON);
  386. AssertEquals('Generator property map empty',0,Gen.PropertyMap.Count);
  387. end;
  388. procedure TTestGenCode.TestSimple;
  389. begin
  390. GenCode('{}');
  391. AssertUnitHeader;
  392. AssertClassHeader('TMyObject','TObject');
  393. AssertVisibility('public');
  394. AssertEnd;
  395. AssertPropertyMap('','TMyObject','','TObject');
  396. end;
  397. procedure TTestGenCode.TestClassName;
  398. begin
  399. Gen.PropertyMap.AddPath('','TSomeObject');
  400. GenCode('{}');
  401. AssertUnitHeader;
  402. AssertClassHeader('TSomeObject','TObject');
  403. AssertVisibility('public');
  404. AssertEnd;
  405. AssertPropertyMap('','TSomeObject','','TObject');
  406. end;
  407. procedure TTestGenCode.TestParentClassName;
  408. begin
  409. Gen.PropertyMap.AddPath('','TSomeObject');
  410. Gen.DefaultParentName:='TMyObject';
  411. GenCode('{}');
  412. AssertUnitHeader;
  413. AssertClassHeader('TSomeObject','TMyObject');
  414. AssertVisibility('public');
  415. AssertEnd;
  416. AssertPropertyMap('','TSomeObject','','TMyObject');
  417. end;
  418. procedure TTestGenCode.TestIntegerProperty;
  419. begin
  420. GenCode('{ "a" : 1 }');
  421. AssertUnitHeader;
  422. AssertClassHeader('TMyObject','TObject');
  423. AssertField('a','integer');
  424. AssertVisibility('public');
  425. AssertProperty('a','integer');
  426. AssertEnd;
  427. AssertPropertyMap('','TMyObject','','TObject');
  428. AssertPropertyMap('a','Integer','a','');
  429. end;
  430. procedure TTestGenCode.Test2IntegersProperty;
  431. begin
  432. GenCode('{ "a" : 1, "b" : 2 }');
  433. AssertUnitHeader;
  434. AssertClassHeader('TMyObject','TObject');
  435. AssertField('a','integer');
  436. AssertField('b','integer');
  437. AssertVisibility('public');
  438. AssertProperty('a','integer');
  439. AssertProperty('b','integer');
  440. AssertEnd;
  441. AssertPropertyMap('','TMyObject','','TObject');
  442. AssertPropertyMap('a','Integer','a','');
  443. AssertPropertyMap('b','Integer','b','');
  444. end;
  445. procedure TTestGenCode.TestBooleanProperty;
  446. begin
  447. GenCode('{ "a" : true }');
  448. AssertUnitHeader;
  449. AssertClassHeader('TMyObject','TObject');
  450. AssertField('a','boolean');
  451. AssertVisibility('public');
  452. AssertProperty('a','boolean');
  453. AssertEnd;
  454. AssertPropertyMap('','TMyObject','','TObject');
  455. AssertPropertyMap('a','Boolean','a','');
  456. end;
  457. procedure TTestGenCode.TestStringProperty;
  458. begin
  459. GenCode('{ "a" : "abce" }');
  460. AssertUnitHeader;
  461. AssertClassHeader('TMyObject','TObject');
  462. AssertField('a','string');
  463. AssertVisibility('public');
  464. AssertProperty('a','string');
  465. AssertEnd;
  466. AssertPropertyMap('','TMyObject','','TObject');
  467. AssertPropertyMap('a','String','a','');
  468. end;
  469. procedure TTestGenCode.TestFloatProperty;
  470. begin
  471. GenCode('{ "a" : 1.1 }');
  472. AssertUnitHeader;
  473. AssertClassHeader('TMyObject','TObject');
  474. AssertField('a','double');
  475. AssertVisibility('public');
  476. AssertProperty('a','double');
  477. AssertEnd;
  478. AssertPropertyMap('','TMyObject','','TObject');
  479. AssertPropertyMap('a','Double','a','');
  480. end;
  481. procedure TTestGenCode.TestInt64Property;
  482. begin
  483. GenCode('{ "a" : 1234567890123 }');
  484. AssertUnitHeader;
  485. AssertClassHeader('TMyObject','TObject');
  486. AssertField('a','int64');
  487. AssertVisibility('public');
  488. AssertProperty('a','int64');
  489. AssertEnd;
  490. AssertPropertyMap('','TMyObject','','TObject');
  491. AssertPropertyMap('a','Int64','a','');
  492. end;
  493. procedure TTestGenCode.TestPropertySetter;
  494. begin
  495. Gen.Options:=[jpoUseSetter];
  496. GenCode('{ "a" : 1234567890123 }');
  497. AssertUnitHeader;
  498. AssertClassHeader('TMyObject','TObject');
  499. AssertField('a','int64');
  500. AssertVisibility('protected');
  501. AssertSetter('A','int64');
  502. AssertVisibility('public');
  503. AssertProperty('a','int64',True);
  504. AssertEnd;
  505. AssertImplementation;
  506. AssertClassComment('Object Implementation','TMyObject');
  507. AssertSetterImplementation('TMyObject','a','int64');
  508. AssertUnitEnd;
  509. AssertPropertyMap('','TMyObject','','TObject');
  510. AssertPropertyMap('a','Int64','a','');
  511. end;
  512. procedure TTestGenCode.TestObjectProperty;
  513. begin
  514. GenCode('{ "a" : {} }');
  515. AssertUnitHeader;
  516. AssertClassHeader('TA','TObject');
  517. AssertVisibility('public');
  518. AssertEnd;
  519. AssertClassHeader('TMyObject','TObject');
  520. AssertField('a','Ta');
  521. AssertVisibility('public');
  522. AssertDestructor;
  523. AssertProperty('a','Ta');
  524. AssertEnd;
  525. AssertImplementation;
  526. AssertClassComment('Comment for class TA','Ta');
  527. AssertClassComment('Comment for class TMyObject','TMyObject');
  528. AssertDestructorImplementation('TMyObject',['a']);
  529. AssertPropertyMap('','TMyObject','','TObject');
  530. AssertPropertyMap('a','Ta','a','TObject');
  531. end;
  532. procedure TTestGenCode.TestObjectPropertySetter;
  533. begin
  534. Gen.Options:=[jpoUseSetter];
  535. GenCode('{ "a" : {} }');
  536. AssertUnitHeader;
  537. AssertClassHeader('TA','TObject');
  538. AssertVisibility('protected');
  539. AssertVisibility('public');
  540. AssertEnd;
  541. AssertClassHeader('TMyObject','TObject');
  542. AssertField('a','Ta');
  543. AssertVisibility('protected');
  544. AssertSetter('a','Ta');
  545. AssertVisibility('Public');
  546. AssertDestructor;
  547. AssertProperty('a','Ta',True);
  548. AssertEnd;
  549. AssertImplementation;
  550. AssertClassComment('Comment for class TA','Ta');
  551. AssertClassComment('Comment for class TMyObject','TMyObject');
  552. AssertDestructorImplementation('TMyObject',['a']);
  553. AssertSetterImplementation('TMyObject','a','Ta',True);
  554. AssertPropertyMap('','TMyObject','','TObject');
  555. AssertPropertyMap('a','Ta','a','TObject');
  556. end;
  557. procedure TTestGenCode.TestObjectPropertySuffix;
  558. begin
  559. Gen.PropertyTypeSuffix:='Type';
  560. GenCode('{ "a" : {} }');
  561. AssertUnitHeader;
  562. AssertClassHeader('TAType','TObject');
  563. AssertVisibility('public');
  564. AssertEnd;
  565. AssertClassHeader('TMyObject','TObject');
  566. AssertField('a','TaType');
  567. AssertVisibility('public');
  568. AssertDestructor;
  569. AssertProperty('a','TaType');
  570. AssertEnd;
  571. AssertPropertyMap('','TMyObject','','TObject');
  572. AssertPropertyMap('a','TaType','a','TObject');
  573. end;
  574. procedure TTestGenCode.TestObjectPropertySkip;
  575. begin
  576. Gen.PropertyTypeSuffix:='Type';
  577. Gen.PropertyMap.AddPath('a','me').SkipType:=true;
  578. GenCode('{ "a" : {} }');
  579. AssertUnitHeader;
  580. AssertClassHeader('TMyObject','TObject');
  581. AssertField('a','me');
  582. AssertVisibility('public');
  583. AssertDestructor;
  584. AssertProperty('a','me');
  585. AssertEnd;
  586. AssertPropertyMap('','TMyObject','','TObject');
  587. AssertPropertyMap('a','me','a','');
  588. end;
  589. procedure TTestGenCode.TestObjectPropertyRecurse;
  590. begin
  591. GenCode('{ "a" : { "b" : {} } }');
  592. AssertUnitHeader;
  593. AssertClassHeader('TAB','TObject');
  594. AssertVisibility('public');
  595. AssertEnd;
  596. AssertClassHeader('TA','TObject');
  597. AssertField('b','TaB');
  598. AssertVisibility('public');
  599. AssertDestructor;
  600. AssertProperty('b','TaB');
  601. AssertEnd;
  602. AssertClassHeader('TMyObject','TObject');
  603. AssertField('a','Ta');
  604. AssertVisibility('public');
  605. AssertDestructor;
  606. AssertProperty('a','Ta');
  607. AssertEnd;
  608. AssertPropertyMap('','TMyObject','','TObject');
  609. AssertPropertyMap('a','Ta','a','TObject');
  610. AssertPropertyMap('a.b','Tab','b','TObject');
  611. end;
  612. procedure TTestGenCode.TestObjectPropertyRecurseSuffix;
  613. begin
  614. Gen.PropertyTypeSuffix:='Type';
  615. GenCode('{ "a" : { "b" : {} } }');
  616. AssertUnitHeader;
  617. AssertClassHeader('TABType','TObject');
  618. AssertVisibility('public');
  619. AssertEnd;
  620. AssertClassHeader('TAType','TObject');
  621. AssertField('b','TaBType');
  622. AssertVisibility('public');
  623. AssertDestructor;
  624. AssertProperty('b','TaBType');
  625. AssertEnd;
  626. AssertClassHeader('TMyObject','TObject');
  627. AssertField('a','TaType');
  628. AssertVisibility('public');
  629. AssertDestructor;
  630. AssertProperty('a','TaType');
  631. AssertEnd;
  632. AssertPropertyMap('','TMyObject','','TObject');
  633. AssertPropertyMap('a','TaType','a','TObject');
  634. AssertPropertyMap('a.b','TabType','b','TObject');
  635. end;
  636. procedure TTestGenCode.TestObjectPropertyRecurseSkip;
  637. begin
  638. Gen.PropertyMap.AddPath('a','me').SkipType:=true;
  639. GenCode('{ "a" : { "b" : {} } }');
  640. AssertUnitHeader;
  641. AssertClassHeader('TMyObject','TObject');
  642. AssertField('a','me');
  643. AssertVisibility('public');
  644. AssertDestructor;
  645. AssertProperty('a','me');
  646. AssertEnd;
  647. AssertPropertyMap('','TMyObject','','TObject');
  648. AssertPropertyMap('a','me','a','');
  649. end;
  650. procedure TTestGenCode.TestObjectPropertyRecurseSkipB;
  651. begin
  652. Gen.PropertyMap.AddPath('a.b','me').SkipType:=true;
  653. GenCode('{ "a" : { "b" : {} } }');
  654. AssertUnitHeader;
  655. AssertClassHeader('TA','TObject');
  656. AssertField('b','me');
  657. AssertVisibility('public');
  658. AssertDestructor;
  659. AssertProperty('b','me');
  660. AssertEnd;
  661. AssertClassHeader('TMyObject','TObject');
  662. AssertField('a','Ta');
  663. AssertVisibility('public');
  664. AssertDestructor;
  665. AssertProperty('a','Ta');
  666. AssertEnd;
  667. AssertPropertyMap('','TMyObject','','TObject');
  668. AssertPropertyMap('a','Ta','a','TObject');
  669. AssertPropertyMap('a.b','me','b','');
  670. end;
  671. procedure TTestGenCode.TestStringArrayProperty;
  672. begin
  673. GenCode('{ "a" : [ "" ] }');
  674. AssertUnitHeader;
  675. AssertArrayType('Ta','string');
  676. AssertClassHeader('TMyObject','TObject');
  677. AssertField('a','Ta');
  678. AssertVisibility('public');
  679. AssertProperty('a','Ta');
  680. AssertEnd;
  681. AssertPropertyMap('','TMyObject','','TObject');
  682. AssertPropertyMap('a','Ta','a','');
  683. AssertPropertyMap('a[0]','String','','');
  684. end;
  685. procedure TTestGenCode.TestIntegerArrayProperty;
  686. begin
  687. GenCode('{ "a" : [ 1 ] }');
  688. AssertUnitHeader;
  689. AssertArrayType('Ta','integer');
  690. AssertClassHeader('TMyObject','TObject');
  691. AssertField('a','Ta');
  692. AssertVisibility('public');
  693. AssertProperty('a','Ta');
  694. AssertEnd;
  695. AssertPropertyMap('','TMyObject','','TObject');
  696. AssertPropertyMap('a','Ta','a','');
  697. AssertPropertyMap('a[0]','Integer','','');
  698. end;
  699. procedure TTestGenCode.TestBooleanArrayProperty;
  700. begin
  701. GenCode('{ "a" : [ true ] }');
  702. AssertUnitHeader;
  703. AssertArrayType('Ta','Boolean');
  704. AssertClassHeader('TMyObject','TObject');
  705. AssertField('a','Ta');
  706. AssertVisibility('public');
  707. AssertProperty('a','Ta');
  708. AssertEnd;
  709. AssertPropertyMap('','TMyObject','','TObject');
  710. AssertPropertyMap('a','Ta','a','');
  711. AssertPropertyMap('a[0]','Boolean','','');
  712. end;
  713. procedure TTestGenCode.TestFloatArrayProperty;
  714. begin
  715. GenCode('{ "a" : [ 1.2 ] }');
  716. AssertUnitHeader;
  717. AssertArrayType('Ta','Double');
  718. AssertClassHeader('TMyObject','TObject');
  719. AssertField('a','Ta');
  720. AssertVisibility('public');
  721. AssertProperty('a','Ta');
  722. AssertEnd;
  723. AssertPropertyMap('','TMyObject','','TObject');
  724. AssertPropertyMap('a','Ta','a','');
  725. AssertPropertyMap('a[0]','Double','','');
  726. end;
  727. procedure TTestGenCode.TestInt64ArrayProperty;
  728. begin
  729. GenCode('{ "a" : [ 1234567890123 ] }');
  730. AssertUnitHeader;
  731. AssertArrayType('Ta','Int64');
  732. AssertClassHeader('TMyObject','TObject');
  733. AssertField('a','Ta');
  734. AssertVisibility('public');
  735. AssertProperty('a','Ta');
  736. AssertEnd;
  737. AssertPropertyMap('','TMyObject','','TObject');
  738. AssertPropertyMap('a','Ta','a','');
  739. AssertPropertyMap('a[0]','Int64','','');
  740. end;
  741. procedure TTestGenCode.TestStringArrayPropertySuffix;
  742. begin
  743. Gen.PropertyTypeSuffix:='Type';
  744. GenCode('{ "a" : [ "" ] }');
  745. AssertUnitHeader;
  746. AssertArrayType('TaType','string');
  747. AssertClassHeader('TMyObject','TObject');
  748. AssertField('a','TaType');
  749. AssertVisibility('public');
  750. AssertProperty('a','TaType');
  751. AssertEnd;
  752. AssertPropertyMap('','TMyObject','','TObject');
  753. AssertPropertyMap('a','TaType','a','');
  754. AssertPropertyMap('a[0]','String','','');
  755. end;
  756. procedure TTestGenCode.TestObjectArrayProperty;
  757. begin
  758. GenCode('{ "a" : [ {} ] }');
  759. AssertUnitHeader;
  760. AssertClassHeader('TaItem','TObject');
  761. AssertVisibility('public');
  762. AssertEnd;
  763. AssertArrayType('Ta','TaItem');
  764. AssertClassHeader('TMyObject','TObject');
  765. AssertField('a','Ta');
  766. AssertVisibility('public');
  767. AssertProperty('a','Ta');
  768. AssertEnd;
  769. AssertPropertyMap('','TMyObject','','TObject');
  770. AssertPropertyMap('a','Ta','a','');
  771. AssertPropertyMap('a[0]','TaItem','','TObject');
  772. end;
  773. procedure TTestGenCode.TestObjectArrayPropertySuffix;
  774. begin
  775. Gen.PropertyTypeSuffix:='Type';
  776. GenCode('{ "a" : [ {} ] }');
  777. AssertUnitHeader;
  778. AssertClassHeader('TaItemType','TObject');
  779. AssertVisibility('public');
  780. AssertEnd;
  781. AssertArrayType('TaType','TaItemType');
  782. AssertClassHeader('TMyObject','TObject');
  783. AssertField('a','TaType');
  784. AssertVisibility('public');
  785. AssertProperty('a','TaType');
  786. AssertEnd;
  787. AssertPropertyMap('','TMyObject','','TObject');
  788. AssertPropertyMap('a','TaType','a','');
  789. AssertPropertyMap('a[0]','TaItemType','','TObject');
  790. end;
  791. procedure TTestGenCode.TestArrayArrayProperty;
  792. begin
  793. GenCode('{ "a" : [ [ "" ] ] }');
  794. AssertUnitHeader;
  795. AssertArrayType('TaItem','String');
  796. AssertArrayType('Ta','TaItem');
  797. AssertClassHeader('TMyObject','TObject');
  798. AssertField('a','Ta');
  799. AssertVisibility('public');
  800. AssertProperty('a','Ta');
  801. AssertEnd;
  802. AssertPropertyMap('','TMyObject','','TObject');
  803. AssertPropertyMap('a','Ta','a','');
  804. AssertPropertyMap('a[0]','TaItem','','');
  805. AssertPropertyMap('a[0][0]','String','','');
  806. end;
  807. procedure TTestGenCode.TestObjectArrayArrayProperty;
  808. begin
  809. GenCode('{ "a" : [ [ {} ] ] }');
  810. AssertUnitHeader;
  811. AssertClassHeader('TaItemItem','TObject');
  812. AssertVisibility('public');
  813. AssertEnd;
  814. AssertArrayType('TaItem','TaItemItem');
  815. AssertArrayType('Ta','TaItem');
  816. AssertPropertyMap('','TMyObject','','TObject');
  817. AssertPropertyMap('a','Ta','a','');
  818. AssertPropertyMap('a[0]','TaItem','','');
  819. AssertPropertyMap('a[0][0]','TaItemItem','','TObject');
  820. end;
  821. procedure TTestGenCode.AssertLoadConstructorDeclaration(AType: String);
  822. Var
  823. S : String;
  824. begin
  825. S:=NextLine;
  826. AssertTrue('Load Constructor declaration in '+S,Pos('Constructor CreateFromJSON(AJSON : '+AType+'); virtual;',S)>0);
  827. end;
  828. procedure TTestGenCode.AssertLoaderDeclaration(AType : String);
  829. Var
  830. S : String;
  831. begin
  832. S:=NextLine;
  833. AssertTrue('LoadFromJSON declaration in '+S,Pos('Procedure LoadFromJSON(AJSON : '+AType+'); virtual;',S)>0);
  834. end;
  835. procedure TTestGenCode.AssertSaverDeclaration;
  836. Var
  837. S : String;
  838. begin
  839. S:=NextLine;
  840. AssertTrue('SaveToJSON function declaration in '+S,Pos('Function SaveToJSON : TJSONObject;',S)>0);
  841. S:=NextLine;
  842. AssertTrue('SaveToJSON procedure declaration in '+S,Pos('Procedure SaveToJSON(AJSON : TJSONObject)',S)>0);
  843. end;
  844. procedure TTestGenCode.AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
  845. begin
  846. if Not IsDelphi then
  847. AssertEnd('Case');// Case
  848. AssertEnd('for');// For
  849. AssertEnd('procedure');// Routine
  850. end;
  851. procedure TTestGenCode.AssertArrayLoaderImplementationStart(const ATypeName,
  852. ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
  853. Var
  854. S : String;
  855. begin
  856. S:=NextLine;
  857. AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
  858. if isDelphi then
  859. AssertDelphiPropertyAssignmentLoop
  860. else
  861. AssertPropertyAssignmentLoop;
  862. end;
  863. procedure TTestGenCode.AssertPropertyAssignmentLoop;
  864. begin
  865. AssertTrue('Have var',Pos('var',NextLine)>0);
  866. AssertTrue('Have P enum',Pos('E : TJSONEnum;',NextLine)>0);
  867. AssertBegin;
  868. AssertTrue('Have E for enum',Pos('For E in AJSON do',NextLine)>0);
  869. AssertBegin;
  870. if (jpoLoadCaseInsensitive in Gen.Options) then
  871. AssertTrue('Have E for enum',Pos('case LowerCase(E.key) of',NextLine)>0)
  872. else
  873. AssertTrue('Have E for enum',Pos('case E.key of',NextLine)>0);
  874. end;
  875. procedure TTestGenCode.AssertDelphiPropertyAssignmentLoop;
  876. Var
  877. S : String;
  878. begin
  879. AssertTrue('Have var',Pos('var',NextLine)>0);
  880. AssertTrue('Have pair',Pos('P : TJSONPair;',NextLine)>0);
  881. AssertTrue('Have obj',Pos('O : TJSONObject;',NextLine)>0);
  882. AssertTrue('Have Propertyname var',Pos('PN : String;',NextLine)>0);
  883. AssertBegin;
  884. S:=NextLine;
  885. AssertTrue('Have JSONObject check in '+S,Pos('not (AJSON is TJSONObject)',S)>0);
  886. if jpoUnknownLoadPropsError in gen.Options then
  887. AssertTrue('Have raise statement',Pos('Raise EJSONException',NextLine)>0);
  888. AssertTrue('Have typecast',Pos('O:=AJSON as TJSONObject',NextLine)>0);
  889. AssertTrue('Have P for enum',Pos('For P in O do',NextLine)>0);
  890. AssertBegin;
  891. if jpoLoadCaseInsensitive in Gen.Options then
  892. AssertTrue('Have case insensitive propertyname assign',Pos('PN:=LowerCase(P.JSONString.Value)',NextLine)>0)
  893. else
  894. AssertTrue('Have propertyname assign',Pos('PN:=P.JSONString.Value',NextLine)>0);
  895. end;
  896. procedure TTestGenCode.AssertObjectLoaderImplementationStart(const ATypeName,
  897. ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
  898. Var
  899. S : String;
  900. begin
  901. S:=NextLine;
  902. AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
  903. if isDelphi then
  904. AssertDelphiPropertyAssignmentLoop
  905. else
  906. AssertPropertyAssignmentLoop;
  907. end;
  908. procedure TTestGenCode.AssertSaverImplementationStart(const ATypeName: String;
  909. IsDelphi: Boolean);
  910. Var
  911. S,N : String;
  912. begin
  913. N:='SaveToJSONFunction '+ATypeName+' : ';
  914. S:=NextLine;
  915. AssertTrue(N+'header',Pos('Function '+ATypeName+'.SaveToJSON : TJSONObject;',S)>0);
  916. AssertBegin;
  917. AssertTrue(N+'Create',Pos('Result:=TJSONObject.Create',NextLine)>0);
  918. AssertTrue(N+'Try',Pos('Try',NextLine)>0);
  919. AssertTrue(N+'Save',Pos('SaveToJSON(Result);',NextLine)>0);
  920. AssertTrue(N+'except',Pos('except',NextLine)>0);
  921. AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
  922. AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
  923. AssertTrue(N+'end;',Pos('End;',NextLine)>0);
  924. AssertTrue(N+'end;',Pos('End;',NextLine)>0);
  925. AssertTrue(N+'proc header',Pos('Procedure '+ATypeName+'.SaveToJSON(AJSON : TJSONObject);',NextLine)>0);
  926. AssertBegin;
  927. end;
  928. procedure TTestGenCode.AssertLoaderImplementationStart(const ATypeName,
  929. ADataName: String; IsDelphi : Boolean = False);
  930. begin
  931. AssertTrue(Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',NextLine)>0);
  932. if isDelphi then
  933. AssertDelphiPropertyAssignmentLoop
  934. else
  935. AssertPropertyAssignmentLoop;
  936. end;
  937. procedure TTestGenCode.AssertLoadConstructorImplementationStart(const ATypeName,
  938. ADataName: String);
  939. begin
  940. AssertTrue('Have constructor call',Pos('Constructor '+ATypeName+'.CreateFromJSON(AJSON : '+ADataName+');',NextLine)>0);
  941. AssertBegin;
  942. AssertTrue('Call create constructor',Pos('create();',NextLine)>0);
  943. AssertTrue('Call LoadFromJSON',Pos('LoadFromJSON(AJSON);',NextLine)>0);
  944. AssertEnd;
  945. end;
  946. procedure TTestGenCode.TestLoadIntegerProperty;
  947. begin
  948. Gen.Options:=[jpoGenerateLoad];
  949. GenCode('{ "a" : 1234 }');
  950. AssertUnitHeader;
  951. AssertClassHeader('TMyObject','TObject');
  952. AssertField('a','integer');
  953. AssertVisibility('public');
  954. AssertLoadConstructorDeclaration('TJSONData');
  955. AssertLoaderDeclaration('TJSONData');
  956. AssertProperty('a','integer',False);
  957. AssertEnd;
  958. AssertImplementation;
  959. AssertClassComment('Object Implementation','TMyObject');
  960. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  961. AssertLoaderImplementationStart('TMyObject','TJSONData');
  962. AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
  963. AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
  964. AssertLoaderImplementationEnd;
  965. AssertUnitEnd;
  966. AssertPropertyMap('','TMyObject','','TObject');
  967. AssertPropertyMap('a','Integer','a','');
  968. end;
  969. procedure TTestGenCode.TestLoad2IntegersProperty;
  970. begin
  971. Gen.Options:=[jpoGenerateLoad];
  972. GenCode('{ "a" : 1234, "b" : 5678 }');
  973. AssertUnitHeader;
  974. AssertClassHeader('TMyObject','TObject');
  975. AssertField('a','integer');
  976. AssertField('b','integer');
  977. AssertVisibility('public');
  978. AssertLoadConstructorDeclaration('TJSONData');
  979. AssertLoaderDeclaration('TJSONData');
  980. AssertProperty('a','integer',False);
  981. AssertProperty('b','integer',False);
  982. AssertEnd;
  983. AssertImplementation;
  984. AssertClassComment('Object Implementation','TMyObject');
  985. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  986. AssertLoaderImplementationStart('TMyObject','TJSONData');
  987. AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
  988. AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
  989. AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
  990. AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
  991. AssertLoaderImplementationEnd;
  992. AssertUnitEnd;
  993. AssertPropertyMap('','TMyObject','','TObject');
  994. AssertPropertyMap('a','Integer','a','');
  995. AssertPropertyMap('b','Integer','b','');
  996. end;
  997. procedure TTestGenCode.TestLoadIntegerWithErrorProperty;
  998. begin
  999. Gen.Options:=[jpoGenerateLoad,jpoUnknownLoadPropsError];
  1000. GenCode('{ "a" : 1234, "b" : 5678 }');
  1001. AssertUnitHeader;
  1002. AssertClassHeader('TMyObject','TObject');
  1003. AssertField('a','integer');
  1004. AssertField('b','integer');
  1005. AssertVisibility('public');
  1006. AssertLoadConstructorDeclaration('TJSONData');
  1007. AssertLoaderDeclaration('TJSONData');
  1008. AssertProperty('a','integer',False);
  1009. AssertProperty('b','integer',False);
  1010. AssertEnd;
  1011. AssertImplementation;
  1012. AssertClassComment('Object Implementation','TMyObject');
  1013. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1014. AssertLoaderImplementationStart('TMyObject','TJSONData');
  1015. AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
  1016. AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
  1017. AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
  1018. AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
  1019. AssertTrue('Have case else',Pos('else',NextLine)>0);
  1020. AssertTrue('Have raise statement', Pos('Raise EJSON.CreateFmt',NextLine)>0);
  1021. AssertLoaderImplementationEnd;
  1022. AssertUnitEnd;
  1023. AssertPropertyMap('','TMyObject','','TObject');
  1024. AssertPropertyMap('a','Integer','a','');
  1025. AssertPropertyMap('b','Integer','b','');
  1026. end;
  1027. procedure TTestGenCode.TestLoadIntegerCaseInsensitiveProperty;
  1028. begin
  1029. Gen.Options:=[jpoGenerateLoad,jpoLoadCaseInsensitive];
  1030. GenCode('{ "A" : 1234 }');
  1031. AssertUnitHeader;
  1032. AssertClassHeader('TMyObject','TObject');
  1033. AssertField('A','integer');
  1034. AssertVisibility('public');
  1035. AssertLoadConstructorDeclaration('TJSONData');
  1036. AssertLoaderDeclaration('TJSONData');
  1037. AssertProperty('A','integer',False);
  1038. AssertEnd;
  1039. AssertImplementation;
  1040. AssertClassComment('Object Implementation','TMyObject');
  1041. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1042. AssertLoaderImplementationStart('TMyObject','TJSONData',False);
  1043. AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
  1044. AssertTrue('Have "a" integer property set', Pos('A:=E.Value.AsInteger;',NextLine)>0);
  1045. AssertLoaderImplementationEnd;
  1046. AssertUnitEnd;
  1047. AssertPropertyMap('','TMyObject','','TObject');
  1048. AssertPropertyMap('A','Integer','A','');
  1049. end;
  1050. procedure TTestGenCode.TestLoadStringProperty;
  1051. begin
  1052. Gen.Options:=[jpoGenerateLoad];
  1053. GenCode('{ "a" : "1234" }');
  1054. AssertUnitHeader;
  1055. AssertClassHeader('TMyObject','TObject');
  1056. AssertField('a','string');
  1057. AssertVisibility('public');
  1058. AssertLoadConstructorDeclaration('TJSONData');
  1059. AssertLoaderDeclaration('TJSONData');
  1060. AssertProperty('a','string',False);
  1061. AssertEnd;
  1062. AssertImplementation;
  1063. AssertClassComment('Object Implementation','TMyObject');
  1064. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1065. AssertLoaderImplementationStart('TMyObject','TJSONData');
  1066. AssertTrue('Have "a" string property case',Pos('''a'':',NextLine)>0);
  1067. AssertTrue('Have "a" string property set', Pos('a:=E.Value.AsString;',NextLine)>0);
  1068. AssertLoaderImplementationEnd;
  1069. AssertUnitEnd;
  1070. AssertPropertyMap('','TMyObject','','TObject');
  1071. AssertPropertyMap('a','String','a','');
  1072. end;
  1073. procedure TTestGenCode.TestLoadBooleanProperty;
  1074. begin
  1075. Gen.Options:=[jpoGenerateLoad];
  1076. GenCode('{ "a" : true }');
  1077. AssertUnitHeader;
  1078. AssertClassHeader('TMyObject','TObject');
  1079. AssertField('a','boolean');
  1080. AssertVisibility('public');
  1081. AssertLoadConstructorDeclaration('TJSONData');
  1082. AssertLoaderDeclaration('TJSONData');
  1083. AssertProperty('a','boolean',False);
  1084. AssertEnd;
  1085. AssertImplementation;
  1086. AssertClassComment('Object Implementation','TMyObject');
  1087. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1088. AssertLoaderImplementationStart('TMyObject','TJSONData');
  1089. AssertTrue('Have "a" boolean property case',Pos('''a'':',NextLine)>0);
  1090. AssertTrue('Have "a" boolean property set', Pos('a:=E.Value.AsBoolean;',NextLine)>0);
  1091. AssertLoaderImplementationEnd;
  1092. AssertUnitEnd;
  1093. AssertPropertyMap('','TMyObject','','TObject');
  1094. AssertPropertyMap('a','Boolean','a','');
  1095. end;
  1096. procedure TTestGenCode.TestLoadInt64Property;
  1097. begin
  1098. Gen.Options:=[jpoGenerateLoad];
  1099. GenCode('{ "a" : 1234567890123 }');
  1100. AssertUnitHeader;
  1101. AssertClassHeader('TMyObject','TObject');
  1102. AssertField('a','Int64');
  1103. AssertVisibility('public');
  1104. AssertLoadConstructorDeclaration('TJSONData');
  1105. AssertLoaderDeclaration('TJSONData');
  1106. AssertProperty('a','Int64',False);
  1107. AssertEnd;
  1108. AssertImplementation;
  1109. AssertClassComment('Object Implementation','TMyObject');
  1110. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1111. AssertLoaderImplementationStart('TMyObject','TJSONData');
  1112. AssertTrue('Have "a" Int64 property case',Pos('''a'':',NextLine)>0);
  1113. AssertTrue('Have "a" Int64 property set', Pos('a:=E.Value.AsInt64;',NextLine)>0);
  1114. AssertLoaderImplementationEnd;
  1115. AssertUnitEnd;
  1116. AssertPropertyMap('','TMyObject','','TObject');
  1117. AssertPropertyMap('a','Int64','a','');
  1118. end;
  1119. procedure TTestGenCode.TestLoadFloatProperty;
  1120. begin
  1121. Gen.Options:=[jpoGenerateLoad];
  1122. GenCode('{ "a" : 1.1 }');
  1123. AssertUnitHeader;
  1124. AssertClassHeader('TMyObject','TObject');
  1125. AssertField('a','Double');
  1126. AssertVisibility('public');
  1127. AssertLoadConstructorDeclaration('TJSONData');
  1128. AssertLoaderDeclaration('TJSONData');
  1129. AssertProperty('a','Double',False);
  1130. AssertEnd;
  1131. AssertImplementation;
  1132. AssertClassComment('Object Implementation','TMyObject');
  1133. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1134. AssertLoaderImplementationStart('TMyObject','TJSONData');
  1135. AssertTrue('Have "a" Double property case',Pos('''a'':',NextLine)>0);
  1136. AssertTrue('Have "a" Double property set', Pos('a:=E.Value.AsFloat;',NextLine)>0);
  1137. AssertLoaderImplementationEnd;
  1138. AssertUnitEnd;
  1139. AssertPropertyMap('','TMyObject','','TObject');
  1140. AssertPropertyMap('a','Double','a','');
  1141. end;
  1142. procedure TTestGenCode.TestLoadObjectProperty;
  1143. begin
  1144. Gen.Options:=[jpoGenerateLoad];
  1145. GenCode('{ "a" : { "b" : "abc" } }');
  1146. AssertUnitHeader;
  1147. AssertClassHeader('Ta','TObject');
  1148. AssertField('b','String');
  1149. AssertVisibility('public');
  1150. AssertLoadConstructorDeclaration('TJSONData');
  1151. AssertLoaderDeclaration('TJSONData');
  1152. AssertProperty('b','String',False);
  1153. AssertEnd;
  1154. AssertClassHeader('TMyObject','TObject');
  1155. AssertField('a','Ta');
  1156. AssertVisibility('public');
  1157. AssertDestructor;
  1158. AssertLoadConstructorDeclaration('TJSONData');
  1159. AssertLoaderDeclaration('TJSONData');
  1160. AssertProperty('a','ta',False);
  1161. AssertEnd;
  1162. AssertImplementation;
  1163. AssertClassComment('Object Implementation','Ta');
  1164. AssertLoadConstructorImplementationStart('Ta','TJSONData');
  1165. AssertLoaderImplementationStart('Ta','TJSONData');
  1166. AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
  1167. AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
  1168. AssertLoaderImplementationEnd;
  1169. AssertClassComment('Object Implementation','TMyObject');
  1170. AssertDestructorImplementation('TMyObject',['a']);
  1171. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1172. AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
  1173. AssertTrue('Have "a" object property case',Pos('''a'':',NextLine)>0);
  1174. AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(E.Value);',NextLine)>0);
  1175. AssertLoaderImplementationEnd;
  1176. AssertUnitEnd;
  1177. AssertPropertyMap('','TMyObject','','TObject');
  1178. AssertPropertyMap('a','Ta','a','TObject');
  1179. end;
  1180. procedure TTestGenCode.AssertArrayCreator(const ArrayTypeName,
  1181. AElementType: String; IsDelphi: Boolean);
  1182. Var
  1183. S : String;
  1184. begin
  1185. S:=NextLine;
  1186. AssertTrue('Have array creator in '+S,Pos('Function Create'+ArrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName,S)>0);
  1187. end;
  1188. procedure TTestGenCode.AssertArraySaver(const ArrayTypeName,
  1189. AElementType: String; IsDelphi: Boolean);
  1190. Var
  1191. E,S : String;
  1192. begin
  1193. S:=NextLine;
  1194. E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
  1195. AssertTrue('Have proc array saver in '+S,Pos(E,S)>0);
  1196. S:=NextLine;
  1197. E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
  1198. AssertTrue('Have func array saver in '+S,Pos(E,S)>0);
  1199. end;
  1200. procedure TTestGenCode.AssertArrayCreatorImplementation(const ArrayTypeName,
  1201. AElementType: String; AObjectName: String; IsDelphi: Boolean);
  1202. Var
  1203. S,E,AN : String;
  1204. begin
  1205. S:=NextLine;
  1206. E:='Function Create'+ARrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName;
  1207. AssertTrue('Have array creator header '+S+'Expected : '+E ,Pos(E,S)>0);
  1208. AssertTrue('Have var',Pos('var',NextLine)>0);
  1209. AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
  1210. if IsDelphi then
  1211. begin
  1212. AssertTrue('Have Array var',Pos('A : TJSONArray;',NextLine)>0);
  1213. AN:='A'
  1214. end
  1215. else
  1216. AN:='AJSON';
  1217. AssertBegin;
  1218. if IsDelphi then
  1219. AssertTrue('Have Array assignnment',Pos('A:=AJSON as TJSONArray;',NextLine)>0);
  1220. AssertTrue('Have array setlength ',Pos('SetLength(Result,'+AN+'.Count);',NextLine)>0);
  1221. AssertTrue('Have loop ',Pos('for i:=0 to '+AN+'.Count-1 do',NextLine)>0);
  1222. if AObjectName='' then
  1223. begin
  1224. if IsDelphi then
  1225. AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].GetValue<'+AElementType+'>;',NextLine)>0)
  1226. else
  1227. AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].'+AElementType+';',NextLine)>0)
  1228. end
  1229. else
  1230. AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AObjectName+'.CreateFromJSON('+AN+'.Items[i]);',NextLine)>0);
  1231. AssertEnd;
  1232. end;
  1233. procedure TTestGenCode.AssertLine(Msg : String; AExpected : String);
  1234. Var
  1235. N,DMsg : String;
  1236. begin
  1237. N:=NextLine;
  1238. DMsg:=Msg+', Expected: "'+AExpected+'", Actual: "'+N+'"';
  1239. AssertTrue(Dmsg,Pos(AExpected,N)>0);
  1240. end;
  1241. procedure TTestGenCode.AssertArraySaverImplementation(const ArrayTypeName,
  1242. AElementType: String; AObjectName: String; IsDelphi: Boolean);
  1243. Var
  1244. N,S,E,AN : String;
  1245. begin
  1246. N:=ArrayTypeName+'Saver : ';
  1247. S:=NextLine;
  1248. E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
  1249. AssertTrue(N+'header',Pos(E,S)>0);
  1250. AssertBegin;
  1251. AssertTrue(N+'Create',Pos('Result:=TJSONArray.Create',NextLine)>0);
  1252. AssertTrue(N+'Try',Pos('Try',NextLine)>0);
  1253. S:=NextLine;
  1254. E:='Save'+ArrayTypeName+'ToJSON(AnArray,Result);';
  1255. AssertTrue(N+'Save',Pos(E,S)>0);
  1256. AssertTrue(N+'except',Pos('except',NextLine)>0);
  1257. AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
  1258. AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
  1259. AssertTrue(N+'end;',Pos('End;',NextLine)>0);
  1260. AssertTrue(N+'end;',Pos('End;',NextLine)>0);
  1261. S:=NextLine;
  1262. E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
  1263. AssertTrue('Have array saver header '+S+'Expected : '+E ,Pos(E,S)>0);
  1264. AssertTrue('Have var',Pos('var',NextLine)>0);
  1265. AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
  1266. AssertBegin;
  1267. AssertTrue('Have loop ',Pos('for i:=0 to Length(AnArray)-1 do',NextLine)>0);
  1268. if AObjectName='' then
  1269. AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add(AnArray[i]);')
  1270. { else if AObjectName='' then
  1271. AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add('+AN+'[i]);')}
  1272. else
  1273. AssertTrue('Have element assignment : '+AElementType,Pos('AJSONArray.Add(AnArray[i].SaveToJSON);',NextLine)>0);
  1274. AssertEnd;
  1275. end;
  1276. procedure TTestGenCode.AssertType;
  1277. begin
  1278. AssertTrue('Have Type keyword',Pos('Type',NextLine)>0);
  1279. end;
  1280. procedure TTestGenCode.AssertDelphiLoadArray(AElementType, AJSONtype : String);
  1281. begin
  1282. AssertUnitHeader;
  1283. AssertArrayType('Ta',AElementType);
  1284. AssertArrayCreator('Ta',AElementType,true);
  1285. AssertType;
  1286. AssertClassHeader('TMyObject','TObject');
  1287. AssertField('a','Ta');
  1288. AssertVisibility('public');
  1289. AssertLoadConstructorDeclaration('TJSONValue');
  1290. AssertLoaderDeclaration('TJSONValue');
  1291. AssertProperty('a','ta',False);
  1292. AssertEnd;
  1293. AssertImplementation;
  1294. AssertArrayCreatorImplementation('Ta',AJSONType,'',True);
  1295. AssertClassComment('Object Implementation','TMyObject');
  1296. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1297. AssertArrayLoaderImplementationStart('TMyObject','TJSONValue','a','Ta',AJSONType);
  1298. AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
  1299. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.Value);',NextLine)>0);
  1300. AssertLoaderImplementationEnd;
  1301. AssertUnitEnd;
  1302. AssertPropertyMap('','TMyObject','','TObject');
  1303. AssertPropertyMap('a','Ta','a','');
  1304. end;
  1305. class function TTestGenCode.GetDataName(IsDelphi: Boolean): string;
  1306. begin
  1307. if IsDelphi then
  1308. Result:='TJSONValue'
  1309. else
  1310. Result:='TJSONData';
  1311. end;
  1312. procedure TTestGenCode.AssertLoadArray(AElementType, AJSONtype: String;
  1313. IsDelphi: Boolean = False);
  1314. Var
  1315. DN : String;
  1316. begin
  1317. AssertUnitHeader;
  1318. DN:=GetDataName(IsDelphi);
  1319. AssertArrayType('Ta',AElementType);
  1320. AssertArrayCreator('Ta',AElementType,IsDelphi);
  1321. AssertType;
  1322. AssertClassHeader('TMyObject','TObject');
  1323. AssertField('a','Ta');
  1324. AssertVisibility('public');
  1325. AssertLoadConstructorDeclaration(DN);
  1326. AssertLoaderDeclaration(DN);
  1327. AssertProperty('a','ta',False);
  1328. AssertEnd;
  1329. AssertImplementation;
  1330. AssertArrayCreatorImplementation('Ta',AJSONType,'',IsDelphi);
  1331. AssertClassComment('Object Implementation','TMyObject');
  1332. AssertLoadConstructorImplementationStart('TMyObject',DN);
  1333. AssertArrayLoaderImplementationStart('TMyObject',DN,'a','Ta',AJSONType,isDelphi);
  1334. if IsDelphi then
  1335. begin
  1336. AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
  1337. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
  1338. end
  1339. else
  1340. begin
  1341. AssertTrue('Have "a" array property case',Pos('''a'':',NextLine)>0);
  1342. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
  1343. end;
  1344. AssertLoaderImplementationEnd(IsDelphi);
  1345. AssertUnitEnd;
  1346. AssertPropertyMap('','TMyObject','','TObject');
  1347. AssertPropertyMap('a','Ta','a','');
  1348. end;
  1349. procedure TTestGenCode.AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
  1350. begin
  1351. AssertUnitHeader;
  1352. AssertArrayType('Ta',AElementType);
  1353. AssertArraySaver('Ta',AElementType,IsDelphi);
  1354. AssertType;
  1355. AssertClassHeader('TMyObject','TObject');
  1356. AssertField('a','Ta');
  1357. AssertVisibility('public');
  1358. AssertSaverDeclaration;
  1359. AssertProperty('a','ta',False);
  1360. AssertEnd;
  1361. AssertImplementation;
  1362. AssertArraySaverImplementation('Ta',AJSONType,'',IsDelphi);
  1363. AssertClassComment('Object Implementation','TMyObject');
  1364. AssertSaverImplementationStart('TMyObject');
  1365. if IsDelphi then
  1366. AssertTrue('Array save statement', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0)
  1367. else
  1368. AssertTrue('Array save statement', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
  1369. AssertEnd('Saver');
  1370. AssertUnitEnd;
  1371. AssertPropertyMap('','TMyObject','','TObject');
  1372. AssertPropertyMap('a','Ta','a','');
  1373. end;
  1374. procedure TTestGenCode.TestLoadStringArrayProperty;
  1375. begin
  1376. Gen.Options:=[jpoGenerateLoad];
  1377. GenCode('{ "a" : [ "abc" ] }');
  1378. AssertLoadArray('string','AsString');
  1379. end;
  1380. procedure TTestGenCode.TestLoadBooleanArrayProperty;
  1381. begin
  1382. Gen.Options:=[jpoGenerateLoad];
  1383. GenCode('{ "a" : [ true ] }');
  1384. AssertLoadArray('boolean','AsBoolean');
  1385. end;
  1386. procedure TTestGenCode.TestLoadIntegerArrayProperty;
  1387. begin
  1388. Gen.Options:=[jpoGenerateLoad];
  1389. GenCode('{ "a" : [ 123 ] }');
  1390. AssertLoadArray('Integer','AsInteger');
  1391. end;
  1392. procedure TTestGenCode.TestLoadInt64ArrayProperty;
  1393. begin
  1394. Gen.Options:=[jpoGenerateLoad];
  1395. GenCode('{ "a" : [ 1234567890123 ] }');
  1396. AssertLoadArray('Int64','AsInt64');
  1397. end;
  1398. procedure TTestGenCode.TestLoadFloatArrayProperty;
  1399. begin
  1400. Gen.Options:=[jpoGenerateLoad];
  1401. GenCode('{ "a" : [ 12.34 ] }');
  1402. AssertLoadArray('Double','AsFloat');
  1403. end;
  1404. procedure TTestGenCode.TestLoadObjectArrayProperty;
  1405. begin
  1406. Gen.Options:=[jpoGenerateLoad];
  1407. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1408. AssertUnitHeader;
  1409. AssertClassHeader('TaItem','TObject');
  1410. AssertField('b','String');
  1411. AssertVisibility('public');
  1412. AssertLoadConstructorDeclaration('TJSONData');
  1413. AssertLoaderDeclaration('TJSONData');
  1414. AssertProperty('b','String',False);
  1415. AssertEnd;
  1416. AssertArrayType('Ta','TaItem');
  1417. AssertArrayCreator('Ta','TaItem');
  1418. AssertType;
  1419. AssertClassHeader('TMyObject','TObject');
  1420. AssertField('a','Ta');
  1421. AssertVisibility('public');
  1422. AssertLoadConstructorDeclaration('TJSONData');
  1423. AssertLoaderDeclaration('TJSONData');
  1424. AssertProperty('a','ta',False);
  1425. AssertEnd;
  1426. AssertImplementation;
  1427. AssertClassComment('Object Implementation','TaItem');
  1428. AssertLoadConstructorImplementationStart('TAItem','TJSONData');
  1429. AssertLoaderImplementationStart('TaItem','TJSONData');
  1430. AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
  1431. AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
  1432. AssertLoaderImplementationEnd;
  1433. AssertArrayCreatorImplementation('Ta','','TaItem');
  1434. AssertClassComment('Object Implementation','TMyObject');
  1435. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1436. AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
  1437. AssertTrue('Have "a" stringarray property case',Pos('''a'':',NextLine)>0);
  1438. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
  1439. AssertLoaderImplementationEnd;
  1440. AssertUnitEnd;
  1441. AssertPropertyMap('','TMyObject','','TObject');
  1442. AssertPropertyMap('a','Ta','a','');
  1443. end;
  1444. procedure TTestGenCode.TestLoadDelphiIntegerProperty;
  1445. begin
  1446. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1447. GenCode('{ "a" : 1234 }');
  1448. AssertUnitHeader;
  1449. AssertClassHeader('TMyObject','TObject');
  1450. AssertField('a','integer');
  1451. AssertVisibility('public');
  1452. AssertLoadConstructorDeclaration('TJSONValue');
  1453. AssertLoaderDeclaration('TJSONValue');
  1454. AssertProperty('a','integer',False);
  1455. AssertEnd;
  1456. AssertImplementation;
  1457. AssertClassComment('Object Implementation','TMyObject');
  1458. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1459. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1460. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1461. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1462. AssertLoaderImplementationEnd(True);
  1463. AssertUnitEnd;
  1464. AssertPropertyMap('','TMyObject','','TObject');
  1465. AssertPropertyMap('a','Integer','a','');
  1466. end;
  1467. procedure TTestGenCode.TestLoadDelphi2IntegersProperty;
  1468. Var
  1469. S : String;
  1470. begin
  1471. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1472. GenCode('{ "a" : 1234, "b" : 5678 }');
  1473. AssertUnitHeader;
  1474. AssertClassHeader('TMyObject','TObject');
  1475. AssertField('a','integer');
  1476. AssertField('b','integer');
  1477. AssertVisibility('public');
  1478. AssertLoadConstructorDeclaration('TJSONValue');
  1479. AssertLoaderDeclaration('TJSONValue');
  1480. AssertProperty('a','integer',False);
  1481. AssertProperty('b','integer',False);
  1482. AssertEnd;
  1483. AssertImplementation;
  1484. AssertClassComment('Object Implementation','TMyObject');
  1485. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1486. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1487. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1488. S:=NextLine;
  1489. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
  1490. AssertTrue('Have no semicolon', Pos(';',S)=0);
  1491. AssertTrue('Have else "b" integer property case ',Pos('Else If (PN=''b'') then',NextLine)>0);
  1492. AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1493. AssertLoaderImplementationEnd(True);
  1494. AssertUnitEnd;
  1495. AssertPropertyMap('','TMyObject','','TObject');
  1496. AssertPropertyMap('a','Integer','a','');
  1497. AssertPropertyMap('b','Integer','b','');
  1498. end;
  1499. procedure TTestGenCode.TestLoadDelphiIntegerWithErrorProperty;
  1500. Var
  1501. S : String;
  1502. begin
  1503. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoUnknownLoadPropsError];
  1504. GenCode('{ "a" : 1234, "b" : 5678 }');
  1505. AssertUnitHeader;
  1506. AssertClassHeader('TMyObject','TObject');
  1507. AssertField('a','integer');
  1508. AssertField('b','integer');
  1509. AssertVisibility('public');
  1510. AssertLoadConstructorDeclaration('TJSONValue');
  1511. AssertLoaderDeclaration('TJSONValue');
  1512. AssertProperty('a','integer',False);
  1513. AssertProperty('b','integer',False);
  1514. AssertEnd;
  1515. AssertImplementation;
  1516. AssertClassComment('Object Implementation','TMyObject');
  1517. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1518. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1519. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1520. S:=NextLine;
  1521. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
  1522. AssertTrue('Have no semicolon for a', Pos(';',S)=0);
  1523. AssertTrue('Have "b" integer property case ',Pos('If (PN=''b'') then',NextLine)>0);
  1524. S:=NextLine;
  1525. AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>',S)>0);
  1526. AssertTrue('Have no semicolon for b', Pos(';',S)=0);
  1527. AssertTrue('Have case else',Pos('else',NextLine)>0);
  1528. AssertTrue('Have raise statement', Pos('Raise EJSONException.CreateFmt',NextLine)>0);
  1529. AssertLoaderImplementationEnd(True);
  1530. AssertUnitEnd;
  1531. AssertPropertyMap('','TMyObject','','TObject');
  1532. AssertPropertyMap('a','Integer','a','');
  1533. AssertPropertyMap('b','Integer','b','');
  1534. end;
  1535. procedure TTestGenCode.TestLoadDelphiIntegerCaseInsensitiveProperty;
  1536. begin
  1537. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoLoadCaseInsensitive];
  1538. GenCode('{ "A" : 1234 }');
  1539. AssertUnitHeader;
  1540. AssertClassHeader('TMyObject','TObject');
  1541. AssertField('A','integer');
  1542. AssertVisibility('public');
  1543. AssertLoadConstructorDeclaration('TJSONValue');
  1544. AssertLoaderDeclaration('TJSONValue');
  1545. AssertProperty('A','integer',False);
  1546. AssertEnd;
  1547. AssertImplementation;
  1548. AssertClassComment('Object Implementation','TMyObject');
  1549. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1550. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1551. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1552. AssertTrue('Have "A" integer property set', Pos('A:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1553. AssertLoaderImplementationEnd(True);
  1554. AssertUnitEnd;
  1555. AssertPropertyMap('','TMyObject','','TObject');
  1556. AssertPropertyMap('A','Integer','A','');
  1557. end;
  1558. procedure TTestGenCode.TestLoadDelphiStringProperty;
  1559. begin
  1560. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1561. GenCode('{ "a" : "1234" }');
  1562. AssertUnitHeader;
  1563. AssertClassHeader('TMyObject','TObject');
  1564. AssertField('a','String');
  1565. AssertVisibility('public');
  1566. AssertLoadConstructorDeclaration('TJSONValue');
  1567. AssertLoaderDeclaration('TJSONValue');
  1568. AssertProperty('a','string',False);
  1569. AssertEnd;
  1570. AssertImplementation;
  1571. AssertClassComment('Object Implementation','TMyObject');
  1572. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1573. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1574. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1575. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1576. AssertLoaderImplementationEnd(True);
  1577. AssertUnitEnd;
  1578. AssertPropertyMap('','TMyObject','','TObject');
  1579. AssertPropertyMap('a','String','a','');
  1580. end;
  1581. procedure TTestGenCode.TestLoadDelphiBooleanProperty;
  1582. begin
  1583. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1584. GenCode('{ "a" : true }');
  1585. AssertUnitHeader;
  1586. AssertClassHeader('TMyObject','TObject');
  1587. AssertField('a','boolean');
  1588. AssertVisibility('public');
  1589. AssertLoadConstructorDeclaration('TJSONValue');
  1590. AssertLoaderDeclaration('TJSONValue');
  1591. AssertProperty('a','boolean',False);
  1592. AssertEnd;
  1593. AssertImplementation;
  1594. AssertClassComment('Object Implementation','TMyObject');
  1595. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1596. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1597. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1598. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Boolean>;',NextLine)>0);
  1599. AssertLoaderImplementationEnd(True);
  1600. AssertUnitEnd;
  1601. AssertPropertyMap('','TMyObject','','TObject');
  1602. AssertPropertyMap('a','Boolean','a','');
  1603. end;
  1604. procedure TTestGenCode.TestLoadDelphiInt64Property;
  1605. begin
  1606. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1607. GenCode('{ "a" : 1234567890123 }');
  1608. AssertUnitHeader;
  1609. AssertClassHeader('TMyObject','TObject');
  1610. AssertField('a','Int64');
  1611. AssertVisibility('public');
  1612. AssertLoadConstructorDeclaration('TJSONValue');
  1613. AssertLoaderDeclaration('TJSONValue');
  1614. AssertProperty('a','Int64',False);
  1615. AssertEnd;
  1616. AssertImplementation;
  1617. AssertClassComment('Object Implementation','TMyObject');
  1618. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1619. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1620. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1621. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Int64>;',NextLine)>0);
  1622. AssertLoaderImplementationEnd(True);
  1623. AssertUnitEnd;
  1624. AssertPropertyMap('','TMyObject','','TObject');
  1625. AssertPropertyMap('a','Int64','a','');
  1626. end;
  1627. procedure TTestGenCode.TestLoadDelphiFloatProperty;
  1628. begin
  1629. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1630. GenCode('{ "a" : 1.1 }');
  1631. AssertUnitHeader;
  1632. AssertClassHeader('TMyObject','TObject');
  1633. AssertField('a','Double');
  1634. AssertVisibility('public');
  1635. AssertLoadConstructorDeclaration('TJSONValue');
  1636. AssertLoaderDeclaration('TJSONValue');
  1637. AssertProperty('a','Double',False);
  1638. AssertEnd;
  1639. AssertImplementation;
  1640. AssertClassComment('Object Implementation','TMyObject');
  1641. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1642. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1643. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1644. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Double>;',NextLine)>0);
  1645. AssertLoaderImplementationEnd(True);
  1646. AssertUnitEnd;
  1647. AssertPropertyMap('','TMyObject','','TObject');
  1648. AssertPropertyMap('a','Double','a','');
  1649. end;
  1650. procedure TTestGenCode.TestLoadDelphiObjectProperty;
  1651. begin
  1652. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1653. GenCode('{ "a" : { "b" : "abc" } }');
  1654. AssertUnitHeader;
  1655. AssertClassHeader('Ta','TObject');
  1656. AssertField('b','String');
  1657. AssertVisibility('public');
  1658. AssertLoadConstructorDeclaration('TJSONValue');
  1659. AssertLoaderDeclaration('TJSONValue');
  1660. AssertProperty('b','String',False);
  1661. AssertEnd;
  1662. AssertClassHeader('TMyObject','TObject');
  1663. AssertField('a','Ta');
  1664. AssertVisibility('public');
  1665. AssertDestructor;
  1666. AssertLoadConstructorDeclaration('TJSONValue');
  1667. AssertLoaderDeclaration('TJSONValue');
  1668. AssertProperty('a','ta',False);
  1669. AssertEnd;
  1670. AssertImplementation;
  1671. AssertClassComment('Object Implementation','Ta');
  1672. AssertLoadConstructorImplementationStart('Ta','TJSONValue');
  1673. AssertLoaderImplementationStart('Ta','TJSONValue',True);
  1674. AssertTrue('Have "b" string property case',Pos('If (PN=''b'') then',NextLine)>0);
  1675. AssertTrue('Have "b" string property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1676. AssertLoaderImplementationEnd(True);
  1677. AssertClassComment('Object Implementation','TMyObject');
  1678. AssertDestructorImplementation('TMyObject',['a']);
  1679. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1680. AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
  1681. AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
  1682. AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(P.JSONValue);',NextLine)>0);
  1683. AssertLoaderImplementationEnd(True);
  1684. AssertUnitEnd;
  1685. AssertPropertyMap('','TMyObject','','TObject');
  1686. AssertPropertyMap('a','Ta','a','TObject');
  1687. end;
  1688. procedure TTestGenCode.TestLoadDelphiObjectArrayProperty;
  1689. begin
  1690. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1691. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1692. AssertUnitHeader;
  1693. AssertClassHeader('TaItem','TObject');
  1694. AssertField('b','String');
  1695. AssertVisibility('public');
  1696. AssertLoadConstructorDeclaration('TJSONValue');
  1697. AssertLoaderDeclaration('TJSONValue');
  1698. AssertProperty('b','String',False);
  1699. AssertEnd;
  1700. AssertArrayType('Ta','TaItem');
  1701. AssertArrayCreator('Ta','TaItem',True);
  1702. AssertType;
  1703. AssertClassHeader('TMyObject','TObject');
  1704. AssertField('a','Ta');
  1705. AssertVisibility('public');
  1706. AssertLoadConstructorDeclaration('TJSONValue');
  1707. AssertLoaderDeclaration('TJSONValue');
  1708. AssertProperty('a','ta',False);
  1709. AssertEnd;
  1710. AssertImplementation;
  1711. AssertClassComment('Object Implementation','TaItem');
  1712. AssertLoadConstructorImplementationStart('TAItem','TJSONValue');
  1713. AssertLoaderImplementationStart('TaItem','TJSONValue',True);
  1714. AssertTrue('Have "b" object property case',Pos('If (PN=''b'') then',NextLine)>0);
  1715. AssertTrue('Have "b" object property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1716. AssertLoaderImplementationEnd(True);
  1717. AssertArrayCreatorImplementation('Ta','','TaItem',True);
  1718. AssertClassComment('Object Implementation','TMyObject');
  1719. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1720. AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
  1721. AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
  1722. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
  1723. AssertLoaderImplementationEnd(True);
  1724. AssertUnitEnd;
  1725. AssertPropertyMap('','TMyObject','','TObject');
  1726. AssertPropertyMap('a','Ta','a','');
  1727. end;
  1728. procedure TTestGenCode.TestSaveIntegerProperty;
  1729. begin
  1730. Gen.Options:=[jpoGenerateSave];
  1731. GenCode('{ "a" : 1234 }');
  1732. AssertUnitHeader;
  1733. AssertClassHeader('TMyObject','TObject');
  1734. AssertField('a','integer');
  1735. AssertVisibility('public');
  1736. AssertSaverDeclaration;
  1737. AssertProperty('a','integer',False);
  1738. AssertEnd;
  1739. AssertImplementation;
  1740. AssertClassComment('Object Implementation','TMyObject');
  1741. AssertSaverImplementationStart('TMyObject');
  1742. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1743. AssertTrue('end',Pos('end;',NextLine)>0);
  1744. AssertUnitEnd;
  1745. AssertPropertyMap('','TMyObject','','TObject');
  1746. AssertPropertyMap('a','Integer','a','');
  1747. end;
  1748. procedure TTestGenCode.TestSave2IntegersProperty;
  1749. begin
  1750. Gen.Options:=[jpoGenerateSave];
  1751. GenCode('{ "a" : 1234, "b" : 5678 }');
  1752. AssertUnitHeader;
  1753. AssertClassHeader('TMyObject','TObject');
  1754. AssertField('a','integer');
  1755. AssertField('b','integer');
  1756. AssertVisibility('public');
  1757. AssertSaverDeclaration;
  1758. AssertProperty('a','integer',False);
  1759. AssertProperty('b','integer',False);
  1760. AssertEnd;
  1761. AssertImplementation;
  1762. AssertClassComment('Object Implementation','TMyObject');
  1763. AssertSaverImplementationStart('TMyObject');
  1764. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1765. AssertTrue('Have "b" integer property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1766. AssertTrue('end',Pos('end;',NextLine)>0);
  1767. AssertUnitEnd;
  1768. AssertPropertyMap('','TMyObject','','TObject');
  1769. AssertPropertyMap('a','Integer','a','');
  1770. AssertPropertyMap('b','Integer','b','');
  1771. end;
  1772. procedure TTestGenCode.TestSaveStringProperty;
  1773. begin
  1774. Gen.Options:=[jpoGenerateSave];
  1775. GenCode('{ "a" : "1234" }');
  1776. AssertUnitHeader;
  1777. AssertClassHeader('TMyObject','TObject');
  1778. AssertField('a','string');
  1779. AssertVisibility('public');
  1780. AssertSaverDeclaration;
  1781. AssertProperty('a','string',False);
  1782. AssertEnd;
  1783. AssertImplementation;
  1784. AssertClassComment('Object Implementation','TMyObject');
  1785. AssertSaverImplementationStart('TMyObject');
  1786. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1787. AssertTrue('end',Pos('end;',NextLine)>0);
  1788. AssertUnitEnd;
  1789. AssertPropertyMap('','TMyObject','','TObject');
  1790. AssertPropertyMap('a','String','a','');
  1791. end;
  1792. procedure TTestGenCode.TestSaveBooleanProperty;
  1793. begin
  1794. Gen.Options:=[jpoGenerateSave];
  1795. GenCode('{ "a" : true }');
  1796. AssertUnitHeader;
  1797. AssertClassHeader('TMyObject','TObject');
  1798. AssertField('a','Boolean');
  1799. AssertVisibility('public');
  1800. AssertSaverDeclaration;
  1801. AssertProperty('a','Boolean',False);
  1802. AssertEnd;
  1803. AssertImplementation;
  1804. AssertClassComment('Object Implementation','TMyObject');
  1805. AssertSaverImplementationStart('TMyObject');
  1806. AssertTrue('Have "a" boolean property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1807. AssertTrue('end',Pos('end;',NextLine)>0);
  1808. AssertUnitEnd;
  1809. AssertPropertyMap('','TMyObject','','TObject');
  1810. AssertPropertyMap('a','Boolean','a','');
  1811. end;
  1812. procedure TTestGenCode.TestSaveInt64Property;
  1813. begin
  1814. Gen.Options:=[jpoGenerateSave];
  1815. GenCode('{ "a" : 1234567890123 }');
  1816. AssertUnitHeader;
  1817. AssertClassHeader('TMyObject','TObject');
  1818. AssertField('a','Int64');
  1819. AssertVisibility('public');
  1820. AssertSaverDeclaration;
  1821. AssertProperty('a','Int64',False);
  1822. AssertEnd;
  1823. AssertImplementation;
  1824. AssertClassComment('Object Implementation','TMyObject');
  1825. AssertSaverImplementationStart('TMyObject');
  1826. AssertTrue('Have "a" int64 property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1827. AssertTrue('end',Pos('end;',NextLine)>0);
  1828. AssertUnitEnd;
  1829. AssertPropertyMap('','TMyObject','','TObject');
  1830. AssertPropertyMap('a','Int64','a','');
  1831. end;
  1832. procedure TTestGenCode.TestSaveFloatProperty;
  1833. begin
  1834. Gen.Options:=[jpoGenerateSave];
  1835. GenCode('{ "a" : 1.2 }');
  1836. AssertUnitHeader;
  1837. AssertClassHeader('TMyObject','TObject');
  1838. AssertField('a','double');
  1839. AssertVisibility('public');
  1840. AssertSaverDeclaration;
  1841. AssertProperty('a','double',False);
  1842. AssertEnd;
  1843. AssertImplementation;
  1844. AssertClassComment('Object Implementation','TMyObject');
  1845. AssertSaverImplementationStart('TMyObject');
  1846. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1847. AssertTrue('end',Pos('end;',NextLine)>0);
  1848. AssertUnitEnd;
  1849. AssertPropertyMap('','TMyObject','','TObject');
  1850. AssertPropertyMap('a','Double','a','');
  1851. end;
  1852. procedure TTestGenCode.TestSaveObjectProperty;
  1853. begin
  1854. Gen.Options:=[jpoGenerateSave];
  1855. GenCode('{ "a" : { "b" : "abc" } }');
  1856. AssertUnitHeader;
  1857. AssertClassHeader('Ta','TObject');
  1858. AssertField('b','String');
  1859. AssertVisibility('public');
  1860. AssertSaverDeclaration;
  1861. AssertProperty('b','String',False);
  1862. AssertEnd;
  1863. AssertClassHeader('TMyObject','TObject');
  1864. AssertField('a','Ta');
  1865. AssertVisibility('public');
  1866. AssertDestructor;
  1867. AssertSaverDeclaration;
  1868. AssertProperty('a','ta',False);
  1869. AssertEnd;
  1870. AssertImplementation;
  1871. AssertClassComment('Object Implementation','Ta');
  1872. AssertSaverImplementationStart('Ta');
  1873. AssertTrue('Have "b" property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1874. AssertEnd;
  1875. AssertClassComment('Object Implementation','TMyObject');
  1876. AssertDestructorImplementation('TMyObject',['a']);
  1877. AssertSaverImplementationStart('TMyObject');
  1878. AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
  1879. AssertTrue('Have "a" object property save', Pos('AJSON.Add(''a'',a.SaveToJSON);',NextLine)>0);
  1880. AssertEnd;
  1881. AssertUnitEnd;
  1882. AssertPropertyMap('','TMyObject','','TObject');
  1883. AssertPropertyMap('a','Ta','a','TObject');
  1884. end;
  1885. procedure TTestGenCode.TestSaveStringArrayProperty;
  1886. begin
  1887. Gen.Options:=[jpoGenerateSave];
  1888. GenCode('{ "a" : [ "abc" ] }');
  1889. AssertSaveArray('string','');
  1890. end;
  1891. procedure TTestGenCode.TestSaveBooleanArrayProperty;
  1892. begin
  1893. Gen.Options:=[jpoGenerateSave];
  1894. GenCode('{ "a" : [ true ] }');
  1895. AssertSaveArray('boolean','');
  1896. end;
  1897. procedure TTestGenCode.TestSaveIntegerArrayProperty;
  1898. begin
  1899. Gen.Options:=[jpoGenerateSave];
  1900. GenCode('{ "a" : [ 123 ] }');
  1901. AssertSaveArray('Integer','');
  1902. end;
  1903. procedure TTestGenCode.TestSaveInt64ArrayProperty;
  1904. begin
  1905. Gen.Options:=[jpoGenerateSave];
  1906. GenCode('{ "a" : [ 1234567890123 ] }');
  1907. AssertSaveArray('Int64','');
  1908. end;
  1909. procedure TTestGenCode.TestSaveFloatArrayProperty;
  1910. begin
  1911. Gen.Options:=[jpoGenerateSave];
  1912. GenCode('{ "a" : [ 1.23] }');
  1913. AssertSaveArray('Double','');
  1914. end;
  1915. procedure TTestGenCode.TestSaveObjectArrayProperty;
  1916. begin
  1917. Gen.Options:=[jpoGenerateSave];
  1918. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1919. AssertUnitHeader;
  1920. AssertClassHeader('TaItem','TObject');
  1921. AssertField('b','String');
  1922. AssertVisibility('public');
  1923. AssertSaverDeclaration;
  1924. AssertProperty('b','String',False);
  1925. AssertEnd;
  1926. AssertArrayType('Ta','TaItem');
  1927. AssertArraySaver('Ta','TaItem');
  1928. AssertType;
  1929. AssertClassHeader('TMyObject','TObject');
  1930. AssertField('a','Ta');
  1931. AssertVisibility('public');
  1932. AssertSaverDeclaration;
  1933. AssertProperty('a','ta',False);
  1934. AssertEnd;
  1935. AssertImplementation;
  1936. AssertClassComment('Object Implementation','TaItem');
  1937. AssertSaverImplementationStart('TaItem');
  1938. AssertTrue('Have "b" string property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1939. AssertTrue('end',Pos('end;',NextLine)>0);
  1940. AssertArraySaverImplementation('Ta','','TaItem');
  1941. AssertClassComment('Object Implementation','TMyObject');
  1942. AssertSaverImplementationStart('TMyObject');
  1943. AssertTrue('Have "a" array property save', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
  1944. AssertEnd('Loader TMyObject');
  1945. AssertUnitEnd;
  1946. AssertPropertyMap('','TMyObject','','TObject');
  1947. AssertPropertyMap('a','Ta','a','');
  1948. end;
  1949. procedure TTestGenCode.TestSaveDelphiIntegerProperty;
  1950. begin
  1951. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  1952. GenCode('{ "a" : 1234 }');
  1953. AssertUnitHeader;
  1954. AssertClassHeader('TMyObject','TObject');
  1955. AssertField('a','integer');
  1956. AssertVisibility('public');
  1957. AssertSaverDeclaration;
  1958. AssertProperty('a','integer',False);
  1959. AssertEnd;
  1960. AssertImplementation;
  1961. AssertClassComment('Object Implementation','TMyObject');
  1962. AssertSaverImplementationStart('TMyObject');
  1963. AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  1964. AssertTrue('end',Pos('end;',NextLine)>0);
  1965. AssertUnitEnd;
  1966. AssertPropertyMap('','TMyObject','','TObject');
  1967. AssertPropertyMap('a','Integer','a','');
  1968. end;
  1969. procedure TTestGenCode.TestSaveDelphi2IntegersProperty;
  1970. begin
  1971. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  1972. GenCode('{ "a" : 1234, "b" : 5678 }');
  1973. AssertUnitHeader;
  1974. AssertClassHeader('TMyObject','TObject');
  1975. AssertField('a','integer');
  1976. AssertField('b','integer');
  1977. AssertVisibility('public');
  1978. AssertSaverDeclaration;
  1979. AssertProperty('a','integer',False);
  1980. AssertProperty('b','integer',False);
  1981. AssertEnd;
  1982. AssertImplementation;
  1983. AssertClassComment('Object Implementation','TMyObject');
  1984. AssertSaverImplementationStart('TMyObject');
  1985. AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  1986. AssertTrue('Have "b" integer property save', Pos('AJSON.AddPair(''b'',TJSONNumber.Create(b));',NextLine)>0);
  1987. AssertTrue('end',Pos('end;',NextLine)>0);
  1988. AssertUnitEnd;
  1989. AssertPropertyMap('','TMyObject','','TObject');
  1990. AssertPropertyMap('a','Integer','a','');
  1991. AssertPropertyMap('b','Integer','b','');
  1992. end;
  1993. procedure TTestGenCode.TestSaveDelphiStringProperty;
  1994. begin
  1995. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  1996. GenCode('{ "a" : "1234" }');
  1997. AssertUnitHeader;
  1998. AssertClassHeader('TMyObject','TObject');
  1999. AssertField('a','string');
  2000. AssertVisibility('public');
  2001. AssertSaverDeclaration;
  2002. AssertProperty('a','string',False);
  2003. AssertEnd;
  2004. AssertImplementation;
  2005. AssertClassComment('Object Implementation','TMyObject');
  2006. AssertSaverImplementationStart('TMyObject');
  2007. AssertTrue('Have "a" string property save', Pos('AJSON.AddPair(''a'',TJSONString.Create(a));',NextLine)>0);
  2008. AssertTrue('end',Pos('end;',NextLine)>0);
  2009. AssertUnitEnd;
  2010. AssertPropertyMap('','TMyObject','','TObject');
  2011. AssertPropertyMap('a','String','a','');
  2012. end;
  2013. procedure TTestGenCode.TestSaveDelphiBooleanProperty;
  2014. begin
  2015. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2016. GenCode('{ "a" : true }');
  2017. AssertUnitHeader;
  2018. AssertClassHeader('TMyObject','TObject');
  2019. AssertField('a','Boolean');
  2020. AssertVisibility('public');
  2021. AssertSaverDeclaration;
  2022. AssertProperty('a','Boolean',False);
  2023. AssertEnd;
  2024. AssertImplementation;
  2025. AssertClassComment('Object Implementation','TMyObject');
  2026. AssertSaverImplementationStart('TMyObject');
  2027. AssertTrue('Have "a" Boolean property save', Pos('AJSON.AddPair(''a'',TJSONBoolean.Create(a));',NextLine)>0);
  2028. AssertTrue('end',Pos('end;',NextLine)>0);
  2029. AssertUnitEnd;
  2030. AssertPropertyMap('','TMyObject','','TObject');
  2031. AssertPropertyMap('a','Boolean','a','');
  2032. end;
  2033. procedure TTestGenCode.TestSaveDelphiInt64Property;
  2034. begin
  2035. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2036. GenCode('{ "a" : 1234567890123 }');
  2037. AssertUnitHeader;
  2038. AssertClassHeader('TMyObject','TObject');
  2039. AssertField('a','Int64');
  2040. AssertVisibility('public');
  2041. AssertSaverDeclaration;
  2042. AssertProperty('a','Int64',False);
  2043. AssertEnd;
  2044. AssertImplementation;
  2045. AssertClassComment('Object Implementation','TMyObject');
  2046. AssertSaverImplementationStart('TMyObject');
  2047. AssertTrue('Have "a" int64 property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  2048. AssertTrue('end',Pos('end;',NextLine)>0);
  2049. AssertUnitEnd;
  2050. AssertPropertyMap('','TMyObject','','TObject');
  2051. AssertPropertyMap('a','Int64','a','');
  2052. end;
  2053. procedure TTestGenCode.TestSaveDelphiFloatProperty;
  2054. Var
  2055. S : String;
  2056. begin
  2057. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2058. GenCode('{ "a" : 1.2 }');
  2059. AssertUnitHeader;
  2060. AssertClassHeader('TMyObject','TObject');
  2061. AssertField('a','double');
  2062. AssertVisibility('public');
  2063. AssertSaverDeclaration;
  2064. AssertProperty('a','double',False);
  2065. AssertEnd;
  2066. AssertImplementation;
  2067. AssertClassComment('Object Implementation','TMyObject');
  2068. AssertSaverImplementationStart('TMyObject');
  2069. S:=NextLine;
  2070. AssertTrue('Have "a" float property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',S)>0);
  2071. AssertTrue('end',Pos('end;',NextLine)>0);
  2072. AssertUnitEnd;
  2073. AssertPropertyMap('','TMyObject','','TObject');
  2074. AssertPropertyMap('a','Double','a','');
  2075. end;
  2076. procedure TTestGenCode.TestSaveDelphiObjectProperty;
  2077. Var
  2078. S : String;
  2079. begin
  2080. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2081. GenCode('{ "a" : { "b" : "abc" } }');
  2082. AssertUnitHeader;
  2083. AssertClassHeader('Ta','TObject');
  2084. AssertField('b','String');
  2085. AssertVisibility('public');
  2086. AssertSaverDeclaration;
  2087. AssertProperty('b','String',False);
  2088. AssertEnd;
  2089. AssertClassHeader('TMyObject','TObject');
  2090. AssertField('a','Ta');
  2091. AssertVisibility('public');
  2092. AssertDestructor;
  2093. AssertSaverDeclaration;
  2094. AssertProperty('a','ta',False);
  2095. AssertEnd;
  2096. AssertImplementation;
  2097. AssertClassComment('Object Implementation','Ta');
  2098. AssertSaverImplementationStart('Ta');
  2099. AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
  2100. AssertEnd;
  2101. AssertClassComment('Object Implementation','TMyObject');
  2102. AssertDestructorImplementation('TMyObject',['a']);
  2103. AssertSaverImplementationStart('TMyObject');
  2104. AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
  2105. S:=NextLine;
  2106. AssertTrue('Have "a" object property save', Pos('AJSON.AddPair(''a'',a.SaveToJSON);',S)>0);
  2107. AssertEnd;
  2108. AssertUnitEnd;
  2109. AssertPropertyMap('','TMyObject','','TObject');
  2110. AssertPropertyMap('a','Ta','a','TObject');
  2111. end;
  2112. procedure TTestGenCode.TestSaveDelphiStringArrayProperty;
  2113. begin
  2114. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2115. GenCode('{ "a" : [ "abc" ] }');
  2116. AssertSaveArray('string','',True);
  2117. end;
  2118. procedure TTestGenCode.TestSaveDelphiBooleanArrayProperty;
  2119. begin
  2120. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2121. GenCode('{ "a" : [ true ] }');
  2122. AssertSaveArray('boolean','',True);
  2123. end;
  2124. procedure TTestGenCode.TestSaveDelphiIntegerArrayProperty;
  2125. begin
  2126. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2127. GenCode('{ "a" : [ 123 ] }');
  2128. AssertSaveArray('Integer','',True);
  2129. end;
  2130. procedure TTestGenCode.TestSaveDelphiInt64ArrayProperty;
  2131. begin
  2132. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2133. GenCode('{ "a" : [ 1234567890123 ] }');
  2134. AssertSaveArray('Int64','',True);
  2135. end;
  2136. procedure TTestGenCode.TestSaveDelphiFloatArrayProperty;
  2137. begin
  2138. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2139. GenCode('{ "a" : [ 1.23] }');
  2140. AssertSaveArray('Double','',True);
  2141. end;
  2142. procedure TTestGenCode.TestSaveDelphiObjectArrayProperty;
  2143. begin
  2144. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2145. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  2146. AssertUnitHeader;
  2147. AssertClassHeader('TaItem','TObject');
  2148. AssertField('b','String');
  2149. AssertVisibility('public');
  2150. AssertSaverDeclaration;
  2151. AssertProperty('b','String',False);
  2152. AssertEnd;
  2153. AssertArrayType('Ta','TaItem');
  2154. AssertArraySaver('Ta','TaItem',True);
  2155. AssertType;
  2156. AssertClassHeader('TMyObject','TObject');
  2157. AssertField('a','Ta');
  2158. AssertVisibility('public');
  2159. AssertSaverDeclaration;
  2160. AssertProperty('a','ta',False);
  2161. AssertEnd;
  2162. AssertImplementation;
  2163. AssertClassComment('Object Implementation','TaItem');
  2164. AssertSaverImplementationStart('TaItem',True);
  2165. AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
  2166. AssertTrue('end',Pos('end;',NextLine)>0);
  2167. AssertArraySaverImplementation('Ta','','TaItem',True);
  2168. AssertClassComment('Object Implementation','TMyObject');
  2169. AssertSaverImplementationStart('TMyObject');
  2170. AssertTrue('Have "a" array property save', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0);
  2171. AssertEnd('Loader TMyObject');
  2172. AssertUnitEnd;
  2173. AssertPropertyMap('','TMyObject','','TObject');
  2174. AssertPropertyMap('a','Ta','a','');
  2175. end;
  2176. procedure TTestGenCode.TestLoadDelphiStringArrayProperty;
  2177. begin
  2178. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2179. GenCode('{ "a" : [ "abc" ] }');
  2180. AssertLoadArray('string','String',True);
  2181. end;
  2182. procedure TTestGenCode.TestLoadDelphiBooleanArrayProperty;
  2183. begin
  2184. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2185. GenCode('{ "a" : [ true ] }');
  2186. AssertLoadArray('boolean','Boolean',True);
  2187. end;
  2188. procedure TTestGenCode.TestLoadDelphiIntegerArrayProperty;
  2189. begin
  2190. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2191. GenCode('{ "a" : [ 12 ] }');
  2192. AssertLoadArray('integer','Integer',True);
  2193. end;
  2194. procedure TTestGenCode.TestLoadDelphiInt64ArrayProperty;
  2195. begin
  2196. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2197. GenCode('{ "a" : [ 1234567890123 ] }');
  2198. AssertLoadArray('int64','Int64',True);
  2199. end;
  2200. procedure TTestGenCode.TestLoadDelphiFloatArrayProperty;
  2201. begin
  2202. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2203. GenCode('{ "a" : [ 1.1 ] }');
  2204. AssertLoadArray('double','Double',True);
  2205. end;
  2206. initialization
  2207. RegisterTest(TTestGenCode);
  2208. end.