tcjsontocode.pp 80 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422
  1. unit tcjsontocode;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testutils, 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. Var
  1351. DN : String;
  1352. begin
  1353. AssertUnitHeader;
  1354. DN:=GetDataName(IsDelphi);
  1355. AssertArrayType('Ta',AElementType);
  1356. AssertArraySaver('Ta',AElementType,IsDelphi);
  1357. AssertType;
  1358. AssertClassHeader('TMyObject','TObject');
  1359. AssertField('a','Ta');
  1360. AssertVisibility('public');
  1361. AssertSaverDeclaration;
  1362. AssertProperty('a','ta',False);
  1363. AssertEnd;
  1364. AssertImplementation;
  1365. AssertArraySaverImplementation('Ta',AJSONType,'',IsDelphi);
  1366. AssertClassComment('Object Implementation','TMyObject');
  1367. AssertSaverImplementationStart('TMyObject');
  1368. if IsDelphi then
  1369. AssertTrue('Array save statement', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0)
  1370. else
  1371. AssertTrue('Array save statement', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
  1372. AssertEnd('Saver');
  1373. AssertUnitEnd;
  1374. AssertPropertyMap('','TMyObject','','TObject');
  1375. AssertPropertyMap('a','Ta','a','');
  1376. end;
  1377. procedure TTestGenCode.TestLoadStringArrayProperty;
  1378. begin
  1379. Gen.Options:=[jpoGenerateLoad];
  1380. GenCode('{ "a" : [ "abc" ] }');
  1381. AssertLoadArray('string','AsString');
  1382. end;
  1383. procedure TTestGenCode.TestLoadBooleanArrayProperty;
  1384. begin
  1385. Gen.Options:=[jpoGenerateLoad];
  1386. GenCode('{ "a" : [ true ] }');
  1387. AssertLoadArray('boolean','AsBoolean');
  1388. end;
  1389. procedure TTestGenCode.TestLoadIntegerArrayProperty;
  1390. begin
  1391. Gen.Options:=[jpoGenerateLoad];
  1392. GenCode('{ "a" : [ 123 ] }');
  1393. AssertLoadArray('Integer','AsInteger');
  1394. end;
  1395. procedure TTestGenCode.TestLoadInt64ArrayProperty;
  1396. begin
  1397. Gen.Options:=[jpoGenerateLoad];
  1398. GenCode('{ "a" : [ 1234567890123 ] }');
  1399. AssertLoadArray('Int64','AsInt64');
  1400. end;
  1401. procedure TTestGenCode.TestLoadFloatArrayProperty;
  1402. begin
  1403. Gen.Options:=[jpoGenerateLoad];
  1404. GenCode('{ "a" : [ 12.34 ] }');
  1405. AssertLoadArray('Double','AsFloat');
  1406. end;
  1407. procedure TTestGenCode.TestLoadObjectArrayProperty;
  1408. begin
  1409. Gen.Options:=[jpoGenerateLoad];
  1410. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1411. AssertUnitHeader;
  1412. AssertClassHeader('TaItem','TObject');
  1413. AssertField('b','String');
  1414. AssertVisibility('public');
  1415. AssertLoadConstructorDeclaration('TJSONData');
  1416. AssertLoaderDeclaration('TJSONData');
  1417. AssertProperty('b','String',False);
  1418. AssertEnd;
  1419. AssertArrayType('Ta','TaItem');
  1420. AssertArrayCreator('Ta','TaItem');
  1421. AssertType;
  1422. AssertClassHeader('TMyObject','TObject');
  1423. AssertField('a','Ta');
  1424. AssertVisibility('public');
  1425. AssertLoadConstructorDeclaration('TJSONData');
  1426. AssertLoaderDeclaration('TJSONData');
  1427. AssertProperty('a','ta',False);
  1428. AssertEnd;
  1429. AssertImplementation;
  1430. AssertClassComment('Object Implementation','TaItem');
  1431. AssertLoadConstructorImplementationStart('TAItem','TJSONData');
  1432. AssertLoaderImplementationStart('TaItem','TJSONData');
  1433. AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
  1434. AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
  1435. AssertLoaderImplementationEnd;
  1436. AssertArrayCreatorImplementation('Ta','','TaItem');
  1437. AssertClassComment('Object Implementation','TMyObject');
  1438. AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
  1439. AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
  1440. AssertTrue('Have "a" stringarray property case',Pos('''a'':',NextLine)>0);
  1441. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
  1442. AssertLoaderImplementationEnd;
  1443. AssertUnitEnd;
  1444. AssertPropertyMap('','TMyObject','','TObject');
  1445. AssertPropertyMap('a','Ta','a','');
  1446. end;
  1447. procedure TTestGenCode.TestLoadDelphiIntegerProperty;
  1448. Var
  1449. S : String;
  1450. begin
  1451. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1452. GenCode('{ "a" : 1234 }');
  1453. AssertUnitHeader;
  1454. AssertClassHeader('TMyObject','TObject');
  1455. AssertField('a','integer');
  1456. AssertVisibility('public');
  1457. AssertLoadConstructorDeclaration('TJSONValue');
  1458. AssertLoaderDeclaration('TJSONValue');
  1459. AssertProperty('a','integer',False);
  1460. AssertEnd;
  1461. AssertImplementation;
  1462. AssertClassComment('Object Implementation','TMyObject');
  1463. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1464. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1465. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1466. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1467. AssertLoaderImplementationEnd(True);
  1468. AssertUnitEnd;
  1469. AssertPropertyMap('','TMyObject','','TObject');
  1470. AssertPropertyMap('a','Integer','a','');
  1471. end;
  1472. procedure TTestGenCode.TestLoadDelphi2IntegersProperty;
  1473. Var
  1474. S : String;
  1475. begin
  1476. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1477. GenCode('{ "a" : 1234, "b" : 5678 }');
  1478. AssertUnitHeader;
  1479. AssertClassHeader('TMyObject','TObject');
  1480. AssertField('a','integer');
  1481. AssertField('b','integer');
  1482. AssertVisibility('public');
  1483. AssertLoadConstructorDeclaration('TJSONValue');
  1484. AssertLoaderDeclaration('TJSONValue');
  1485. AssertProperty('a','integer',False);
  1486. AssertProperty('b','integer',False);
  1487. AssertEnd;
  1488. AssertImplementation;
  1489. AssertClassComment('Object Implementation','TMyObject');
  1490. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1491. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1492. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1493. S:=NextLine;
  1494. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
  1495. AssertTrue('Have no semicolon', Pos(';',S)=0);
  1496. AssertTrue('Have else "b" integer property case ',Pos('Else If (PN=''b'') then',NextLine)>0);
  1497. AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1498. AssertLoaderImplementationEnd(True);
  1499. AssertUnitEnd;
  1500. AssertPropertyMap('','TMyObject','','TObject');
  1501. AssertPropertyMap('a','Integer','a','');
  1502. AssertPropertyMap('b','Integer','b','');
  1503. end;
  1504. procedure TTestGenCode.TestLoadDelphiIntegerWithErrorProperty;
  1505. Var
  1506. S : String;
  1507. begin
  1508. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoUnknownLoadPropsError];
  1509. GenCode('{ "a" : 1234, "b" : 5678 }');
  1510. AssertUnitHeader;
  1511. AssertClassHeader('TMyObject','TObject');
  1512. AssertField('a','integer');
  1513. AssertField('b','integer');
  1514. AssertVisibility('public');
  1515. AssertLoadConstructorDeclaration('TJSONValue');
  1516. AssertLoaderDeclaration('TJSONValue');
  1517. AssertProperty('a','integer',False);
  1518. AssertProperty('b','integer',False);
  1519. AssertEnd;
  1520. AssertImplementation;
  1521. AssertClassComment('Object Implementation','TMyObject');
  1522. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1523. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1524. AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
  1525. S:=NextLine;
  1526. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
  1527. AssertTrue('Have no semicolon for a', Pos(';',S)=0);
  1528. AssertTrue('Have "b" integer property case ',Pos('If (PN=''b'') then',NextLine)>0);
  1529. S:=NextLine;
  1530. AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>',S)>0);
  1531. AssertTrue('Have no semicolon for b', Pos(';',S)=0);
  1532. AssertTrue('Have case else',Pos('else',NextLine)>0);
  1533. AssertTrue('Have raise statement', Pos('Raise EJSONException.CreateFmt',NextLine)>0);
  1534. AssertLoaderImplementationEnd(True);
  1535. AssertUnitEnd;
  1536. AssertPropertyMap('','TMyObject','','TObject');
  1537. AssertPropertyMap('a','Integer','a','');
  1538. AssertPropertyMap('b','Integer','b','');
  1539. end;
  1540. procedure TTestGenCode.TestLoadDelphiIntegerCaseInsensitiveProperty;
  1541. begin
  1542. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoLoadCaseInsensitive];
  1543. GenCode('{ "A" : 1234 }');
  1544. AssertUnitHeader;
  1545. AssertClassHeader('TMyObject','TObject');
  1546. AssertField('A','integer');
  1547. AssertVisibility('public');
  1548. AssertLoadConstructorDeclaration('TJSONValue');
  1549. AssertLoaderDeclaration('TJSONValue');
  1550. AssertProperty('A','integer',False);
  1551. AssertEnd;
  1552. AssertImplementation;
  1553. AssertClassComment('Object Implementation','TMyObject');
  1554. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1555. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1556. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1557. AssertTrue('Have "A" integer property set', Pos('A:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
  1558. AssertLoaderImplementationEnd(True);
  1559. AssertUnitEnd;
  1560. AssertPropertyMap('','TMyObject','','TObject');
  1561. AssertPropertyMap('A','Integer','A','');
  1562. end;
  1563. procedure TTestGenCode.TestLoadDelphiStringProperty;
  1564. begin
  1565. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1566. GenCode('{ "a" : "1234" }');
  1567. AssertUnitHeader;
  1568. AssertClassHeader('TMyObject','TObject');
  1569. AssertField('a','String');
  1570. AssertVisibility('public');
  1571. AssertLoadConstructorDeclaration('TJSONValue');
  1572. AssertLoaderDeclaration('TJSONValue');
  1573. AssertProperty('a','string',False);
  1574. AssertEnd;
  1575. AssertImplementation;
  1576. AssertClassComment('Object Implementation','TMyObject');
  1577. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1578. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1579. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1580. AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1581. AssertLoaderImplementationEnd(True);
  1582. AssertUnitEnd;
  1583. AssertPropertyMap('','TMyObject','','TObject');
  1584. AssertPropertyMap('a','String','a','');
  1585. end;
  1586. procedure TTestGenCode.TestLoadDelphiBooleanProperty;
  1587. begin
  1588. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1589. GenCode('{ "a" : true }');
  1590. AssertUnitHeader;
  1591. AssertClassHeader('TMyObject','TObject');
  1592. AssertField('a','boolean');
  1593. AssertVisibility('public');
  1594. AssertLoadConstructorDeclaration('TJSONValue');
  1595. AssertLoaderDeclaration('TJSONValue');
  1596. AssertProperty('a','boolean',False);
  1597. AssertEnd;
  1598. AssertImplementation;
  1599. AssertClassComment('Object Implementation','TMyObject');
  1600. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1601. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1602. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1603. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Boolean>;',NextLine)>0);
  1604. AssertLoaderImplementationEnd(True);
  1605. AssertUnitEnd;
  1606. AssertPropertyMap('','TMyObject','','TObject');
  1607. AssertPropertyMap('a','Boolean','a','');
  1608. end;
  1609. procedure TTestGenCode.TestLoadDelphiInt64Property;
  1610. begin
  1611. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1612. GenCode('{ "a" : 1234567890123 }');
  1613. AssertUnitHeader;
  1614. AssertClassHeader('TMyObject','TObject');
  1615. AssertField('a','Int64');
  1616. AssertVisibility('public');
  1617. AssertLoadConstructorDeclaration('TJSONValue');
  1618. AssertLoaderDeclaration('TJSONValue');
  1619. AssertProperty('a','Int64',False);
  1620. AssertEnd;
  1621. AssertImplementation;
  1622. AssertClassComment('Object Implementation','TMyObject');
  1623. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1624. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1625. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1626. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Int64>;',NextLine)>0);
  1627. AssertLoaderImplementationEnd(True);
  1628. AssertUnitEnd;
  1629. AssertPropertyMap('','TMyObject','','TObject');
  1630. AssertPropertyMap('a','Int64','a','');
  1631. end;
  1632. procedure TTestGenCode.TestLoadDelphiFloatProperty;
  1633. begin
  1634. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1635. GenCode('{ "a" : 1.1 }');
  1636. AssertUnitHeader;
  1637. AssertClassHeader('TMyObject','TObject');
  1638. AssertField('a','Double');
  1639. AssertVisibility('public');
  1640. AssertLoadConstructorDeclaration('TJSONValue');
  1641. AssertLoaderDeclaration('TJSONValue');
  1642. AssertProperty('a','Double',False);
  1643. AssertEnd;
  1644. AssertImplementation;
  1645. AssertClassComment('Object Implementation','TMyObject');
  1646. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1647. AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
  1648. AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
  1649. AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Double>;',NextLine)>0);
  1650. AssertLoaderImplementationEnd(True);
  1651. AssertUnitEnd;
  1652. AssertPropertyMap('','TMyObject','','TObject');
  1653. AssertPropertyMap('a','Double','a','');
  1654. end;
  1655. procedure TTestGenCode.TestLoadDelphiObjectProperty;
  1656. begin
  1657. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1658. GenCode('{ "a" : { "b" : "abc" } }');
  1659. AssertUnitHeader;
  1660. AssertClassHeader('Ta','TObject');
  1661. AssertField('b','String');
  1662. AssertVisibility('public');
  1663. AssertLoadConstructorDeclaration('TJSONValue');
  1664. AssertLoaderDeclaration('TJSONValue');
  1665. AssertProperty('b','String',False);
  1666. AssertEnd;
  1667. AssertClassHeader('TMyObject','TObject');
  1668. AssertField('a','Ta');
  1669. AssertVisibility('public');
  1670. AssertDestructor;
  1671. AssertLoadConstructorDeclaration('TJSONValue');
  1672. AssertLoaderDeclaration('TJSONValue');
  1673. AssertProperty('a','ta',False);
  1674. AssertEnd;
  1675. AssertImplementation;
  1676. AssertClassComment('Object Implementation','Ta');
  1677. AssertLoadConstructorImplementationStart('Ta','TJSONValue');
  1678. AssertLoaderImplementationStart('Ta','TJSONValue',True);
  1679. AssertTrue('Have "b" string property case',Pos('If (PN=''b'') then',NextLine)>0);
  1680. AssertTrue('Have "b" string property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1681. AssertLoaderImplementationEnd(True);
  1682. AssertClassComment('Object Implementation','TMyObject');
  1683. AssertDestructorImplementation('TMyObject',['a']);
  1684. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1685. AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
  1686. AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
  1687. AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(P.JSONValue);',NextLine)>0);
  1688. AssertLoaderImplementationEnd(True);
  1689. AssertUnitEnd;
  1690. AssertPropertyMap('','TMyObject','','TObject');
  1691. AssertPropertyMap('a','Ta','a','TObject');
  1692. end;
  1693. procedure TTestGenCode.TestLoadDelphiObjectArrayProperty;
  1694. begin
  1695. Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
  1696. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1697. AssertUnitHeader;
  1698. AssertClassHeader('TaItem','TObject');
  1699. AssertField('b','String');
  1700. AssertVisibility('public');
  1701. AssertLoadConstructorDeclaration('TJSONValue');
  1702. AssertLoaderDeclaration('TJSONValue');
  1703. AssertProperty('b','String',False);
  1704. AssertEnd;
  1705. AssertArrayType('Ta','TaItem');
  1706. AssertArrayCreator('Ta','TaItem',True);
  1707. AssertType;
  1708. AssertClassHeader('TMyObject','TObject');
  1709. AssertField('a','Ta');
  1710. AssertVisibility('public');
  1711. AssertLoadConstructorDeclaration('TJSONValue');
  1712. AssertLoaderDeclaration('TJSONValue');
  1713. AssertProperty('a','ta',False);
  1714. AssertEnd;
  1715. AssertImplementation;
  1716. AssertClassComment('Object Implementation','TaItem');
  1717. AssertLoadConstructorImplementationStart('TAItem','TJSONValue');
  1718. AssertLoaderImplementationStart('TaItem','TJSONValue',True);
  1719. AssertTrue('Have "b" object property case',Pos('If (PN=''b'') then',NextLine)>0);
  1720. AssertTrue('Have "b" object property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
  1721. AssertLoaderImplementationEnd(True);
  1722. AssertArrayCreatorImplementation('Ta','','TaItem',True);
  1723. AssertClassComment('Object Implementation','TMyObject');
  1724. AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
  1725. AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
  1726. AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
  1727. AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
  1728. AssertLoaderImplementationEnd(True);
  1729. AssertUnitEnd;
  1730. AssertPropertyMap('','TMyObject','','TObject');
  1731. AssertPropertyMap('a','Ta','a','');
  1732. end;
  1733. procedure TTestGenCode.TestSaveIntegerProperty;
  1734. begin
  1735. Gen.Options:=[jpoGenerateSave];
  1736. GenCode('{ "a" : 1234 }');
  1737. AssertUnitHeader;
  1738. AssertClassHeader('TMyObject','TObject');
  1739. AssertField('a','integer');
  1740. AssertVisibility('public');
  1741. AssertSaverDeclaration;
  1742. AssertProperty('a','integer',False);
  1743. AssertEnd;
  1744. AssertImplementation;
  1745. AssertClassComment('Object Implementation','TMyObject');
  1746. AssertSaverImplementationStart('TMyObject');
  1747. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1748. AssertTrue('end',Pos('end;',NextLine)>0);
  1749. AssertUnitEnd;
  1750. AssertPropertyMap('','TMyObject','','TObject');
  1751. AssertPropertyMap('a','Integer','a','');
  1752. end;
  1753. procedure TTestGenCode.TestSave2IntegersProperty;
  1754. begin
  1755. Gen.Options:=[jpoGenerateSave];
  1756. GenCode('{ "a" : 1234, "b" : 5678 }');
  1757. AssertUnitHeader;
  1758. AssertClassHeader('TMyObject','TObject');
  1759. AssertField('a','integer');
  1760. AssertField('b','integer');
  1761. AssertVisibility('public');
  1762. AssertSaverDeclaration;
  1763. AssertProperty('a','integer',False);
  1764. AssertProperty('b','integer',False);
  1765. AssertEnd;
  1766. AssertImplementation;
  1767. AssertClassComment('Object Implementation','TMyObject');
  1768. AssertSaverImplementationStart('TMyObject');
  1769. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1770. AssertTrue('Have "b" integer property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1771. AssertTrue('end',Pos('end;',NextLine)>0);
  1772. AssertUnitEnd;
  1773. AssertPropertyMap('','TMyObject','','TObject');
  1774. AssertPropertyMap('a','Integer','a','');
  1775. AssertPropertyMap('b','Integer','b','');
  1776. end;
  1777. procedure TTestGenCode.TestSaveStringProperty;
  1778. begin
  1779. Gen.Options:=[jpoGenerateSave];
  1780. GenCode('{ "a" : "1234" }');
  1781. AssertUnitHeader;
  1782. AssertClassHeader('TMyObject','TObject');
  1783. AssertField('a','string');
  1784. AssertVisibility('public');
  1785. AssertSaverDeclaration;
  1786. AssertProperty('a','string',False);
  1787. AssertEnd;
  1788. AssertImplementation;
  1789. AssertClassComment('Object Implementation','TMyObject');
  1790. AssertSaverImplementationStart('TMyObject');
  1791. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1792. AssertTrue('end',Pos('end;',NextLine)>0);
  1793. AssertUnitEnd;
  1794. AssertPropertyMap('','TMyObject','','TObject');
  1795. AssertPropertyMap('a','String','a','');
  1796. end;
  1797. procedure TTestGenCode.TestSaveBooleanProperty;
  1798. begin
  1799. Gen.Options:=[jpoGenerateSave];
  1800. GenCode('{ "a" : true }');
  1801. AssertUnitHeader;
  1802. AssertClassHeader('TMyObject','TObject');
  1803. AssertField('a','Boolean');
  1804. AssertVisibility('public');
  1805. AssertSaverDeclaration;
  1806. AssertProperty('a','Boolean',False);
  1807. AssertEnd;
  1808. AssertImplementation;
  1809. AssertClassComment('Object Implementation','TMyObject');
  1810. AssertSaverImplementationStart('TMyObject');
  1811. AssertTrue('Have "a" boolean property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1812. AssertTrue('end',Pos('end;',NextLine)>0);
  1813. AssertUnitEnd;
  1814. AssertPropertyMap('','TMyObject','','TObject');
  1815. AssertPropertyMap('a','Boolean','a','');
  1816. end;
  1817. procedure TTestGenCode.TestSaveInt64Property;
  1818. begin
  1819. Gen.Options:=[jpoGenerateSave];
  1820. GenCode('{ "a" : 1234567890123 }');
  1821. AssertUnitHeader;
  1822. AssertClassHeader('TMyObject','TObject');
  1823. AssertField('a','Int64');
  1824. AssertVisibility('public');
  1825. AssertSaverDeclaration;
  1826. AssertProperty('a','Int64',False);
  1827. AssertEnd;
  1828. AssertImplementation;
  1829. AssertClassComment('Object Implementation','TMyObject');
  1830. AssertSaverImplementationStart('TMyObject');
  1831. AssertTrue('Have "a" int64 property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1832. AssertTrue('end',Pos('end;',NextLine)>0);
  1833. AssertUnitEnd;
  1834. AssertPropertyMap('','TMyObject','','TObject');
  1835. AssertPropertyMap('a','Int64','a','');
  1836. end;
  1837. procedure TTestGenCode.TestSaveFloatProperty;
  1838. begin
  1839. Gen.Options:=[jpoGenerateSave];
  1840. GenCode('{ "a" : 1.2 }');
  1841. AssertUnitHeader;
  1842. AssertClassHeader('TMyObject','TObject');
  1843. AssertField('a','double');
  1844. AssertVisibility('public');
  1845. AssertSaverDeclaration;
  1846. AssertProperty('a','double',False);
  1847. AssertEnd;
  1848. AssertImplementation;
  1849. AssertClassComment('Object Implementation','TMyObject');
  1850. AssertSaverImplementationStart('TMyObject');
  1851. AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
  1852. AssertTrue('end',Pos('end;',NextLine)>0);
  1853. AssertUnitEnd;
  1854. AssertPropertyMap('','TMyObject','','TObject');
  1855. AssertPropertyMap('a','Double','a','');
  1856. end;
  1857. procedure TTestGenCode.TestSaveObjectProperty;
  1858. begin
  1859. Gen.Options:=[jpoGenerateSave];
  1860. GenCode('{ "a" : { "b" : "abc" } }');
  1861. AssertUnitHeader;
  1862. AssertClassHeader('Ta','TObject');
  1863. AssertField('b','String');
  1864. AssertVisibility('public');
  1865. AssertSaverDeclaration;
  1866. AssertProperty('b','String',False);
  1867. AssertEnd;
  1868. AssertClassHeader('TMyObject','TObject');
  1869. AssertField('a','Ta');
  1870. AssertVisibility('public');
  1871. AssertDestructor;
  1872. AssertSaverDeclaration;
  1873. AssertProperty('a','ta',False);
  1874. AssertEnd;
  1875. AssertImplementation;
  1876. AssertClassComment('Object Implementation','Ta');
  1877. AssertSaverImplementationStart('Ta');
  1878. AssertTrue('Have "b" property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1879. AssertEnd;
  1880. AssertClassComment('Object Implementation','TMyObject');
  1881. AssertDestructorImplementation('TMyObject',['a']);
  1882. AssertSaverImplementationStart('TMyObject');
  1883. AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
  1884. AssertTrue('Have "a" object property save', Pos('AJSON.Add(''a'',a.SaveToJSON);',NextLine)>0);
  1885. AssertEnd;
  1886. AssertUnitEnd;
  1887. AssertPropertyMap('','TMyObject','','TObject');
  1888. AssertPropertyMap('a','Ta','a','TObject');
  1889. end;
  1890. procedure TTestGenCode.TestSaveStringArrayProperty;
  1891. begin
  1892. Gen.Options:=[jpoGenerateSave];
  1893. GenCode('{ "a" : [ "abc" ] }');
  1894. AssertSaveArray('string','');
  1895. end;
  1896. procedure TTestGenCode.TestSaveBooleanArrayProperty;
  1897. begin
  1898. Gen.Options:=[jpoGenerateSave];
  1899. GenCode('{ "a" : [ true ] }');
  1900. AssertSaveArray('boolean','');
  1901. end;
  1902. procedure TTestGenCode.TestSaveIntegerArrayProperty;
  1903. begin
  1904. Gen.Options:=[jpoGenerateSave];
  1905. GenCode('{ "a" : [ 123 ] }');
  1906. AssertSaveArray('Integer','');
  1907. end;
  1908. procedure TTestGenCode.TestSaveInt64ArrayProperty;
  1909. begin
  1910. Gen.Options:=[jpoGenerateSave];
  1911. GenCode('{ "a" : [ 1234567890123 ] }');
  1912. AssertSaveArray('Int64','');
  1913. end;
  1914. procedure TTestGenCode.TestSaveFloatArrayProperty;
  1915. begin
  1916. Gen.Options:=[jpoGenerateSave];
  1917. GenCode('{ "a" : [ 1.23] }');
  1918. AssertSaveArray('Double','');
  1919. end;
  1920. procedure TTestGenCode.TestSaveObjectArrayProperty;
  1921. begin
  1922. Gen.Options:=[jpoGenerateSave];
  1923. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  1924. AssertUnitHeader;
  1925. AssertClassHeader('TaItem','TObject');
  1926. AssertField('b','String');
  1927. AssertVisibility('public');
  1928. AssertSaverDeclaration;
  1929. AssertProperty('b','String',False);
  1930. AssertEnd;
  1931. AssertArrayType('Ta','TaItem');
  1932. AssertArraySaver('Ta','TaItem');
  1933. AssertType;
  1934. AssertClassHeader('TMyObject','TObject');
  1935. AssertField('a','Ta');
  1936. AssertVisibility('public');
  1937. AssertSaverDeclaration;
  1938. AssertProperty('a','ta',False);
  1939. AssertEnd;
  1940. AssertImplementation;
  1941. AssertClassComment('Object Implementation','TaItem');
  1942. AssertSaverImplementationStart('TaItem');
  1943. AssertTrue('Have "b" string property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
  1944. AssertTrue('end',Pos('end;',NextLine)>0);
  1945. AssertArraySaverImplementation('Ta','','TaItem');
  1946. AssertClassComment('Object Implementation','TMyObject');
  1947. AssertSaverImplementationStart('TMyObject');
  1948. AssertTrue('Have "a" array property save', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
  1949. AssertEnd('Loader TMyObject');
  1950. AssertUnitEnd;
  1951. AssertPropertyMap('','TMyObject','','TObject');
  1952. AssertPropertyMap('a','Ta','a','');
  1953. end;
  1954. procedure TTestGenCode.TestSaveDelphiIntegerProperty;
  1955. begin
  1956. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  1957. GenCode('{ "a" : 1234 }');
  1958. AssertUnitHeader;
  1959. AssertClassHeader('TMyObject','TObject');
  1960. AssertField('a','integer');
  1961. AssertVisibility('public');
  1962. AssertSaverDeclaration;
  1963. AssertProperty('a','integer',False);
  1964. AssertEnd;
  1965. AssertImplementation;
  1966. AssertClassComment('Object Implementation','TMyObject');
  1967. AssertSaverImplementationStart('TMyObject');
  1968. AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  1969. AssertTrue('end',Pos('end;',NextLine)>0);
  1970. AssertUnitEnd;
  1971. AssertPropertyMap('','TMyObject','','TObject');
  1972. AssertPropertyMap('a','Integer','a','');
  1973. end;
  1974. procedure TTestGenCode.TestSaveDelphi2IntegersProperty;
  1975. begin
  1976. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  1977. GenCode('{ "a" : 1234, "b" : 5678 }');
  1978. AssertUnitHeader;
  1979. AssertClassHeader('TMyObject','TObject');
  1980. AssertField('a','integer');
  1981. AssertField('b','integer');
  1982. AssertVisibility('public');
  1983. AssertSaverDeclaration;
  1984. AssertProperty('a','integer',False);
  1985. AssertProperty('b','integer',False);
  1986. AssertEnd;
  1987. AssertImplementation;
  1988. AssertClassComment('Object Implementation','TMyObject');
  1989. AssertSaverImplementationStart('TMyObject');
  1990. AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  1991. AssertTrue('Have "b" integer property save', Pos('AJSON.AddPair(''b'',TJSONNumber.Create(b));',NextLine)>0);
  1992. AssertTrue('end',Pos('end;',NextLine)>0);
  1993. AssertUnitEnd;
  1994. AssertPropertyMap('','TMyObject','','TObject');
  1995. AssertPropertyMap('a','Integer','a','');
  1996. AssertPropertyMap('b','Integer','b','');
  1997. end;
  1998. procedure TTestGenCode.TestSaveDelphiStringProperty;
  1999. begin
  2000. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2001. GenCode('{ "a" : "1234" }');
  2002. AssertUnitHeader;
  2003. AssertClassHeader('TMyObject','TObject');
  2004. AssertField('a','string');
  2005. AssertVisibility('public');
  2006. AssertSaverDeclaration;
  2007. AssertProperty('a','string',False);
  2008. AssertEnd;
  2009. AssertImplementation;
  2010. AssertClassComment('Object Implementation','TMyObject');
  2011. AssertSaverImplementationStart('TMyObject');
  2012. AssertTrue('Have "a" string property save', Pos('AJSON.AddPair(''a'',TJSONString.Create(a));',NextLine)>0);
  2013. AssertTrue('end',Pos('end;',NextLine)>0);
  2014. AssertUnitEnd;
  2015. AssertPropertyMap('','TMyObject','','TObject');
  2016. AssertPropertyMap('a','String','a','');
  2017. end;
  2018. procedure TTestGenCode.TestSaveDelphiBooleanProperty;
  2019. begin
  2020. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2021. GenCode('{ "a" : true }');
  2022. AssertUnitHeader;
  2023. AssertClassHeader('TMyObject','TObject');
  2024. AssertField('a','Boolean');
  2025. AssertVisibility('public');
  2026. AssertSaverDeclaration;
  2027. AssertProperty('a','Boolean',False);
  2028. AssertEnd;
  2029. AssertImplementation;
  2030. AssertClassComment('Object Implementation','TMyObject');
  2031. AssertSaverImplementationStart('TMyObject');
  2032. AssertTrue('Have "a" Boolean property save', Pos('AJSON.AddPair(''a'',TJSONBoolean.Create(a));',NextLine)>0);
  2033. AssertTrue('end',Pos('end;',NextLine)>0);
  2034. AssertUnitEnd;
  2035. AssertPropertyMap('','TMyObject','','TObject');
  2036. AssertPropertyMap('a','Boolean','a','');
  2037. end;
  2038. procedure TTestGenCode.TestSaveDelphiInt64Property;
  2039. begin
  2040. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2041. GenCode('{ "a" : 1234567890123 }');
  2042. AssertUnitHeader;
  2043. AssertClassHeader('TMyObject','TObject');
  2044. AssertField('a','Int64');
  2045. AssertVisibility('public');
  2046. AssertSaverDeclaration;
  2047. AssertProperty('a','Int64',False);
  2048. AssertEnd;
  2049. AssertImplementation;
  2050. AssertClassComment('Object Implementation','TMyObject');
  2051. AssertSaverImplementationStart('TMyObject');
  2052. AssertTrue('Have "a" int64 property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
  2053. AssertTrue('end',Pos('end;',NextLine)>0);
  2054. AssertUnitEnd;
  2055. AssertPropertyMap('','TMyObject','','TObject');
  2056. AssertPropertyMap('a','Int64','a','');
  2057. end;
  2058. procedure TTestGenCode.TestSaveDelphiFloatProperty;
  2059. Var
  2060. S : String;
  2061. begin
  2062. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2063. GenCode('{ "a" : 1.2 }');
  2064. AssertUnitHeader;
  2065. AssertClassHeader('TMyObject','TObject');
  2066. AssertField('a','double');
  2067. AssertVisibility('public');
  2068. AssertSaverDeclaration;
  2069. AssertProperty('a','double',False);
  2070. AssertEnd;
  2071. AssertImplementation;
  2072. AssertClassComment('Object Implementation','TMyObject');
  2073. AssertSaverImplementationStart('TMyObject');
  2074. S:=NextLine;
  2075. AssertTrue('Have "a" float property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',S)>0);
  2076. AssertTrue('end',Pos('end;',NextLine)>0);
  2077. AssertUnitEnd;
  2078. AssertPropertyMap('','TMyObject','','TObject');
  2079. AssertPropertyMap('a','Double','a','');
  2080. end;
  2081. procedure TTestGenCode.TestSaveDelphiObjectProperty;
  2082. Var
  2083. S : String;
  2084. begin
  2085. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2086. GenCode('{ "a" : { "b" : "abc" } }');
  2087. AssertUnitHeader;
  2088. AssertClassHeader('Ta','TObject');
  2089. AssertField('b','String');
  2090. AssertVisibility('public');
  2091. AssertSaverDeclaration;
  2092. AssertProperty('b','String',False);
  2093. AssertEnd;
  2094. AssertClassHeader('TMyObject','TObject');
  2095. AssertField('a','Ta');
  2096. AssertVisibility('public');
  2097. AssertDestructor;
  2098. AssertSaverDeclaration;
  2099. AssertProperty('a','ta',False);
  2100. AssertEnd;
  2101. AssertImplementation;
  2102. AssertClassComment('Object Implementation','Ta');
  2103. AssertSaverImplementationStart('Ta');
  2104. AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
  2105. AssertEnd;
  2106. AssertClassComment('Object Implementation','TMyObject');
  2107. AssertDestructorImplementation('TMyObject',['a']);
  2108. AssertSaverImplementationStart('TMyObject');
  2109. AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
  2110. S:=NextLine;
  2111. AssertTrue('Have "a" object property save', Pos('AJSON.AddPair(''a'',a.SaveToJSON);',S)>0);
  2112. AssertEnd;
  2113. AssertUnitEnd;
  2114. AssertPropertyMap('','TMyObject','','TObject');
  2115. AssertPropertyMap('a','Ta','a','TObject');
  2116. end;
  2117. procedure TTestGenCode.TestSaveDelphiStringArrayProperty;
  2118. begin
  2119. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2120. GenCode('{ "a" : [ "abc" ] }');
  2121. AssertSaveArray('string','',True);
  2122. end;
  2123. procedure TTestGenCode.TestSaveDelphiBooleanArrayProperty;
  2124. begin
  2125. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2126. GenCode('{ "a" : [ true ] }');
  2127. AssertSaveArray('boolean','',True);
  2128. end;
  2129. procedure TTestGenCode.TestSaveDelphiIntegerArrayProperty;
  2130. begin
  2131. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2132. GenCode('{ "a" : [ 123 ] }');
  2133. AssertSaveArray('Integer','',True);
  2134. end;
  2135. procedure TTestGenCode.TestSaveDelphiInt64ArrayProperty;
  2136. begin
  2137. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2138. GenCode('{ "a" : [ 1234567890123 ] }');
  2139. AssertSaveArray('Int64','',True);
  2140. end;
  2141. procedure TTestGenCode.TestSaveDelphiFloatArrayProperty;
  2142. begin
  2143. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2144. GenCode('{ "a" : [ 1.23] }');
  2145. AssertSaveArray('Double','',True);
  2146. end;
  2147. procedure TTestGenCode.TestSaveDelphiObjectArrayProperty;
  2148. begin
  2149. Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
  2150. GenCode('{ "a" : [ { "b" : "abc" } ] }');
  2151. AssertUnitHeader;
  2152. AssertClassHeader('TaItem','TObject');
  2153. AssertField('b','String');
  2154. AssertVisibility('public');
  2155. AssertSaverDeclaration;
  2156. AssertProperty('b','String',False);
  2157. AssertEnd;
  2158. AssertArrayType('Ta','TaItem');
  2159. AssertArraySaver('Ta','TaItem',True);
  2160. AssertType;
  2161. AssertClassHeader('TMyObject','TObject');
  2162. AssertField('a','Ta');
  2163. AssertVisibility('public');
  2164. AssertSaverDeclaration;
  2165. AssertProperty('a','ta',False);
  2166. AssertEnd;
  2167. AssertImplementation;
  2168. AssertClassComment('Object Implementation','TaItem');
  2169. AssertSaverImplementationStart('TaItem',True);
  2170. AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
  2171. AssertTrue('end',Pos('end;',NextLine)>0);
  2172. AssertArraySaverImplementation('Ta','','TaItem',True);
  2173. AssertClassComment('Object Implementation','TMyObject');
  2174. AssertSaverImplementationStart('TMyObject');
  2175. AssertTrue('Have "a" array property save', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0);
  2176. AssertEnd('Loader TMyObject');
  2177. AssertUnitEnd;
  2178. AssertPropertyMap('','TMyObject','','TObject');
  2179. AssertPropertyMap('a','Ta','a','');
  2180. end;
  2181. procedure TTestGenCode.TestLoadDelphiStringArrayProperty;
  2182. begin
  2183. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2184. GenCode('{ "a" : [ "abc" ] }');
  2185. AssertLoadArray('string','String',True);
  2186. end;
  2187. procedure TTestGenCode.TestLoadDelphiBooleanArrayProperty;
  2188. begin
  2189. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2190. GenCode('{ "a" : [ true ] }');
  2191. AssertLoadArray('boolean','Boolean',True);
  2192. end;
  2193. procedure TTestGenCode.TestLoadDelphiIntegerArrayProperty;
  2194. begin
  2195. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2196. GenCode('{ "a" : [ 12 ] }');
  2197. AssertLoadArray('integer','Integer',True);
  2198. end;
  2199. procedure TTestGenCode.TestLoadDelphiInt64ArrayProperty;
  2200. begin
  2201. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2202. GenCode('{ "a" : [ 1234567890123 ] }');
  2203. AssertLoadArray('int64','Int64',True);
  2204. end;
  2205. procedure TTestGenCode.TestLoadDelphiFloatArrayProperty;
  2206. begin
  2207. Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
  2208. GenCode('{ "a" : [ 1.1 ] }');
  2209. AssertLoadArray('double','Double',True);
  2210. end;
  2211. initialization
  2212. RegisterTest(TTestGenCode);
  2213. end.