123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873 |
- unit tctstopas;
- {$mode ObjFPC}{$H+}
- { $define dumpsource}
- interface
- uses
- Classes, SysUtils, fpcunit, testregistry, tstopas;
- Type
- { TTestTSToPas }
- TMyTypescriptToPas = class(TTypescriptToPas)
- end;
- TTestTSToPas = Class(TTestCase)
- private
- FConverter: TTypescriptToPas;
- function GetConversionOptions: TConversionOptions;
- procedure SetConversionOptions(AValue: TConversionOptions);
- Public
- Procedure Setup; override;
- procedure TearDown; override;
- procedure Convert(aSource : string); overload;
- procedure Convert(aSource : Array of String); overload;
- procedure Convert(aSource : TStrings); overload;
- procedure CheckDeclaration(const aSection, aDeclaration : String);
- procedure CheckDeclaration(const aSection, aDeclaration, aDeclaration2 : String);
- procedure CheckDeclarations(const aSection : String; Const Declarations : Array of string);
- Property Converter : TTypescriptToPas Read FConverter;
- Property ConversionOptions : TConversionOptions Read GetConversionOptions Write SetConversionOptions;
- Published
- Procedure TestEmpty;
- Procedure TestVarDeclaration;
- Procedure Test2VarDeclarations;
- Procedure Test3VarDeclarations;
- Procedure TestVarIndirectType;
- Procedure TestKeywordVarDeclaration;
- Procedure TestSimpleType;
- Procedure TestAliasType;
- Procedure TestAliasAliasedType;
- Procedure TestUnionType;
- procedure TestUnionTypeAllStrings;
- Procedure TestIntersectionType;
- Procedure TestUnionIntersectionType;
- Procedure TestEnumType;
- Procedure TestArrayType;
- Procedure TestTupleType;
- Procedure TestTupleTypeForceUntyped;
- Procedure TestTupleTypeUnbounded;
- Procedure TestTupleTypeForceUntypedUnbounded;
- procedure TestTupleTypeUnequalTypes;
- procedure TestTupleTypeUnequalTypesUnbounded;
- Procedure TestFunctionType;
- Procedure TestFunctionTypeWithArg;
- Procedure TestFunctionTypeWithReturn;
- procedure TestFunctionTypeWithTupleReturn;
- Procedure TestFunctionTypeWithReturnNoArgs;
- Procedure TestFunctionTypeArrayType;
- Procedure TestFunctionTypeArrayTypeObj;
- Procedure TestFunctionTypeArrayTypeArray;
- Procedure TestFunctionCallbackArg;
- Procedure TestFunctionCallbackArgRecursive;
- Procedure TestSimpleFunction;
- Procedure TestSimpleFunctionKeyword;
- Procedure TestExportSimpleFunction;
- Procedure TestFunctionSimpleResult;
- Procedure TestFunctionTypeRefResult;
- procedure TestFunctionOneArg;
- procedure TestFunctionOneArgUntyped;
- procedure TestFunctionTwoArgs;
- Procedure TestFunctionFunctionResult;
- Procedure TestOverloadedProcedures;
- Procedure TestUnionProcedures;
- Procedure TestIndirectUnionProcedures;
- Procedure TestUniqueOverloadedProcedures;
- Procedure TestEmptyNameSpace;
- Procedure TestEmptyNameSpaceFunction;
- Procedure TestExportInterface;
- Procedure TestExportInterfaceAsClass;
- Procedure TestExportInterfaceWithPropertiesAsClass;
- Procedure TestExportInterfacePropertyCallbackArgRecursive;
- Procedure TestInterfaceNamedFunction;
- Procedure TestInterfaceNamedFunctionCallback;
- Procedure TestObjectEmpty;
- procedure TestObjectOneProperty;
- procedure TestObjectOneReadOnlyProperty;
- procedure TestObjectOneReadOnlyPropertyKeyword;
- procedure TestClassOnePrivateProperty;
- procedure TestClassOneMethod;
- Procedure TestClassOneMethodKeyword;
- procedure TestClassOneConstructor;
- procedure TestClassPropertyArrayType;
- procedure TestClassPropertyObjectType;
- procedure TestClassPropertyObjectTypeRecursive;
- procedure TestClassMethodOneCallback;
- procedure TestClassMethodCallBackArrayTuple;
- procedure TestClassMethodTupleReturn;
- procedure TestClassMethodOneCallbackLocalArgTypes;
- procedure TestNameSpaceClassLocalType;
- end;
- implementation
- { TTestTSToPas }
- function TTestTSToPas.GetConversionOptions: TConversionOptions;
- begin
- Result:=FConverter.Options;
- end;
- procedure TTestTSToPas.SetConversionOptions(AValue: TConversionOptions);
- begin
- FConverter.Options:=aValue;
- end;
- procedure TTestTSToPas.Setup;
- begin
- inherited Setup;
- FConverter:=TMyTypescriptToPas.Create(Nil);
- FConverter.Options:=FConverter.Options+[coRaw];
- end;
- procedure TTestTSToPas.TearDown;
- begin
- FreeAndNil(FConverter);
- inherited TearDown;
- end;
- procedure TTestTSToPas.Convert(aSource: string);
- begin
- Convert([aSource]);
- end;
- procedure TTestTSToPas.Convert(aSource: array of String);
- Var
- aSrc : TStrings;
- begin
- aSrc:=TStringList.Create;
- try
- TStringList(aSrc).SkipLastLineBreak:=True;
- aSrc.AddStrings(aSource);
- {$IFDEF dumpsource}
- if IsConsole then
- begin
- Writeln('--');
- Writeln(aSrc.Text);
- Writeln('--');
- end;
- {$ENDIF dumpsource}
- Convert(aSrc);
- finally
- aSrc.Free;
- end;
- end;
- procedure TTestTSToPas.Convert(aSource: TStrings);
- Var
- S : TStream;
- begin
- S:=TStringStream.Create(aSource.Text);
- try
- FConverter.InputStream:=S;
- FConverter.Execute;
- finally
- S.Free;
- end;
- end;
- procedure TTestTSToPas.CheckDeclaration(const aSection, aDeclaration: String);
- begin
- CheckDeclarations(aSection,[aDeclaration]);
- end;
- procedure TTestTSToPas.CheckDeclaration(const aSection, aDeclaration, aDeclaration2: String);
- begin
- CheckDeclarations(aSection,[aDeclaration,aDeclaration2]);
- end;
- procedure TTestTSToPas.CheckDeclarations(const aSection: String; const Declarations: array of string);
- Var
- Src : TStrings;
- I,J : Integer;
- D,S,actSrc : String;
- begin
- Src:=FConverter.Source;
- {$IFDEF dumpsource}
- if IsConsole then
- begin
- Writeln('>>>');
- Writeln(Src.Text);
- Writeln('<<<');
- end;
- {$ENDIF dumpsource}
- I:=0;
- While (I<Src.Count) and (Trim(Src[i])='') do
- Inc(I);
- if aSection<>'' then
- begin
- AssertTrue('Section: Not at end',I<Src.Count);
- AssertEquals('Section correct',LowerCase(aSection),LowerCase(Trim(Src[i])));
- Inc(I);
- end;
- For J:=0 to Length(Declarations)-1 do
- begin
- D:=Format('Declaration %d: ',[J]);
- S:=Declarations[J];
- While (I<Src.Count) and (Trim(Src[i])='') do
- Inc(I);
- AssertTrue(D+'Not at end',I<Src.Count);
- actSrc:=Src[i];
- AssertEquals(D+'Declaration correct',LowerCase(S),LowerCase(Trim(actSrc)));
- Inc(I);
- end;
- end;
- procedure TTestTSToPas.TestEmpty;
- begin
- AssertNotNull(Converter);
- end;
- procedure TTestTSToPas.TestVarDeclaration;
- begin
- Convert('declare var x : number;');
- CheckDeclaration('var','x : double; external name ''x'';');
- end;
- procedure TTestTSToPas.Test2VarDeclarations;
- begin
- Convert('declare var x,y : number;');
- CheckDeclaration('var','x : double; external name ''x'';','y : double; external name ''y'';');
- end;
- procedure TTestTSToPas.Test3VarDeclarations;
- begin
- Convert('declare var x,y,z : number;');
- CheckDeclarations('var',['x : double; external name ''x'';','y : double; external name ''y'';','z : double; external name ''z'';']);
- end;
- procedure TTestTSToPas.TestVarIndirectType;
- begin
- Convert('declare var a : { b : string;};');
- CheckDeclarations('type',[
- 'TA = class external name ''Object'' (TJSObject)',
- 'public',
- 'b : string;',
- 'end;',
- 'var',
- 'a : ta; external name ''a'';']);
- end;
- procedure TTestTSToPas.TestKeywordVarDeclaration;
- begin
- Convert('declare var on : string;');
- CheckDeclarations('var',['&on : string; external name ''on'';']);
- end;
- procedure TTestTSToPas.TestSimpleType;
- begin
- Convert('declare type MyType = string;');
- CheckDeclarations('type',['TMyType = string;']);
- end;
- procedure TTestTSToPas.TestAliasType;
- begin
- Convert('declare type MyType = SomeOtherType;');
- CheckDeclarations('type',['TMyType = SomeOtherType;']);
- end;
- procedure TTestTSToPas.TestAliasAliasedType;
- begin
- Converter.TypeAliases.Add('SomeOtherType=TMyOther');
- Convert('declare type MyType = SomeOtherType;');
- CheckDeclarations('type',['TMyType = TMyOther;']);
- end;
- procedure TTestTSToPas.TestUnionType;
- begin
- Convert('declare type MyType = string | number;');
- CheckDeclarations('type',['TMyType = JSValue; // string | number']);
- end;
- procedure TTestTSToPas.TestUnionTypeAllStrings;
- begin
- Convert('declare type MyType = ''string'' | ''number'';');
- CheckDeclarations('type',['TMyType = string; // Restricted values']);
- end;
- procedure TTestTSToPas.TestIntersectionType;
- begin
- Convert('declare type MyType = string & number;');
- CheckDeclarations('type',['TMyType = JSValue; // string & number']);
- end;
- procedure TTestTSToPas.TestUnionIntersectionType;
- begin
- Convert('declare type MyType = number | (string & number) ;');
- CheckDeclarations('type',['TMyType = JSValue; // number | (string & number)']);
- end;
- procedure TTestTSToPas.TestEnumType;
- begin
- Convert('declare enum Color {Red, Green, Blue} ;');
- CheckDeclarations('type',['TColor = (Red, Green, Blue);']);
- end;
- procedure TTestTSToPas.TestArrayType;
- begin
- Convert('declare type A = number[];');
- CheckDeclarations('type',['TA = array of Double;']);
- end;
- procedure TTestTSToPas.TestTupleType;
- begin
- Convert('declare type A = [number,number];');
- CheckDeclarations('type',['TA = array[0..1] of Double;']);
- end;
- procedure TTestTSToPas.TestTupleTypeForceUntyped;
- begin
- ConversionOptions:=ConversionOptions+[coUntypedTuples];
- Convert('declare type A = [number,number];');
- CheckDeclarations('type',['TA = array[0..1] of jsValue;']);
- end;
- procedure TTestTSToPas.TestTupleTypeUnbounded;
- begin
- ConversionOptions:=ConversionOptions+[coDynamicTuples];
- Convert('declare type A = [number,number];');
- CheckDeclarations('type',['TA = array of double;']);
- end;
- procedure TTestTSToPas.TestTupleTypeForceUntypedUnbounded;
- begin
- ConversionOptions:=ConversionOptions+[coDynamicTuples,coUntypedTuples];
- Convert('declare type A = [number,number];');
- CheckDeclarations('type',['TA = tjsvaluedynarray;']);
- end;
- procedure TTestTSToPas.TestTupleTypeUnequalTypes;
- begin
- Convert('declare type A = [number,string];');
- CheckDeclarations('type',['TA = array[0..1] of jsvalue;']);
- end;
- procedure TTestTSToPas.TestTupleTypeUnequalTypesUnbounded;
- begin
- ConversionOptions:=ConversionOptions+[coDynamicTuples];
- Convert('declare type A = [number,string];');
- CheckDeclarations('type',['TA = tjsvaluedynarray;']);
- end;
- procedure TTestTSToPas.TestFunctionType;
- begin
- Convert('declare type A = () => void;');
- CheckDeclarations('type',['TA = procedure;']);
- end;
- procedure TTestTSToPas.TestFunctionTypeWithArg;
- begin
- Convert('declare type A = (B : string) => void;');
- CheckDeclarations('type',['TA = procedure (B : string);']);
- end;
- procedure TTestTSToPas.TestFunctionTypeWithReturn;
- begin
- Convert('declare type A = (B : string) => number;');
- CheckDeclarations('type',['TA = function (B : string): Double;']);
- end;
- procedure TTestTSToPas.TestFunctionTypeWithTupleReturn;
- begin
- Convert('declare type A = (B : string) => [number,number];');
- CheckDeclarations('type',[
- 'TTA_Result = array[0..1] of double;',
- 'TA = function (B : string): TTA_Result;'
- ]);
- end;
- procedure TTestTSToPas.TestFunctionTypeWithReturnNoArgs;
- begin
- Convert('declare type A = () => number;');
- CheckDeclarations('type',['TA = function: Double;']);
- end;
- procedure TTestTSToPas.TestFunctionTypeArrayType;
- begin
- Convert('declare type A = (B : string[]) => void;');
- CheckDeclarations('type',['TA = procedure (B : array of string);']);
- end;
- procedure TTestTSToPas.TestFunctionTypeArrayTypeObj;
- begin
- Convert('declare function b (a : Array<{}>): string;');
- CheckDeclarations('type',[
- 'tb_a_item = class external name ''Object'' (TJSObject)',
- 'end;',
- 'tb_a = array of tb_a_item;',
- 'function b(a : Tb_a): string; external name ''b'';'
- ]);
- end;
- procedure TTestTSToPas.TestFunctionTypeArrayTypeArray;
- begin
- Convert('declare function a(b: string[][]): void;');
- CheckDeclarations('type',[
- 'ta_b_item = array of string;',
- 'ta_b = array of ta_b_item;',
- 'Procedure a(b : Ta_b); external name ''a'';'
- ]);
- end;
- procedure TTestTSToPas.TestFunctionCallbackArg;
- begin
- Convert('declare function b (para1 : (a: number) => string) : string;');
- CheckDeclarations('type',[
- 'tb_para1 = function (a : double): string;',
- 'function b(para1 : Tb_para1): string; external name ''b'';'
- ]);
- end;
- procedure TTestTSToPas.TestFunctionCallbackArgRecursive;
- begin
- Convert('declare function b (para1 : (a: (c: string) =>void) => string) : string;');
- CheckDeclarations('type',[
- 'tb_para1_a = procedure (c : string);',
- 'tb_para1 = function (a : tb_para1_a): string;',
- 'function b(para1 : Tb_para1): string; external name ''b'';'
- ]);
- end;
- procedure TTestTSToPas.TestSimpleFunction;
- begin
- Convert('declare function A() : void;');
- CheckDeclarations('',['Procedure A; external name ''a'';']);
- end;
- procedure TTestTSToPas.TestSimpleFunctionKeyword;
- begin
- Convert('declare function on() : void;');
- CheckDeclarations('',['Procedure &on; external name ''on'';']);
- end;
- procedure TTestTSToPas.TestExportSimpleFunction;
- begin
- Convert('export function A() : void;');
- CheckDeclarations('',['Procedure A; external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionSimpleResult;
- begin
- Convert('declare function A() : number;');
- CheckDeclarations('',['function A: double; external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionTypeRefResult;
- begin
- Convert(['declare type B = number;','declare function A() : B;']);
- CheckDeclarations('type',['TB = double;','function A: TB; external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionOneArg;
- begin
- Convert('declare function A(b : string) : void;');
- CheckDeclarations('',['procedure A(b : string); external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionOneArgUntyped;
- begin
- Convert('declare function A(b) : void;');
- CheckDeclarations('',['procedure A(b : jsvalue); external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionTwoArgs;
- begin
- Convert('declare function A(b : string, c : number) : void;');
- CheckDeclarations('',['procedure A(b : string; c : double); external name ''A'';']);
- end;
- procedure TTestTSToPas.TestFunctionFunctionResult;
- begin
- convert('declare class A { b(): (c: { d : any }) => void; }');
- CheckDeclarations('Type',[
- '// Forward class definitions',
- 'ta = class;',
- 'ta_b_result_c = class external name ''object'' (TJSObject)',
- 'public',
- 'd : jsvalue;',
- 'end;',
- 'ta_b_result = procedure (c : ta_b_result_c);',
- 'ta = class external name ''A'' (TJSObject)',
- 'public',
- 'function b: ta_b_result;',
- 'end;'
- ])
- end;
- procedure TTestTSToPas.TestOverloadedProcedures;
- begin
- Convert(['declare function A() : void;','declare function A(b : string) : void;']);
- CheckDeclarations('',[
- 'procedure A; external name ''A''; overload;',
- 'procedure A(b : string); external name ''A''; overload;']);
- end;
- procedure TTestTSToPas.TestUnionProcedures;
- begin
- Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
- Convert(['declare function A(b: number | string) : void;']);
- CheckDeclarations('',[
- 'procedure A(b : double); external name ''A''; overload;',
- 'procedure A(b : string); external name ''A''; overload;']);
- end;
- procedure TTestTSToPas.TestIndirectUnionProcedures;
- begin
- Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
- Convert(['declare type U = number | string;','declare function A(b: U) : void;']);
- CheckDeclarations('type',[
- 'TU = JSValue; // number | string',
- 'procedure A(b : double); external name ''A''; overload;',
- 'procedure A(b : string); external name ''A''; overload;'
- ]);
- end;
- procedure TTestTSToPas.TestUniqueOverloadedProcedures;
- begin
- Converter.Options:=Converter.Options+[coExpandUnionTypeArgs];
- Convert(['declare function A(b: number) : void;','declare function A(b: number | string) : void;']);
- CheckDeclarations('',[
- 'procedure A(b : double); external name ''A''; overload;',
- 'procedure A(b : string); external name ''A''; overload;'
- ]);
- end;
- procedure TTestTSToPas.TestEmptyNameSpace;
- begin
- Convert(['declare namespace A { };']);
- CheckDeclarations('type',['// forward class definitions',
- 'TA = Class;',
- '// Namespaces',
- 'TA = class external name ''A'' (TJSObject)',
- 'Public',
- 'end;']);
- end;
- procedure TTestTSToPas.TestEmptyNameSpaceFunction;
- begin
- Convert(['declare namespace A { ',
- ' function B() : void;',
- '}']);
- CheckDeclarations('type',['// forward class definitions',
- 'TA = Class;',
- '// Namespaces',
- 'TA = class external name ''A'' (TJSObject)',
- 'Public',
- 'procedure B;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestExportInterface;
- begin
- Convert('declare interface Color { b () : string; } ;');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TColor = interface;',
- 'TColor = interface',
- 'function b: string;',
- 'end;']
- );
- end;
- procedure TTestTSToPas.TestExportInterfaceAsClass;
- begin
- ConversionOptions:=ConversionOptions+[coInterfaceAsClass];
- Convert('declare interface Color { b () : string; } ;');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TColor = class;',
- 'TColor = class external name ''object'' (TJSObject)',
- 'function b: string;',
- 'end;']
- );
- end;
- procedure TTestTSToPas.TestExportInterfaceWithPropertiesAsClass;
- begin
- Convert('declare interface Color { b : string; } ;');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TColor = class;',
- 'TColor = class external name ''object'' (TJSObject)',
- 'b : string;',
- 'end;']
- );
- end;
- procedure TTestTSToPas.TestExportInterfacePropertyCallbackArgRecursive;
- begin
- Convert('declare interface A { b?: (c: (d: Boolean) => void) => void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'tA_b_c = procedure (d : boolean);',
- 'tA_b = procedure (c : tA_b_c);',
- 'TA = class external name ''object'' (TJSObject)',
- 'b : TA_b;',
- 'end;']
- );
- end;
- procedure TTestTSToPas.TestInterfaceNamedFunction;
- begin
- Convert('declare interface a { (b : String, c: string): number; }');
- CheckDeclarations('type',[
- // '// Forward class definitions',
- 'TA = function (B : String; C : string): double;'
- ]);
- end;
- procedure TTestTSToPas.TestInterfaceNamedFunctionCallback;
- begin
- Convert('declare interface a { (b : (c: string) => void): number; }');
- CheckDeclarations('type',[
- 'Ta__b = procedure (c : string);',
- 'TA = function (B : TA__b): double;'
- ]);
- end;
- procedure TTestTSToPas.TestObjectEmpty;
- begin
- Convert('declare type A = { }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''Object'' (TJSObject)',
- 'end;']);
- end;
- procedure TTestTSToPas.TestObjectOneProperty;
- begin
- Convert('declare type A = { prop : string; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''Object'' (TJSObject)',
- 'Public',
- 'prop : string;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassOnePrivateProperty;
- begin
- Convert('declare class A { private prop : string; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''A'' (TJSObject)',
- 'Private',
- 'prop : string;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassOneMethod;
- begin
- Convert(' export class A { b (c: string) : void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'procedure b(c : string);',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassOneMethodKeyword;
- begin
- Convert(' export class A { to() : void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'procedure &to;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassOneConstructor;
- begin
- Convert(' export class A { constructor (c: string) : void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'constructor new(c : string);',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassPropertyArrayType;
- begin
- Convert(' export class A { b : string[] ; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'tA_b = array of string;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'b : TA_b;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassPropertyObjectType;
- begin
- Convert('declare interface A { B: { C : number; }; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA_b = class external name ''Object'' (TJSObject)',
- 'public',
- 'c : double;',
- 'end;',
- 'TA = class external name ''object'' (TJSObject)',
- 'b : TA_B;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassPropertyObjectTypeRecursive;
- begin
- Convert('declare interface A { B: { C: { D : number; }; }; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA_b_c = class external name ''Object'' (TJSObject)',
- 'public',
- 'd : double;',
- 'end;',
- 'TA_b = class external name ''Object'' (TJSObject)',
- 'public',
- 'c : Ta_b_c;',
- 'end;',
- 'TA = class external name ''Object'' (TJSObject)',
- 'b : TA_B;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassMethodOneCallback;
- begin
- Convert(' export class A { b (c: (d : number) => string) : void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'tA_b_c = function (d : double): string;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'procedure b(c : TA_b_c);',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassMethodCallBackArrayTuple;
- begin
- Convert('declare class A { b() : [number, number][]; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA_b_Result_Item = array[0..1] of double;',
- 'tA_b_Result = array of TA_b_Result_Item;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'function b: tA_b_Result;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassMethodTupleReturn;
- begin
- Convert(' export class A { b () : [number, number]; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'tA_b_Result = array[0..1] of double;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'function b: tA_b_Result;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestClassMethodOneCallbackLocalArgTypes;
- begin
- ConversionOptions:=ConversionOptions+[coLocalArgumentTypes];
- Convert(' export class A { b (c: (d : number) => string) : void; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''A'' (TJSObject)',
- 'public',
- 'Type',
- 'tb_c = function (d : double): string;',
- 'public',
- 'procedure b(c : Tb_c);',
- 'end;']);
- end;
- procedure TTestTSToPas.TestNameSpaceClassLocalType;
- begin
- Convert('declare module "a" { class b { c(d : string): string[]; }; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- '// Modules',
- 'TA = class external name ''a'' (TJSObject)',
- 'Public',
- 'Type',
- '// Forward class definitions',
- 'TB = class;',
- 'TB_c_Result = Array of string;',
- 'TB = class external name ''b'' (TJSObject)',
- 'Public',
- 'function c(d : string): TB_c_Result;',
- 'end;'
- ])
- end;
- procedure TTestTSToPas.TestObjectOneReadOnlyProperty;
- begin
- Convert('declare type A = { readonly prop : string; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''Object'' (TJSObject)',
- 'Private',
- 'FProp : String; external name ''prop'';',
- 'Public',
- 'Property prop : string read FProp;',
- 'end;']);
- end;
- procedure TTestTSToPas.TestObjectOneReadOnlyPropertyKeyword;
- begin
- Convert('declare type A = { readonly on : string; }');
- CheckDeclarations('type',[
- '// Forward class definitions',
- 'TA = class;',
- 'TA = class external name ''Object'' (TJSObject)',
- 'Private',
- 'FOn : String; external name ''on'';',
- 'Public',
- 'Property on : string read FOn;',
- 'end;']);
- end;
- Initialization
- Registertest(TTestTSToPas);
- end.
|