tctstopas.pp 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873
  1. unit tctstopas;
  2. {$mode ObjFPC}{$H+}
  3. { $define dumpsource}
  4. interface
  5. uses
  6. Classes, SysUtils, fpcunit, testregistry, tstopas;
  7. Type
  8. { TTestTSToPas }
  9. TMyTypescriptToPas = class(TTypescriptToPas)
  10. end;
  11. TTestTSToPas = Class(TTestCase)
  12. private
  13. FConverter: TTypescriptToPas;
  14. function GetConversionOptions: TConversionOptions;
  15. procedure SetConversionOptions(AValue: TConversionOptions);
  16. Public
  17. Procedure Setup; override;
  18. procedure TearDown; override;
  19. procedure Convert(aSource : string); overload;
  20. procedure Convert(aSource : Array of String); overload;
  21. procedure Convert(aSource : TStrings); overload;
  22. procedure CheckDeclaration(const aSection, aDeclaration : String);
  23. procedure CheckDeclaration(const aSection, aDeclaration, aDeclaration2 : String);
  24. procedure CheckDeclarations(const aSection : String; Const Declarations : Array of string);
  25. Property Converter : TTypescriptToPas Read FConverter;
  26. Property ConversionOptions : TConversionOptions Read GetConversionOptions Write SetConversionOptions;
  27. Published
  28. Procedure TestEmpty;
  29. Procedure TestVarDeclaration;
  30. Procedure Test2VarDeclarations;
  31. Procedure Test3VarDeclarations;
  32. Procedure TestVarIndirectType;
  33. Procedure TestKeywordVarDeclaration;
  34. Procedure TestSimpleType;
  35. Procedure TestAliasType;
  36. Procedure TestAliasAliasedType;
  37. Procedure TestUnionType;
  38. procedure TestUnionTypeAllStrings;
  39. Procedure TestIntersectionType;
  40. Procedure TestUnionIntersectionType;
  41. Procedure TestEnumType;
  42. Procedure TestArrayType;
  43. Procedure TestTupleType;
  44. Procedure TestTupleTypeForceUntyped;
  45. Procedure TestTupleTypeUnbounded;
  46. Procedure TestTupleTypeForceUntypedUnbounded;
  47. procedure TestTupleTypeUnequalTypes;
  48. procedure TestTupleTypeUnequalTypesUnbounded;
  49. Procedure TestFunctionType;
  50. Procedure TestFunctionTypeWithArg;
  51. Procedure TestFunctionTypeWithReturn;
  52. procedure TestFunctionTypeWithTupleReturn;
  53. Procedure TestFunctionTypeWithReturnNoArgs;
  54. Procedure TestFunctionTypeArrayType;
  55. Procedure TestFunctionTypeArrayTypeObj;
  56. Procedure TestFunctionTypeArrayTypeArray;
  57. Procedure TestFunctionCallbackArg;
  58. Procedure TestFunctionCallbackArgRecursive;
  59. Procedure TestSimpleFunction;
  60. Procedure TestSimpleFunctionKeyword;
  61. Procedure TestExportSimpleFunction;
  62. Procedure TestFunctionSimpleResult;
  63. Procedure TestFunctionTypeRefResult;
  64. procedure TestFunctionOneArg;
  65. procedure TestFunctionOneArgUntyped;
  66. procedure TestFunctionTwoArgs;
  67. Procedure TestFunctionFunctionResult;
  68. Procedure TestOverloadedProcedures;
  69. Procedure TestUnionProcedures;
  70. Procedure TestIndirectUnionProcedures;
  71. Procedure TestUniqueOverloadedProcedures;
  72. Procedure TestEmptyNameSpace;
  73. Procedure TestEmptyNameSpaceFunction;
  74. Procedure TestExportInterface;
  75. Procedure TestExportInterfaceAsClass;
  76. Procedure TestExportInterfaceWithPropertiesAsClass;
  77. Procedure TestExportInterfacePropertyCallbackArgRecursive;
  78. Procedure TestInterfaceNamedFunction;
  79. Procedure TestInterfaceNamedFunctionCallback;
  80. Procedure TestObjectEmpty;
  81. procedure TestObjectOneProperty;
  82. procedure TestObjectOneReadOnlyProperty;
  83. procedure TestObjectOneReadOnlyPropertyKeyword;
  84. procedure TestClassOnePrivateProperty;
  85. procedure TestClassOneMethod;
  86. Procedure TestClassOneMethodKeyword;
  87. procedure TestClassOneConstructor;
  88. procedure TestClassPropertyArrayType;
  89. procedure TestClassPropertyObjectType;
  90. procedure TestClassPropertyObjectTypeRecursive;
  91. procedure TestClassMethodOneCallback;
  92. procedure TestClassMethodCallBackArrayTuple;
  93. procedure TestClassMethodTupleReturn;
  94. procedure TestClassMethodOneCallbackLocalArgTypes;
  95. procedure TestNameSpaceClassLocalType;
  96. end;
  97. implementation
  98. { TTestTSToPas }
  99. function TTestTSToPas.GetConversionOptions: TConversionOptions;
  100. begin
  101. Result:=FConverter.Options;
  102. end;
  103. procedure TTestTSToPas.SetConversionOptions(AValue: TConversionOptions);
  104. begin
  105. FConverter.Options:=aValue;
  106. end;
  107. procedure TTestTSToPas.Setup;
  108. begin
  109. inherited Setup;
  110. FConverter:=TMyTypescriptToPas.Create(Nil);
  111. FConverter.Options:=FConverter.Options+[coRaw];
  112. end;
  113. procedure TTestTSToPas.TearDown;
  114. begin
  115. FreeAndNil(FConverter);
  116. inherited TearDown;
  117. end;
  118. procedure TTestTSToPas.Convert(aSource: string);
  119. begin
  120. Convert([aSource]);
  121. end;
  122. procedure TTestTSToPas.Convert(aSource: array of String);
  123. Var
  124. aSrc : TStrings;
  125. begin
  126. aSrc:=TStringList.Create;
  127. try
  128. TStringList(aSrc).SkipLastLineBreak:=True;
  129. aSrc.AddStrings(aSource);
  130. {$IFDEF dumpsource}
  131. if IsConsole then
  132. begin
  133. Writeln('--');
  134. Writeln(aSrc.Text);
  135. Writeln('--');
  136. end;
  137. {$ENDIF dumpsource}
  138. Convert(aSrc);
  139. finally
  140. aSrc.Free;
  141. end;
  142. end;
  143. procedure TTestTSToPas.Convert(aSource: TStrings);
  144. Var
  145. S : TStream;
  146. begin
  147. S:=TStringStream.Create(aSource.Text);
  148. try
  149. FConverter.InputStream:=S;
  150. FConverter.Execute;
  151. finally
  152. S.Free;
  153. end;
  154. end;
  155. procedure TTestTSToPas.CheckDeclaration(const aSection, aDeclaration: String);
  156. begin
  157. CheckDeclarations(aSection,[aDeclaration]);
  158. end;
  159. procedure TTestTSToPas.CheckDeclaration(const aSection, aDeclaration, aDeclaration2: String);
  160. begin
  161. CheckDeclarations(aSection,[aDeclaration,aDeclaration2]);
  162. end;
  163. procedure TTestTSToPas.CheckDeclarations(const aSection: String; const Declarations: array of string);
  164. Var
  165. Src : TStrings;
  166. I,J : Integer;
  167. D,S,actSrc : String;
  168. begin
  169. Src:=FConverter.Source;
  170. {$IFDEF dumpsource}
  171. if IsConsole then
  172. begin
  173. Writeln('>>>');
  174. Writeln(Src.Text);
  175. Writeln('<<<');
  176. end;
  177. {$ENDIF dumpsource}
  178. I:=0;
  179. While (I<Src.Count) and (Trim(Src[i])='') do
  180. Inc(I);
  181. if aSection<>'' then
  182. begin
  183. AssertTrue('Section: Not at end',I<Src.Count);
  184. AssertEquals('Section correct',LowerCase(aSection),LowerCase(Trim(Src[i])));
  185. Inc(I);
  186. end;
  187. For J:=0 to Length(Declarations)-1 do
  188. begin
  189. D:=Format('Declaration %d: ',[J]);
  190. S:=Declarations[J];
  191. While (I<Src.Count) and (Trim(Src[i])='') do
  192. Inc(I);
  193. AssertTrue(D+'Not at end',I<Src.Count);
  194. actSrc:=Src[i];
  195. AssertEquals(D+'Declaration correct',LowerCase(S),LowerCase(Trim(actSrc)));
  196. Inc(I);
  197. end;
  198. end;
  199. procedure TTestTSToPas.TestEmpty;
  200. begin
  201. AssertNotNull(Converter);
  202. end;
  203. procedure TTestTSToPas.TestVarDeclaration;
  204. begin
  205. Convert('declare var x : number;');
  206. CheckDeclaration('var','x : double; external name ''x'';');
  207. end;
  208. procedure TTestTSToPas.Test2VarDeclarations;
  209. begin
  210. Convert('declare var x,y : number;');
  211. CheckDeclaration('var','x : double; external name ''x'';','y : double; external name ''y'';');
  212. end;
  213. procedure TTestTSToPas.Test3VarDeclarations;
  214. begin
  215. Convert('declare var x,y,z : number;');
  216. CheckDeclarations('var',['x : double; external name ''x'';','y : double; external name ''y'';','z : double; external name ''z'';']);
  217. end;
  218. procedure TTestTSToPas.TestVarIndirectType;
  219. begin
  220. Convert('declare var a : { b : string;};');
  221. CheckDeclarations('type',[
  222. 'TA = class external name ''Object'' (TJSObject)',
  223. 'public',
  224. 'b : string;',
  225. 'end;',
  226. 'var',
  227. 'a : ta; external name ''a'';']);
  228. end;
  229. procedure TTestTSToPas.TestKeywordVarDeclaration;
  230. begin
  231. Convert('declare var on : string;');
  232. CheckDeclarations('var',['&on : string; external name ''on'';']);
  233. end;
  234. procedure TTestTSToPas.TestSimpleType;
  235. begin
  236. Convert('declare type MyType = string;');
  237. CheckDeclarations('type',['TMyType = string;']);
  238. end;
  239. procedure TTestTSToPas.TestAliasType;
  240. begin
  241. Convert('declare type MyType = SomeOtherType;');
  242. CheckDeclarations('type',['TMyType = SomeOtherType;']);
  243. end;
  244. procedure TTestTSToPas.TestAliasAliasedType;
  245. begin
  246. Converter.TypeAliases.Add('SomeOtherType=TMyOther');
  247. Convert('declare type MyType = SomeOtherType;');
  248. CheckDeclarations('type',['TMyType = TMyOther;']);
  249. end;
  250. procedure TTestTSToPas.TestUnionType;
  251. begin
  252. Convert('declare type MyType = string | number;');
  253. CheckDeclarations('type',['TMyType = JSValue; // string | number']);
  254. end;
  255. procedure TTestTSToPas.TestUnionTypeAllStrings;
  256. begin
  257. Convert('declare type MyType = ''string'' | ''number'';');
  258. CheckDeclarations('type',['TMyType = string; // Restricted values']);
  259. end;
  260. procedure TTestTSToPas.TestIntersectionType;
  261. begin
  262. Convert('declare type MyType = string & number;');
  263. CheckDeclarations('type',['TMyType = JSValue; // string & number']);
  264. end;
  265. procedure TTestTSToPas.TestUnionIntersectionType;
  266. begin
  267. Convert('declare type MyType = number | (string & number) ;');
  268. CheckDeclarations('type',['TMyType = JSValue; // number | (string & number)']);
  269. end;
  270. procedure TTestTSToPas.TestEnumType;
  271. begin
  272. Convert('declare enum Color {Red, Green, Blue} ;');
  273. CheckDeclarations('type',['TColor = (Red, Green, Blue);']);
  274. end;
  275. procedure TTestTSToPas.TestArrayType;
  276. begin
  277. Convert('declare type A = number[];');
  278. CheckDeclarations('type',['TA = array of Double;']);
  279. end;
  280. procedure TTestTSToPas.TestTupleType;
  281. begin
  282. Convert('declare type A = [number,number];');
  283. CheckDeclarations('type',['TA = array[0..1] of Double;']);
  284. end;
  285. procedure TTestTSToPas.TestTupleTypeForceUntyped;
  286. begin
  287. ConversionOptions:=ConversionOptions+[coUntypedTuples];
  288. Convert('declare type A = [number,number];');
  289. CheckDeclarations('type',['TA = array[0..1] of jsValue;']);
  290. end;
  291. procedure TTestTSToPas.TestTupleTypeUnbounded;
  292. begin
  293. ConversionOptions:=ConversionOptions+[coDynamicTuples];
  294. Convert('declare type A = [number,number];');
  295. CheckDeclarations('type',['TA = array of double;']);
  296. end;
  297. procedure TTestTSToPas.TestTupleTypeForceUntypedUnbounded;
  298. begin
  299. ConversionOptions:=ConversionOptions+[coDynamicTuples,coUntypedTuples];
  300. Convert('declare type A = [number,number];');
  301. CheckDeclarations('type',['TA = tjsvaluedynarray;']);
  302. end;
  303. procedure TTestTSToPas.TestTupleTypeUnequalTypes;
  304. begin
  305. Convert('declare type A = [number,string];');
  306. CheckDeclarations('type',['TA = array[0..1] of jsvalue;']);
  307. end;
  308. procedure TTestTSToPas.TestTupleTypeUnequalTypesUnbounded;
  309. begin
  310. ConversionOptions:=ConversionOptions+[coDynamicTuples];
  311. Convert('declare type A = [number,string];');
  312. CheckDeclarations('type',['TA = tjsvaluedynarray;']);
  313. end;
  314. procedure TTestTSToPas.TestFunctionType;
  315. begin
  316. Convert('declare type A = () => void;');
  317. CheckDeclarations('type',['TA = procedure;']);
  318. end;
  319. procedure TTestTSToPas.TestFunctionTypeWithArg;
  320. begin
  321. Convert('declare type A = (B : string) => void;');
  322. CheckDeclarations('type',['TA = procedure (B : string);']);
  323. end;
  324. procedure TTestTSToPas.TestFunctionTypeWithReturn;
  325. begin
  326. Convert('declare type A = (B : string) => number;');
  327. CheckDeclarations('type',['TA = function (B : string): Double;']);
  328. end;
  329. procedure TTestTSToPas.TestFunctionTypeWithTupleReturn;
  330. begin
  331. Convert('declare type A = (B : string) => [number,number];');
  332. CheckDeclarations('type',[
  333. 'TTA_Result = array[0..1] of double;',
  334. 'TA = function (B : string): TTA_Result;'
  335. ]);
  336. end;
  337. procedure TTestTSToPas.TestFunctionTypeWithReturnNoArgs;
  338. begin
  339. Convert('declare type A = () => number;');
  340. CheckDeclarations('type',['TA = function: Double;']);
  341. end;
  342. procedure TTestTSToPas.TestFunctionTypeArrayType;
  343. begin
  344. Convert('declare type A = (B : string[]) => void;');
  345. CheckDeclarations('type',['TA = procedure (B : array of string);']);
  346. end;
  347. procedure TTestTSToPas.TestFunctionTypeArrayTypeObj;
  348. begin
  349. Convert('declare function b (a : Array<{}>): string;');
  350. CheckDeclarations('type',[
  351. 'tb_a_item = class external name ''Object'' (TJSObject)',
  352. 'end;',
  353. 'tb_a = array of tb_a_item;',
  354. 'function b(a : Tb_a): string; external name ''b'';'
  355. ]);
  356. end;
  357. procedure TTestTSToPas.TestFunctionTypeArrayTypeArray;
  358. begin
  359. Convert('declare function a(b: string[][]): void;');
  360. CheckDeclarations('type',[
  361. 'ta_b_item = array of string;',
  362. 'ta_b = array of ta_b_item;',
  363. 'Procedure a(b : Ta_b); external name ''a'';'
  364. ]);
  365. end;
  366. procedure TTestTSToPas.TestFunctionCallbackArg;
  367. begin
  368. Convert('declare function b (para1 : (a: number) => string) : string;');
  369. CheckDeclarations('type',[
  370. 'tb_para1 = function (a : double): string;',
  371. 'function b(para1 : Tb_para1): string; external name ''b'';'
  372. ]);
  373. end;
  374. procedure TTestTSToPas.TestFunctionCallbackArgRecursive;
  375. begin
  376. Convert('declare function b (para1 : (a: (c: string) =>void) => string) : string;');
  377. CheckDeclarations('type',[
  378. 'tb_para1_a = procedure (c : string);',
  379. 'tb_para1 = function (a : tb_para1_a): string;',
  380. 'function b(para1 : Tb_para1): string; external name ''b'';'
  381. ]);
  382. end;
  383. procedure TTestTSToPas.TestSimpleFunction;
  384. begin
  385. Convert('declare function A() : void;');
  386. CheckDeclarations('',['Procedure A; external name ''a'';']);
  387. end;
  388. procedure TTestTSToPas.TestSimpleFunctionKeyword;
  389. begin
  390. Convert('declare function on() : void;');
  391. CheckDeclarations('',['Procedure &on; external name ''on'';']);
  392. end;
  393. procedure TTestTSToPas.TestExportSimpleFunction;
  394. begin
  395. Convert('export function A() : void;');
  396. CheckDeclarations('',['Procedure A; external name ''A'';']);
  397. end;
  398. procedure TTestTSToPas.TestFunctionSimpleResult;
  399. begin
  400. Convert('declare function A() : number;');
  401. CheckDeclarations('',['function A: double; external name ''A'';']);
  402. end;
  403. procedure TTestTSToPas.TestFunctionTypeRefResult;
  404. begin
  405. Convert(['declare type B = number;','declare function A() : B;']);
  406. CheckDeclarations('type',['TB = double;','function A: TB; external name ''A'';']);
  407. end;
  408. procedure TTestTSToPas.TestFunctionOneArg;
  409. begin
  410. Convert('declare function A(b : string) : void;');
  411. CheckDeclarations('',['procedure A(b : string); external name ''A'';']);
  412. end;
  413. procedure TTestTSToPas.TestFunctionOneArgUntyped;
  414. begin
  415. Convert('declare function A(b) : void;');
  416. CheckDeclarations('',['procedure A(b : jsvalue); external name ''A'';']);
  417. end;
  418. procedure TTestTSToPas.TestFunctionTwoArgs;
  419. begin
  420. Convert('declare function A(b : string, c : number) : void;');
  421. CheckDeclarations('',['procedure A(b : string; c : double); external name ''A'';']);
  422. end;
  423. procedure TTestTSToPas.TestFunctionFunctionResult;
  424. begin
  425. convert('declare class A { b(): (c: { d : any }) => void; }');
  426. CheckDeclarations('Type',[
  427. '// Forward class definitions',
  428. 'ta = class;',
  429. 'ta_b_result_c = class external name ''object'' (TJSObject)',
  430. 'public',
  431. 'd : jsvalue;',
  432. 'end;',
  433. 'ta_b_result = procedure (c : ta_b_result_c);',
  434. 'ta = class external name ''A'' (TJSObject)',
  435. 'public',
  436. 'function b: ta_b_result;',
  437. 'end;'
  438. ])
  439. end;
  440. procedure TTestTSToPas.TestOverloadedProcedures;
  441. begin
  442. Convert(['declare function A() : void;','declare function A(b : string) : void;']);
  443. CheckDeclarations('',[
  444. 'procedure A; external name ''A''; overload;',
  445. 'procedure A(b : string); external name ''A''; overload;']);
  446. end;
  447. procedure TTestTSToPas.TestUnionProcedures;
  448. begin
  449. Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
  450. Convert(['declare function A(b: number | string) : void;']);
  451. CheckDeclarations('',[
  452. 'procedure A(b : double); external name ''A''; overload;',
  453. 'procedure A(b : string); external name ''A''; overload;']);
  454. end;
  455. procedure TTestTSToPas.TestIndirectUnionProcedures;
  456. begin
  457. Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
  458. Convert(['declare type U = number | string;','declare function A(b: U) : void;']);
  459. CheckDeclarations('type',[
  460. 'TU = JSValue; // number | string',
  461. 'procedure A(b : double); external name ''A''; overload;',
  462. 'procedure A(b : string); external name ''A''; overload;'
  463. ]);
  464. end;
  465. procedure TTestTSToPas.TestUniqueOverloadedProcedures;
  466. begin
  467. Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
  468. Convert(['declare function A(b: number) : void;','declare function A(b: number | string) : void;']);
  469. CheckDeclarations('',[
  470. 'procedure A(b : double); external name ''A''; overload;',
  471. 'procedure A(b : string); external name ''A''; overload;'
  472. ]);
  473. end;
  474. procedure TTestTSToPas.TestEmptyNameSpace;
  475. begin
  476. Convert(['declare namespace A { };']);
  477. CheckDeclarations('type',['// forward class definitions',
  478. 'TA = Class;',
  479. '// Namespaces',
  480. 'TA = class external name ''A'' (TJSObject)',
  481. 'Public',
  482. 'end;']);
  483. end;
  484. procedure TTestTSToPas.TestEmptyNameSpaceFunction;
  485. begin
  486. Convert(['declare namespace A { ',
  487. ' function B() : void;',
  488. '}']);
  489. CheckDeclarations('type',['// forward class definitions',
  490. 'TA = Class;',
  491. '// Namespaces',
  492. 'TA = class external name ''A'' (TJSObject)',
  493. 'Public',
  494. 'procedure B;',
  495. 'end;']);
  496. end;
  497. procedure TTestTSToPas.TestExportInterface;
  498. begin
  499. Convert('declare interface Color { b () : string; } ;');
  500. CheckDeclarations('type',[
  501. '// Forward class definitions',
  502. 'TColor = interface;',
  503. 'TColor = interface',
  504. 'function b: string;',
  505. 'end;']
  506. );
  507. end;
  508. procedure TTestTSToPas.TestExportInterfaceAsClass;
  509. begin
  510. ConversionOptions:=ConversionOptions+[coInterfaceAsClass];
  511. Convert('declare interface Color { b () : string; } ;');
  512. CheckDeclarations('type',[
  513. '// Forward class definitions',
  514. 'TColor = class;',
  515. 'TColor = class external name ''object'' (TJSObject)',
  516. 'function b: string;',
  517. 'end;']
  518. );
  519. end;
  520. procedure TTestTSToPas.TestExportInterfaceWithPropertiesAsClass;
  521. begin
  522. Convert('declare interface Color { b : string; } ;');
  523. CheckDeclarations('type',[
  524. '// Forward class definitions',
  525. 'TColor = class;',
  526. 'TColor = class external name ''object'' (TJSObject)',
  527. 'b : string;',
  528. 'end;']
  529. );
  530. end;
  531. procedure TTestTSToPas.TestExportInterfacePropertyCallbackArgRecursive;
  532. begin
  533. Convert('declare interface A { b?: (c: (d: Boolean) => void) => void; }');
  534. CheckDeclarations('type',[
  535. '// Forward class definitions',
  536. 'TA = class;',
  537. 'tA_b_c = procedure (d : boolean);',
  538. 'tA_b = procedure (c : tA_b_c);',
  539. 'TA = class external name ''object'' (TJSObject)',
  540. 'b : TA_b;',
  541. 'end;']
  542. );
  543. end;
  544. procedure TTestTSToPas.TestInterfaceNamedFunction;
  545. begin
  546. Convert('declare interface a { (b : String, c: string): number; }');
  547. CheckDeclarations('type',[
  548. // '// Forward class definitions',
  549. 'TA = function (B : String; C : string): double;'
  550. ]);
  551. end;
  552. procedure TTestTSToPas.TestInterfaceNamedFunctionCallback;
  553. begin
  554. Convert('declare interface a { (b : (c: string) => void): number; }');
  555. CheckDeclarations('type',[
  556. 'Ta__b = procedure (c : string);',
  557. 'TA = function (B : TA__b): double;'
  558. ]);
  559. end;
  560. procedure TTestTSToPas.TestObjectEmpty;
  561. begin
  562. Convert('declare type A = { }');
  563. CheckDeclarations('type',[
  564. '// Forward class definitions',
  565. 'TA = class;',
  566. 'TA = class external name ''Object'' (TJSObject)',
  567. 'end;']);
  568. end;
  569. procedure TTestTSToPas.TestObjectOneProperty;
  570. begin
  571. Convert('declare type A = { prop : string; }');
  572. CheckDeclarations('type',[
  573. '// Forward class definitions',
  574. 'TA = class;',
  575. 'TA = class external name ''Object'' (TJSObject)',
  576. 'Public',
  577. 'prop : string;',
  578. 'end;']);
  579. end;
  580. procedure TTestTSToPas.TestClassOnePrivateProperty;
  581. begin
  582. Convert('declare class A { private prop : string; }');
  583. CheckDeclarations('type',[
  584. '// Forward class definitions',
  585. 'TA = class;',
  586. 'TA = class external name ''A'' (TJSObject)',
  587. 'Private',
  588. 'prop : string;',
  589. 'end;']);
  590. end;
  591. procedure TTestTSToPas.TestClassOneMethod;
  592. begin
  593. Convert(' export class A { b (c: string) : void; }');
  594. CheckDeclarations('type',[
  595. '// Forward class definitions',
  596. 'TA = class;',
  597. 'TA = class external name ''A'' (TJSObject)',
  598. 'public',
  599. 'procedure b(c : string);',
  600. 'end;']);
  601. end;
  602. procedure TTestTSToPas.TestClassOneMethodKeyword;
  603. begin
  604. Convert(' export class A { to() : void; }');
  605. CheckDeclarations('type',[
  606. '// Forward class definitions',
  607. 'TA = class;',
  608. 'TA = class external name ''A'' (TJSObject)',
  609. 'public',
  610. 'procedure &to;',
  611. 'end;']);
  612. end;
  613. procedure TTestTSToPas.TestClassOneConstructor;
  614. begin
  615. Convert(' export class A { constructor (c: string) : void; }');
  616. CheckDeclarations('type',[
  617. '// Forward class definitions',
  618. 'TA = class;',
  619. 'TA = class external name ''A'' (TJSObject)',
  620. 'public',
  621. 'constructor new(c : string);',
  622. 'end;']);
  623. end;
  624. procedure TTestTSToPas.TestClassPropertyArrayType;
  625. begin
  626. Convert(' export class A { b : string[] ; }');
  627. CheckDeclarations('type',[
  628. '// Forward class definitions',
  629. 'TA = class;',
  630. 'tA_b = array of string;',
  631. 'TA = class external name ''A'' (TJSObject)',
  632. 'public',
  633. 'b : TA_b;',
  634. 'end;']);
  635. end;
  636. procedure TTestTSToPas.TestClassPropertyObjectType;
  637. begin
  638. Convert('declare interface A { B: { C : number; }; }');
  639. CheckDeclarations('type',[
  640. '// Forward class definitions',
  641. 'TA = class;',
  642. 'TA_b = class external name ''Object'' (TJSObject)',
  643. 'public',
  644. 'c : double;',
  645. 'end;',
  646. 'TA = class external name ''object'' (TJSObject)',
  647. 'b : TA_B;',
  648. 'end;']);
  649. end;
  650. procedure TTestTSToPas.TestClassPropertyObjectTypeRecursive;
  651. begin
  652. Convert('declare interface A { B: { C: { D : number; }; }; }');
  653. CheckDeclarations('type',[
  654. '// Forward class definitions',
  655. 'TA = class;',
  656. 'TA_b_c = class external name ''Object'' (TJSObject)',
  657. 'public',
  658. 'd : double;',
  659. 'end;',
  660. 'TA_b = class external name ''Object'' (TJSObject)',
  661. 'public',
  662. 'c : Ta_b_c;',
  663. 'end;',
  664. 'TA = class external name ''Object'' (TJSObject)',
  665. 'b : TA_B;',
  666. 'end;']);
  667. end;
  668. procedure TTestTSToPas.TestClassMethodOneCallback;
  669. begin
  670. Convert(' export class A { b (c: (d : number) => string) : void; }');
  671. CheckDeclarations('type',[
  672. '// Forward class definitions',
  673. 'TA = class;',
  674. 'tA_b_c = function (d : double): string;',
  675. 'TA = class external name ''A'' (TJSObject)',
  676. 'public',
  677. 'procedure b(c : TA_b_c);',
  678. 'end;']);
  679. end;
  680. procedure TTestTSToPas.TestClassMethodCallBackArrayTuple;
  681. begin
  682. Convert('declare class A { b() : [number, number][]; }');
  683. CheckDeclarations('type',[
  684. '// Forward class definitions',
  685. 'TA = class;',
  686. 'TA_b_Result_Item = array[0..1] of double;',
  687. 'tA_b_Result = array of TA_b_Result_Item;',
  688. 'TA = class external name ''A'' (TJSObject)',
  689. 'public',
  690. 'function b: tA_b_Result;',
  691. 'end;']);
  692. end;
  693. procedure TTestTSToPas.TestClassMethodTupleReturn;
  694. begin
  695. Convert(' export class A { b () : [number, number]; }');
  696. CheckDeclarations('type',[
  697. '// Forward class definitions',
  698. 'TA = class;',
  699. 'tA_b_Result = array[0..1] of double;',
  700. 'TA = class external name ''A'' (TJSObject)',
  701. 'public',
  702. 'function b: tA_b_Result;',
  703. 'end;']);
  704. end;
  705. procedure TTestTSToPas.TestClassMethodOneCallbackLocalArgTypes;
  706. begin
  707. ConversionOptions:=ConversionOptions+[coLocalArgumentTypes];
  708. Convert(' export class A { b (c: (d : number) => string) : void; }');
  709. CheckDeclarations('type',[
  710. '// Forward class definitions',
  711. 'TA = class;',
  712. 'TA = class external name ''A'' (TJSObject)',
  713. 'public',
  714. 'Type',
  715. 'tb_c = function (d : double): string;',
  716. 'public',
  717. 'procedure b(c : Tb_c);',
  718. 'end;']);
  719. end;
  720. procedure TTestTSToPas.TestNameSpaceClassLocalType;
  721. begin
  722. Convert('declare module "a" { class b { c(d : string): string[]; }; }');
  723. CheckDeclarations('type',[
  724. '// Forward class definitions',
  725. 'TA = class;',
  726. '// Modules',
  727. 'TA = class external name ''a'' (TJSObject)',
  728. 'Public',
  729. 'Type',
  730. '// Forward class definitions',
  731. 'TB = class;',
  732. 'TB_c_Result = Array of string;',
  733. 'TB = class external name ''b'' (TJSObject)',
  734. 'Public',
  735. 'function c(d : string): TB_c_Result;',
  736. 'end;'
  737. ])
  738. end;
  739. procedure TTestTSToPas.TestObjectOneReadOnlyProperty;
  740. begin
  741. Convert('declare type A = { readonly prop : string; }');
  742. CheckDeclarations('type',[
  743. '// Forward class definitions',
  744. 'TA = class;',
  745. 'TA = class external name ''Object'' (TJSObject)',
  746. 'Private',
  747. 'FProp : String; external name ''prop'';',
  748. 'Public',
  749. 'Property prop : string read FProp;',
  750. 'end;']);
  751. end;
  752. procedure TTestTSToPas.TestObjectOneReadOnlyPropertyKeyword;
  753. begin
  754. Convert('declare type A = { readonly on : string; }');
  755. CheckDeclarations('type',[
  756. '// Forward class definitions',
  757. 'TA = class;',
  758. 'TA = class external name ''Object'' (TJSObject)',
  759. 'Private',
  760. 'FOn : String; external name ''on'';',
  761. 'Public',
  762. 'Property on : string read FOn;',
  763. 'end;']);
  764. end;
  765. Initialization
  766. Registertest(TTestTSToPas);
  767. end.