1 {
2     This file is part of the Free Component Library (FCL)
3     Copyright (c) 2018 by Michael Van Canneyt
4 
5     Unit tests for Pascal-to-Javascript converter class.
6 
7     See the file COPYING.FPC, included in this distribution,
8     for details about the copyright.
9 
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 
14  **********************************************************************
15 
16  Examples:
17     ./testpas2js --suite=TTestModule.TestEmptyProgram
18     ./testpas2js --suite=TTestModule.TestEmptyUnit
19 }
20 unit TCModules;
21 
22 {$mode objfpc}{$H+}
23 
24 interface
25 
26 uses
27   Classes, SysUtils, fpcunit, testregistry, contnrs,
28   jstree, jswriter, jsbase,
29   PasTree, PScanner, PasResolver, PParser, PasResolveEval,
30   FPPas2Js;
31 
32 const
33   // default parser+scanner options
34   po_tcmodules = po_Pas2js+[po_KeepScannerError];
35   co_tcmodules = [coNoTypeInfo];
36 type
37   TSrcMarkerKind = (
38     mkLabel,
39     mkResolverReference,
40     mkDirectReference
41     );
42   PSrcMarker = ^TSrcMarker;
43   TSrcMarker = record
44     Kind: TSrcMarkerKind;
45     Filename: string;
46     Row: integer;
47     StartCol, EndCol: integer; // token start, end column
48     Identifier: string;
49     Next: PSrcMarker;
50   end;
51 
52   TSystemUnitPart = (
53     supTObject,
54     supTVarRec,
55     supTypeInfo,
56     supTInterfacedObject
57     );
58   TSystemUnitParts = set of TSystemUnitPart;
59 
60   { TTestHintMessage }
61 
62   TTestHintMessage = class
63   public
64     Id: int64;
65     MsgType: TMessageType;
66     MsgNumber: integer;
67     Msg: string;
68     SourcePos: TPasSourcePos;
69   end;
70 
71   { TTestPasParser }
72 
73   TTestPasParser = Class(TPasParser)
74   end;
75 
onstnull76   TOnFindUnit = function(const aUnitName: String): TPasModule of object;
77 
78   { TTestEnginePasResolver }
79 
80   TTestEnginePasResolver = class(TPas2JsResolver)
81   private
82     FFilename: string;
83     FModule: TPasModule;
84     FOnFindUnit: TOnFindUnit;
85     FParser: TTestPasParser;
86     FStreamResolver: TStreamResolver;
87     FScanner: TPas2jsPasScanner;
88     FSource: string;
89   public
90     destructor Destroy; override;
FindUnitnull91     function FindUnit(const AName, InFilename: String; NameExpr,
92       InFileExpr: TPasExpr): TPasModule; override;
93     procedure UsedInterfacesFinished(Section: TPasSection); override;
94     property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
95     property Filename: string read FFilename write FFilename;
96     property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
97     property Scanner: TPas2jsPasScanner read FScanner write FScanner;
98     property Parser: TTestPasParser read FParser write FParser;
99     property Source: string read FSource write FSource;
100     property Module: TPasModule read FModule;
101   end;
102 
103   { TCustomTestModule }
104 
105   TCustomTestModule = Class(TTestCase)
106   private
107     FConverter: TPasToJSConverter;
108     FEngine: TTestEnginePasResolver;
109     FExpectedErrorClass: ExceptClass;
110     FExpectedErrorMsg: string;
111     FExpectedErrorNumber: integer;
112     FFilename: string;
113     FFileResolver: TStreamResolver;
114     FHub: TPas2JSResolverHub;
115     FJSImplementationSrc: TJSSourceElements;
116     FJSImplementationUses: TJSArrayLiteral;
117     FJSInitBody: TJSFunctionBody;
118     FJSImplentationUses: TJSArrayLiteral;
119     FJSInterfaceUses: TJSArrayLiteral;
120     FJSModule: TJSSourceElements;
121     FJSModuleSrc: TJSSourceElements;
122     FJSSource: TStringList;
123     FModule: TPasModule;
124     FJSModuleCallArgs: TJSArguments;
125     FModules: TObjectList;// list of TTestEnginePasResolver
126     FParser: TTestPasParser;
127     FPasProgram: TPasProgram;
128     FHintMsgs: TObjectList; // list of TTestHintMessage
129     FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
130     FJSRegModuleCall: TJSCallExpression;
131     FScanner: TPas2jsPasScanner;
132     FSkipTests: boolean;
133     FSource: TStringList;
134     FFirstPasStatement: TPasImplBlock;
135     {$IFDEF EnablePasTreeGlobalRefCount}
136     FElementRefCountAtSetup: int64;
137     {$ENDIF}
GetMsgCountnull138     function GetMsgCount: integer;
GetMsgsnull139     function GetMsgs(Index: integer): TTestHintMessage;
GetResolverCountnull140     function GetResolverCount: integer;
GetResolversnull141     function GetResolvers(Index: integer): TTestEnginePasResolver;
OnPasResolverFindUnitnull142     function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
143     procedure OnParserLog(Sender: TObject; const Msg: String);
144     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
145     procedure OnScannerLog(Sender: TObject; const Msg: String);
146   protected
147     procedure SetUp; override;
CreateConverternull148     function CreateConverter: TPasToJSConverter; virtual;
LoadUnitnull149     function LoadUnit(const aUnitName: String): TPasModule;
150     procedure InitScanner(aScanner: TPas2jsPasScanner); virtual;
151     procedure TearDown; override;
152     Procedure Add(Line: string); virtual;
153     Procedure Add(const Lines: array of string);
154     Procedure StartParsing; virtual;
155     procedure ParseModuleQueue; virtual;
156     procedure ParseModule; virtual;
157     procedure ParseProgram; virtual;
158     procedure ParseUnit; virtual;
159   protected
FindModuleWithFilenamenull160     function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
AddModulenull161     function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
AddModuleWithSrcnull162     function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
AddModuleWithIntfImplSrcnull163     function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
164       ImplementationSrc: string): TTestEnginePasResolver; virtual;
165     procedure AddSystemUnit(Parts: TSystemUnitParts = []); virtual;
166     procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
167     procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
168     procedure ConvertModule; virtual;
169     procedure ConvertProgram; virtual;
170     procedure ConvertUnit; virtual;
ConvertJSModuleToStringnull171     function ConvertJSModuleToString(El: TJSElement): string; virtual;
172     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
GetDottedIdentifiernull173     function GetDottedIdentifier(El: TJSElement): string;
174     procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
175       ImplStatements: string = ''); virtual;
176     procedure CheckDiff(Msg, Expected, Actual: string); virtual;
177     procedure CheckUnit(Filename, ExpectedSrc: string); virtual;
178     procedure CheckHint(MsgType: TMessageType; MsgNumber: integer;
179       Msg: string; Marker: PSrcMarker = nil); virtual;
180     procedure CheckResolverUnexpectedHints(WithSourcePos: boolean = false); virtual;
181     procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
182     procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
183     procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
184     procedure SetExpectedConverterError(Msg: string; MsgNumber: integer);
IsErrorExpectednull185     function IsErrorExpected(E: Exception): boolean;
186     procedure HandleScannerError(E: EScannerError);
187     procedure HandleParserError(E: EParserError);
188     procedure HandlePasResolveError(E: EPasResolve);
189     procedure HandlePas2JSError(E: EPas2JS);
190     procedure HandleException(E: Exception);
191     procedure FailException(E: Exception);
192     procedure WriteSources(const aFilename: string; aRow, aCol: integer);
IndexOfResolvernull193     function IndexOfResolver(const Filename: string): integer;
GetResolvernull194     function GetResolver(const Filename: string): TTestEnginePasResolver;
GetDefaultNamespacenull195     function GetDefaultNamespace: string;
196     property PasProgram: TPasProgram Read FPasProgram;
197     property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
198     property ResolverCount: integer read GetResolverCount;
199     property Engine: TTestEnginePasResolver read FEngine;
200     property Filename: string read FFilename;
201     Property Module: TPasModule Read FModule;
202     property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
203     property Converter: TPasToJSConverter read FConverter;
204     property JSSource: TStringList read FJSSource;
205     property JSModule: TJSSourceElements read FJSModule;
206     property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
207     property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
208     property JSImplementationUses: TJSArrayLiteral read FJSImplementationUses;
209     property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
210     property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
211     property JSInitBody: TJSFunctionBody read FJSInitBody;
212     property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
213     property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
214     property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
215     property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
216     property SkipTests: boolean read FSkipTests write FSkipTests;
217   public
218     constructor Create; override;
219     destructor Destroy; override;
220     property Hub: TPas2JSResolverHub read FHub;
221     property Source: TStringList read FSource;
222     property FileResolver: TStreamResolver read FFileResolver;
223     property Scanner: TPas2jsPasScanner read FScanner;
224     property Parser: TTestPasParser read FParser;
225     property MsgCount: integer read GetMsgCount;
226     property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
227   end;
228 
229   { TTestModule }
230 
231   TTestModule = class(TCustomTestModule)
232   Published
233     Procedure TestReservedWords;
234 
235     // program/units
236     Procedure TestEmptyProgram;
237     Procedure TestEmptyProgramUseStrict;
238     Procedure TestEmptyUnit;
239     Procedure TestEmptyUnitUseStrict;
240     Procedure TestDottedUnitNames;
241     Procedure TestDottedUnitNameImpl;
242     Procedure TestDottedUnitExpr;
243     Procedure Test_ModeFPCFail;
244     Procedure Test_ModeSwitchCBlocksFail;
245     Procedure TestUnit_UseSystem;
246     Procedure TestUnit_Intf1Impl2Intf1;
247     Procedure TestIncludeVersion;
248 
249     // vars/const
250     Procedure TestVarInt;
251     Procedure TestVarBaseTypes;
252     Procedure TestBaseTypeSingleFail;
253     Procedure TestBaseTypeExtendedFail;
254     Procedure TestConstBaseTypes;
255     Procedure TestUnitImplVars;
256     Procedure TestUnitImplConsts;
257     Procedure TestUnitImplRecord;
258     Procedure TestRenameJSNameConflict;
259     Procedure TestLocalConst;
260     Procedure TestVarExternal;
261     Procedure TestVarExternalOtherUnit;
262     Procedure TestVarAbsoluteFail;
263     Procedure TestConstExternal;
264 
265     // numbers
266     Procedure TestDouble;
267     Procedure TestInteger;
268     Procedure TestIntegerRange;
269     Procedure TestIntegerTypecasts;
270     Procedure TestInteger_BitwiseShrNativeInt;
271     Procedure TestInteger_BitwiseShlNativeInt;
272     Procedure TestInteger_SystemFunc;
273     Procedure TestCurrency;
274     Procedure TestForBoolDo;
275     Procedure TestForIntDo;
276     Procedure TestForIntInDo;
277 
278     // strings
279     Procedure TestCharConst;
280     Procedure TestChar_Compare;
281     Procedure TestChar_BuiltInProcs;
282     Procedure TestStringConst;
283     Procedure TestStringConstSurrogate;
284     Procedure TestString_Length;
285     Procedure TestString_Compare;
286     Procedure TestString_SetLength;
287     Procedure TestString_CharAt;
288     Procedure TestStringHMinusFail;
289     Procedure TestStr;
290     Procedure TestBaseType_AnsiStringFail;
291     Procedure TestBaseType_WideStringFail;
292     Procedure TestBaseType_ShortStringFail;
293     Procedure TestBaseType_RawByteStringFail;
294     Procedure TestTypeShortstring_Fail;
295     Procedure TestCharSet_Custom;
296     Procedure TestForCharDo;
297     Procedure TestForCharInDo;
298 
299     // alias types
300     Procedure TestAliasTypeRef;
301     Procedure TestTypeCast_BaseTypes;
302     Procedure TestTypeCast_AliasBaseTypes;
303 
304     // functions
305     Procedure TestEmptyProc;
306     Procedure TestProcOneParam;
307     Procedure TestFunctionWithoutParams;
308     Procedure TestProcedureWithoutParams;
309     Procedure TestPrgProcVar;
310     Procedure TestProcTwoArgs;
311     Procedure TestProc_DefaultValue;
312     Procedure TestUnitProcVar;
313     Procedure TestImplProc;
314     Procedure TestFunctionResult;
315     Procedure TestNestedProc;
316     Procedure TestNestedProc_ResultString;
317     Procedure TestForwardProc;
318     Procedure TestNestedForwardProc;
319     Procedure TestAssignFunctionResult;
320     Procedure TestFunctionResultInCondition;
321     Procedure TestFunctionResultInForLoop;
322     Procedure TestFunctionResultInTypeCast;
323     Procedure TestExit;
324     Procedure TestExit_ResultInFinally;
325     Procedure TestBreak;
326     Procedure TestBreakAsVar;
327     Procedure TestContinue;
328     Procedure TestProc_External;
329     Procedure TestProc_ExternalOtherUnit;
330     Procedure TestProc_Asm;
331     Procedure TestProc_Assembler;
332     Procedure TestProc_VarParam;
333     Procedure TestProc_VarParamString;
334     Procedure TestProc_VarParamV;
335     Procedure TestProc_Overload;
336     Procedure TestProc_OverloadForward;
337     Procedure TestProc_OverloadIntfImpl;
338     Procedure TestProc_OverloadNested;
339     Procedure TestProc_OverloadNestedForward;
340     Procedure TestProc_OverloadUnitCycle;
341     Procedure TestProc_Varargs;
342     Procedure TestProc_ConstOrder;
343     Procedure TestProc_DuplicateConst;
344     Procedure TestProc_LocalVarAbsolute;
345     Procedure TestProc_LocalVarInit;
346     Procedure TestProc_ReservedWords;
347     Procedure TestProc_ConstRefWord;
348 
349     // anonymous functions
350     Procedure TestAnonymousProc_Assign_ObjFPC;
351     Procedure TestAnonymousProc_Assign_Delphi;
352     Procedure TestAnonymousProc_Arg;
353     Procedure TestAnonymousProc_Typecast;
354     Procedure TestAnonymousProc_With;
355     Procedure TestAnonymousProc_ExceptOn;
356     Procedure TestAnonymousProc_Nested;
357     Procedure TestAnonymousProc_NestedAssignResult;
358     Procedure TestAnonymousProc_Class;
359     Procedure TestAnonymousProc_ForLoop;
360 
361     // enums, sets
362     Procedure TestEnum_Name;
363     Procedure TestEnum_Number;
364     Procedure TestEnum_ConstFail;
365     Procedure TestEnum_Functions;
366     Procedure TestEnum_AsParams;
367     Procedure TestEnumRange_Array;
368     Procedure TestEnum_ForIn;
369     Procedure TestEnum_ScopedNumber;
370     Procedure TestEnum_InFunction;
371     Procedure TestSet_Enum;
372     Procedure TestSet_Operators;
373     Procedure TestSet_Operator_In;
374     Procedure TestSet_Functions;
375     Procedure TestSet_PassAsArgClone;
376     Procedure TestSet_AsParams;
377     Procedure TestSet_Property;
378     Procedure TestSet_EnumConst;
379     Procedure TestSet_IntConst;
380     Procedure TestSet_AnonymousEnumType;
381     Procedure TestSet_AnonymousEnumTypeChar; // ToDo
382     Procedure TestSet_ConstEnum;
383     Procedure TestSet_ConstChar;
384     Procedure TestSet_ConstInt;
385     Procedure TestSet_InFunction;
386     Procedure TestSet_ForIn;
387 
388     // statements
389     Procedure TestNestBegin;
390     Procedure TestIncDec;
391     Procedure TestLoHiFpcMode;
392     Procedure TestLoHiDelphiMode;
393     Procedure TestAssignments;
394     Procedure TestArithmeticOperators1;
395     Procedure TestLogicalOperators;
396     Procedure TestBitwiseOperators;
397     Procedure TestBitwiseOperatorsLongword;
398     Procedure TestFunctionInt;
399     Procedure TestFunctionString;
400     Procedure TestIfThen;
401     Procedure TestForLoop;
402     Procedure TestForLoopInsideFunction;
403     Procedure TestForLoop_ReadVarAfter;
404     Procedure TestForLoop_Nested;
405     Procedure TestRepeatUntil;
406     Procedure TestAsmBlock;
407     Procedure TestAsmPas_Impl; // ToDo
408     Procedure TestTryFinally;
409     Procedure TestTryExcept;
410     Procedure TestTryExcept_ReservedWords;
411     Procedure TestIfThenRaiseElse;
412     Procedure TestCaseOf;
413     Procedure TestCaseOf_UseSwitch;
414     Procedure TestCaseOfNoElse;
415     Procedure TestCaseOfNoElse_UseSwitch;
416     Procedure TestCaseOfRange;
417     Procedure TestCaseOfString;
418     Procedure TestCaseOfChar;
419     Procedure TestCaseOfExternalClassConst;
420     Procedure TestDebugger;
421 
422     // arrays
423     Procedure TestArray_Dynamic;
424     Procedure TestArray_Dynamic_Nil;
425     Procedure TestArray_DynMultiDimensional;
426     Procedure TestArray_DynamicAssign;
427     Procedure TestArray_StaticInt;
428     Procedure TestArray_StaticBool;
429     Procedure TestArray_StaticChar;
430     Procedure TestArray_StaticMultiDim;
431     Procedure TestArray_StaticInFunction;
432     Procedure TestArray_StaticMultiDimEqualNotImplemented;
433     Procedure TestArrayOfRecord;
434     Procedure TestArray_StaticRecord;
435     Procedure TestArrayOfSet;
436     Procedure TestArray_DynAsParam;
437     Procedure TestArray_StaticAsParam;
438     Procedure TestArrayElement_AsParams;
439     Procedure TestArrayElementFromFuncResult_AsParams;
440     Procedure TestArrayEnumTypeRange;
441     Procedure TestArray_SetLengthOutArg;
442     Procedure TestArray_SetLengthProperty;
443     Procedure TestArray_SetLengthMultiDim;
444     Procedure TestArray_SetLengthDynOfStatic;
445     Procedure TestArray_OpenArrayOfString;
446     Procedure TestArray_ArrayOfCharAssignString; // ToDo
447     Procedure TestArray_ConstRef;
448     Procedure TestArray_Concat;
449     Procedure TestArray_Copy;
450     Procedure TestArray_InsertDelete;
451     Procedure TestArray_DynArrayConstObjFPC;
452     Procedure TestArray_DynArrayConstDelphi;
453     Procedure TestArray_ArrayLitAsParam;
454     Procedure TestArray_ArrayLitMultiDimAsParam;
455     Procedure TestArray_ArrayLitStaticAsParam;
456     Procedure TestArray_ForInArrOfString;
457     Procedure TestExternalClass_TypeCastArrayToExternalClass;
458     Procedure TestExternalClass_TypeCastArrayFromExternalClass;
459     Procedure TestArrayOfConst_TVarRec;
460     Procedure TestArrayOfConst_PassBaseTypes;
461     Procedure TestArrayOfConst_PassObj;
462 
463     // record
464     Procedure TestRecord_Empty;
465     Procedure TestRecord_Var;
466     Procedure TestRecord_VarExternal;
467     Procedure TestRecord_WithDo;
468     Procedure TestRecord_Assign;
469     Procedure TestRecord_AsParams;
470     Procedure TestRecord_ConstRef;
471     Procedure TestRecordElement_AsParams;
472     Procedure TestRecordElementFromFuncResult_AsParams;
473     Procedure TestRecordElementFromWith_AsParams;
474     Procedure TestRecord_Equal;
475     Procedure TestRecord_JSValue;
476     Procedure TestRecord_VariantFail;
477     Procedure TestRecord_FieldArray;
478     Procedure TestRecord_Const;
479     Procedure TestRecord_TypecastFail;
480     Procedure TestRecord_InFunction;
481     Procedure TestRecord_AnonymousFail;
482 
483     // advanced record
484     Procedure TestAdvRecord_Function;
485     Procedure TestAdvRecord_Property;
486     Procedure TestAdvRecord_PropertyDefault;
487     Procedure TestAdvRecord_Property_ClassMethod;
488     Procedure TestAdvRecord_Const;
489     Procedure TestAdvRecord_ExternalField;
490     Procedure TestAdvRecord_SubRecord;
491     Procedure TestAdvRecord_SubClass;
492     Procedure TestAdvRecord_SubInterfaceFail;
493     Procedure TestAdvRecord_Constructor;
494     Procedure TestAdvRecord_ClassConstructor_Program;
495     Procedure TestAdvRecord_ClassConstructor_Unit;
496 
497     // classes
498     Procedure TestClass_TObjectDefaultConstructor;
499     Procedure TestClass_TObjectConstructorWithParams;
500     Procedure TestClass_TObjectConstructorWithDefaultParam;
501     Procedure TestClass_Var;
502     Procedure TestClass_Method;
503     Procedure TestClass_Implementation;
504     Procedure TestClass_Inheritance;
505     Procedure TestClass_TypeAlias;
506     Procedure TestClass_AbstractMethod;
507     Procedure TestClass_CallInherited_ProcNoParams;
508     Procedure TestClass_CallInherited_WithParams;
509     Procedure TestClasS_CallInheritedConstructor;
510     Procedure TestClass_ClassVar_Assign;
511     Procedure TestClass_CallClassMethod;
512     Procedure TestClass_Property;
513     Procedure TestClass_Property_ClassMethod;
514     Procedure TestClass_Property_Indexed;
515     Procedure TestClass_Property_IndexSpec;
516     Procedure TestClass_PropertyOfTypeArray;
517     Procedure TestClass_PropertyDefault;
518     Procedure TestClass_PropertyDefault_TypecastToOtherDefault;
519     //Procedure TestClass_PropertyDefault;
520     Procedure TestClass_PropertyOverride;
521     Procedure TestClass_PropertyIncVisibility;
522     Procedure TestClass_Assigned;
523     Procedure TestClass_WithClassDoCreate;
524     Procedure TestClass_WithClassInstDoProperty;
525     Procedure TestClass_WithClassInstDoPropertyWithParams;
526     Procedure TestClass_WithClassInstDoFunc;
527     Procedure TestClass_TypeCast;
528     Procedure TestClass_TypeCastUntypedParam;
529     Procedure TestClass_Overloads;
530     Procedure TestClass_OverloadsAncestor;
531     Procedure TestClass_OverloadConstructor;
532     Procedure TestClass_OverloadDelphiOverride;
533     Procedure TestClass_ReintroduceVarDelphi;
534     Procedure TestClass_ReintroducedVar;
535     Procedure TestClass_RaiseDescendant;
536     Procedure TestClass_ExternalMethod;
537     Procedure TestClass_ExternalVirtualNameMismatchFail;
538     Procedure TestClass_ExternalOverrideFail;
539     Procedure TestClass_ExternalVar;
540     Procedure TestClass_Const;
541     Procedure TestClass_LocalConstDuplicate_Prg;
542     Procedure TestClass_LocalConstDuplicate_Unit;
543     // ToDo: Procedure TestAdvRecord_LocalConstDuplicate;
544     Procedure TestClass_LocalVarSelfFail;
545     Procedure TestClass_ArgSelfFail;
546     Procedure TestClass_NestedProcSelf;
547     Procedure TestClass_NestedProcSelf2;
548     Procedure TestClass_NestedProcClassSelf;
549     Procedure TestClass_NestedProcCallInherited;
550     Procedure TestClass_TObjectFree;
551     Procedure TestClass_TObjectFree_VarArg;
552     Procedure TestClass_TObjectFreeNewInstance;
553     Procedure TestClass_TObjectFreeLowerCase;
554     Procedure TestClass_TObjectFreeFunctionFail;
555     Procedure TestClass_TObjectFreePropertyFail;
556     Procedure TestClass_ForIn;
557     Procedure TestClass_DispatchMessage;
558     Procedure TestClass_Message_DuplicateIntFail;
559     Procedure TestClass_DispatchMessage_WrongFieldNameFail;
560 
561     // class of
562     Procedure TestClassOf_Create;
563     Procedure TestClassOf_Call;
564     Procedure TestClassOf_Assign;
565     Procedure TestClassOf_Is;
566     Procedure TestClassOf_Compare;
567     Procedure TestClassOf_ClassVar;
568     Procedure TestClassOf_ClassMethod;
569     Procedure TestClassOf_ClassProperty;
570     Procedure TestClassOf_ClassMethodSelf;
571     Procedure TestClassOf_TypeCast;
572     Procedure TestClassOf_ImplicitFunctionCall;
573     Procedure TestClassOf_Const;
574 
575     // nested class
576     Procedure TestNestedClass_Alias;
577     Procedure TestNestedClass_Record;
578     Procedure TestNestedClass_Class;
579 
580     // external class
581     Procedure TestExternalClass_Var;
582     Procedure TestExternalClass_Const;
583     Procedure TestExternalClass_Dollar;
584     Procedure TestExternalClass_DuplicateVarFail;
585     Procedure TestExternalClass_Method;
586     Procedure TestExternalClass_ClassMethod;
587     Procedure TestExternalClass_ClassMethodStatic;
588     Procedure TestExternalClass_FunctionResultInTypeCast;
589     Procedure TestExternalClass_NonExternalOverride;
590     Procedure TestExternalClass_OverloadHint;
591     Procedure TestExternalClass_SameNamePublishedProperty;
592     Procedure TestExternalClass_Property;
593     Procedure TestExternalClass_PropertyDate;
594     Procedure TestExternalClass_ClassProperty;
595     Procedure TestExternalClass_ClassOf;
596     Procedure TestExternalClass_ClassOtherUnit;
597     Procedure TestExternalClass_Is;
598     Procedure TestExternalClass_As;
599     Procedure TestExternalClass_DestructorFail;
600     Procedure TestExternalClass_New;
601     Procedure TestExternalClass_ClassOf_New;
602     Procedure TestExternalClass_FuncClassOf_New;
603     Procedure TestExternalClass_New_PasClassFail;
604     Procedure TestExternalClass_New_PasClassBracketsFail;
605     Procedure TestExternalClass_NewExtName;
606     Procedure TestExternalClass_Constructor;
607     Procedure TestExternalClass_ConstructorBrackets;
608     Procedure TestExternalClass_LocalConstSameName;
609     Procedure TestExternalClass_ReintroduceOverload;
610     Procedure TestExternalClass_Inherited;
611     Procedure TestExternalClass_PascalAncestorFail;
612     Procedure TestExternalClass_NewInstance;
613     Procedure TestExternalClass_NewInstance_NonVirtualFail;
614     Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
615     Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
616     Procedure TestExternalClass_JSFunctionPasDescendant;
617     Procedure TestExternalClass_PascalProperty;
618     Procedure TestExternalClass_TypeCastToRootClass;
619     Procedure TestExternalClass_TypeCastToJSObject;
620     Procedure TestExternalClass_TypeCastStringToExternalString;
621     Procedure TestExternalClass_TypeCastToJSFunction;
622     Procedure TestExternalClass_TypeCastDelphiUnrelated;
623     Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
624     Procedure TestExternalClass_BracketAccessor;
625     Procedure TestExternalClass_BracketAccessor_Call;
626     Procedure TestExternalClass_BracketAccessor_2ParamsFail;
627     Procedure TestExternalClass_BracketAccessor_ReadOnly;
628     Procedure TestExternalClass_BracketAccessor_WriteOnly;
629     Procedure TestExternalClass_BracketAccessor_MultiType;
630     Procedure TestExternalClass_BracketAccessor_Index;
631     Procedure TestExternalClass_ForInJSObject;
632     Procedure TestExternalClass_ForInJSArray;
633     Procedure TestExternalClass_IncompatibleArgDuplicateIdentifier;
634 
635     // class interfaces
636     Procedure TestClassInterface_Corba;
637     Procedure TestClassInterface_ProcExternalFail;
638     Procedure TestClassInterface_Overloads;
639     Procedure TestClassInterface_DuplicateGUIInIntfListFail;
640     Procedure TestClassInterface_DuplicateGUIInAncestorFail;
641     Procedure TestClassInterface_AncestorImpl;
642     Procedure TestClassInterface_ImplReintroduce;
643     Procedure TestClassInterface_MethodResolution;
644     Procedure TestClassInterface_AncestorMoreInterfaces;
645     Procedure TestClassInterface_MethodOverride;
646     Procedure TestClassInterface_Corba_Delegation;
647     Procedure TestClassInterface_Corba_DelegationStatic;
648     Procedure TestClassInterface_Corba_Operators;
649     Procedure TestClassInterface_Corba_Args;
650     Procedure TestClassInterface_Corba_ForIn;
651     Procedure TestClassInterface_COM_AssignVar;
652     Procedure TestClassInterface_COM_AssignArg;
653     Procedure TestClassInterface_COM_FunctionResult;
654     Procedure TestClassInterface_COM_InheritedFuncResult;
655     Procedure TestClassInterface_COM_IsAsTypeCasts;
656     Procedure TestClassInterface_COM_PassAsArg;
657     Procedure TestClassInterface_COM_PassToUntypedParam;
658     Procedure TestClassInterface_COM_FunctionInExpr;
659     Procedure TestClassInterface_COM_Property;
660     Procedure TestClassInterface_COM_IntfProperty;
661     Procedure TestClassInterface_COM_Delegation;
662     Procedure TestClassInterface_COM_With;
663     Procedure TestClassInterface_COM_ForIn;
664     Procedure TestClassInterface_COM_ArrayOfIntfFail;
665     Procedure TestClassInterface_COM_RecordIntfFail;
666     Procedure TestClassInterface_COM_UnitInitialization;
667     Procedure TestClassInterface_GUID;
668     Procedure TestClassInterface_GUIDProperty;
669 
670     // helpers
671     Procedure TestClassHelper_ClassVar;
672     Procedure TestClassHelper_Method_AccessInstanceFields;
673     Procedure TestClassHelper_Method_Call;
674     Procedure TestClassHelper_Method_Nested_Call;
675     Procedure TestClassHelper_ClassMethod_Call;
676     Procedure TestClassHelper_ClassOf;
677     Procedure TestClassHelper_MethodRefObjFPC;
678     Procedure TestClassHelper_Constructor;
679     Procedure TestClassHelper_InheritedObjFPC;
680     Procedure TestClassHelper_Property;
681     Procedure TestClassHelper_Property_Array;
682     Procedure TestClassHelper_Property_Array_Default;
683     Procedure TestClassHelper_Property_Array_DefaultDefault;
684     Procedure TestClassHelper_ClassProperty;
685     Procedure TestClassHelper_ClassPropertyStatic;
686     Procedure TestClassHelper_ClassProperty_Array;
687     Procedure TestClassHelper_ForIn;
688     Procedure TestClassHelper_PassProperty;
689     Procedure TestExtClassHelper_ClassVar;
690     Procedure TestExtClassHelper_Method_Call;
691     Procedure TestExtClassHelper_ClassMethod_MissingStatic;
692     Procedure TestRecordHelper_ClassVar;
693     Procedure TestRecordHelper_Method_Call;
694     Procedure TestRecordHelper_Constructor;
695     Procedure TestTypeHelper_ClassVar;
696     Procedure TestTypeHelper_PassResultElement;
697     Procedure TestTypeHelper_PassArgs;
698     Procedure TestTypeHelper_PassVarConst;
699     Procedure TestTypeHelper_PassFuncResult;
700     Procedure TestTypeHelper_PassPropertyField;
701     Procedure TestTypeHelper_PassPropertyGetter;
702     Procedure TestTypeHelper_PassClassPropertyField;
703     Procedure TestTypeHelper_PassClassPropertyGetterStatic;
704     Procedure TestTypeHelper_PassClassPropertyGetterNonStatic;
705     Procedure TestTypeHelper_Property;
706     Procedure TestTypeHelper_Property_Array;
707     Procedure TestTypeHelper_ClassProperty;
708     Procedure TestTypeHelper_ClassProperty_Array;
709     Procedure TestTypeHelper_ClassMethod;
710     Procedure TestTypeHelper_ExtClassMethodFail;
711     Procedure TestTypeHelper_Constructor;
712     Procedure TestTypeHelper_Word;
713     Procedure TestTypeHelper_Boolean;
714     Procedure TestTypeHelper_WordBool;
715     Procedure TestTypeHelper_Double;
716     Procedure TestTypeHelper_NativeInt;
717     Procedure TestTypeHelper_StringChar;
718     Procedure TestTypeHelper_JSValue;
719     Procedure TestTypeHelper_Array;
720     Procedure TestTypeHelper_EnumType;
721     Procedure TestTypeHelper_SetType;
722     Procedure TestTypeHelper_InterfaceType;
723     Procedure TestTypeHelper_NestedSelf;
724 
725     // proc types
726     Procedure TestProcType;
727     Procedure TestProcType_Arg;
728     Procedure TestProcType_FunctionFPC;
729     Procedure TestProcType_FunctionDelphi;
730     Procedure TestProcType_ProcedureDelphi;
731     Procedure TestProcType_AsParam;
732     Procedure TestProcType_MethodFPC;
733     Procedure TestProcType_MethodDelphi;
734     Procedure TestProcType_PropertyFPC;
735     Procedure TestProcType_PropertyDelphi;
736     Procedure TestProcType_WithClassInstDoPropertyFPC;
737     Procedure TestProcType_Nested;
738     Procedure TestProcType_NestedOfObject;
739     Procedure TestProcType_ReferenceToProc;
740     Procedure TestProcType_ReferenceToMethod;
741     Procedure TestProcType_Typecast;
742     Procedure TestProcType_PassProcToUntyped;
743     Procedure TestProcType_PassProcToArray;
744     Procedure TestProcType_SafeCallObjFPC;
745     Procedure TestProcType_SafeCallDelphi;
746 
747     // pointer
748     Procedure TestPointer;
749     Procedure TestPointer_Proc;
750     Procedure TestPointer_AssignRecordFail;
751     Procedure TestPointer_AssignStaticArrayFail;
752     Procedure TestPointer_TypeCastJSValueToPointer;
753     Procedure TestPointer_NonRecordFail;
754     Procedure TestPointer_AnonymousArgTypeFail;
755     Procedure TestPointer_AnonymousVarTypeFail;
756     Procedure TestPointer_AnonymousResultTypeFail;
757     Procedure TestPointer_AddrOperatorFail;
758     Procedure TestPointer_ArrayParamsFail;
759     Procedure TestPointer_PointerAddFail;
760     Procedure TestPointer_IncPointerFail;
761     Procedure TestPointer_Record;
762     Procedure TestPointer_RecordArg;
763 
764     // jsvalue
765     Procedure TestJSValue_AssignToJSValue;
766     Procedure TestJSValue_TypeCastToBaseType;
767     Procedure TestJSValue_TypecastToJSValue;
768     Procedure TestJSValue_Equal;
769     Procedure TestJSValue_If;
770     Procedure TestJSValue_Not;
771     Procedure TestJSValue_Enum;
772     Procedure TestJSValue_ClassInstance;
773     Procedure TestJSValue_ClassOf;
774     Procedure TestJSValue_ArrayOfJSValue;
775     Procedure TestJSValue_ArrayLit;
776     Procedure TestJSValue_Params;
777     Procedure TestJSValue_UntypedParam;
778     Procedure TestJSValue_FuncResultType;
779     Procedure TestJSValue_ProcType_Assign;
780     Procedure TestJSValue_ProcType_Equal;
781     Procedure TestJSValue_ProcType_Param;
782     Procedure TestJSValue_AssignToPointerFail;
783     Procedure TestJSValue_OverloadDouble;
784     Procedure TestJSValue_OverloadNativeInt;
785     Procedure TestJSValue_OverloadWord;
786     Procedure TestJSValue_OverloadString;
787     Procedure TestJSValue_OverloadChar;
788     Procedure TestJSValue_OverloadPointer;
789     Procedure TestJSValue_ForIn;
790 
791     // RTTI
792     Procedure TestRTTI_IntRange;
793     Procedure TestRTTI_Double;
794     Procedure TestRTTI_ProcType;
795     Procedure TestRTTI_ProcType_ArgFromOtherUnit;
796     Procedure TestRTTI_EnumAndSetType;
797     Procedure TestRTTI_EnumRange;
798     Procedure TestRTTI_AnonymousEnumType;
799     Procedure TestRTTI_StaticArray;
800     Procedure TestRTTI_DynArray;
801     Procedure TestRTTI_ArrayNestedAnonymous;
802     Procedure TestRTTI_PublishedMethodOverloadFail;
803     Procedure TestRTTI_PublishedMethodExternalFail;
804     Procedure TestRTTI_PublishedClassPropertyFail;
805     Procedure TestRTTI_PublishedClassFieldFail;
806     Procedure TestRTTI_PublishedFieldExternalFail;
807     Procedure TestRTTI_Class_Field;
808     Procedure TestRTTI_Class_Method;
809     Procedure TestRTTI_Class_MethodArgFlags;
810     Procedure TestRTTI_Class_Property;
811     Procedure TestRTTI_Class_PropertyParams;
812     Procedure TestRTTI_Class_OtherUnit_TypeAlias;
813     Procedure TestRTTI_Class_OmitRTTI;
814     Procedure TestRTTI_IndexModifier;
815     Procedure TestRTTI_StoredModifier;
816     Procedure TestRTTI_DefaultValue;
817     Procedure TestRTTI_DefaultValueSet;
818     Procedure TestRTTI_DefaultValueRangeType;
819     Procedure TestRTTI_DefaultValueInherit;
820     Procedure TestRTTI_OverrideMethod;
821     Procedure TestRTTI_ReintroduceMethod;
822     Procedure TestRTTI_OverloadProperty;
823     // ToDo: array argument
824     Procedure TestRTTI_ClassForward;
825     Procedure TestRTTI_ClassOf;
826     Procedure TestRTTI_Record;
827     Procedure TestRTTI_RecordAnonymousArray;
828     Procedure TestRTTI_LocalTypes;
829     Procedure TestRTTI_TypeInfo_BaseTypes;
830     Procedure TestRTTI_TypeInfo_Type_BaseTypes;
831     Procedure TestRTTI_TypeInfo_LocalFail;
832     Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses1;
833     Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
834     Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
835     Procedure TestRTTI_TypeInfo_FunctionClassType;
836     Procedure TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
837     Procedure TestRTTI_Interface_Corba;
838     Procedure TestRTTI_Interface_COM;
839     Procedure TestRTTI_ClassHelper;
840     Procedure TestRTTI_ExternalClass;
841 
842     // Resourcestring
843     Procedure TestResourcestringProgram;
844     Procedure TestResourcestringUnit;
845     Procedure TestResourcestringImplementation;
846 
847     // Attributes
848     Procedure TestAttributes_Members;
849     Procedure TestAttributes_Types;
850     Procedure TestAttributes_HelperConstructor_Fail;
851 
852     // Assertions, checks
853     procedure TestAssert;
854     procedure TestAssert_SysUtils;
855     procedure TestObjectChecks;
856     procedure TestOverflowChecks_Int;
857     procedure TestRangeChecks_AssignInt;
858     procedure TestRangeChecks_AssignIntRange;
859     procedure TestRangeChecks_AssignEnum;
860     procedure TestRangeChecks_AssignEnumRange;
861     procedure TestRangeChecks_AssignChar;
862     procedure TestRangeChecks_AssignCharRange;
863     procedure TestRangeChecks_ArrayIndex;
864     procedure TestRangeChecks_ArrayOfRecIndex;
865     procedure TestRangeChecks_StringIndex;
866     procedure TestRangeChecks_TypecastInt;
867     procedure TestRangeChecks_TypeHelperInt;
868 
869     // Async/AWait
870     Procedure TestAsync_Proc;
871     Procedure TestAsync_CallResultIsPromise;
872     Procedure TestAsync_ConstructorFail;
873     Procedure TestAsync_PropertyGetterFail;
874     Procedure TestAwait_NonPromiseWithTypeFail;
875     Procedure TestAWait_OutsideAsyncFail;
876     Procedure TestAWait_Result;
877     Procedure TestAWait_ExternalClassPromise;
878     Procedure TestAsync_AnonymousProc;
879     Procedure TestAsync_ProcType;
880     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
881     Procedure TestAsync_Inherited;
882   end;
883 
LinesToStrnull884 function LinesToStr(Args: array of const): string;
ExtractFileUnitNamenull885 function ExtractFileUnitName(aFilename: string): string;
JSToStrnull886 function JSToStr(El: TJSElement): string;
CheckSrcDiffnull887 function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
888 
889 implementation
890 
LinesToStrnull891 function LinesToStr(Args: array of const): string;
892 var
893   s: String;
894   i: Integer;
895 begin
896   s:='';
897   for i:=Low(Args) to High(Args) do
898     case Args[i].VType of
899       vtChar:         s += Args[i].VChar+LineEnding;
900       vtString:       s += Args[i].VString^+LineEnding;
901       vtPChar:        s += Args[i].VPChar+LineEnding;
902       vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
903       vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
904       vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
905       vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
906       vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
907     end;
908   Result:=s;
909 end;
910 
ExtractFileUnitNamenull911 function ExtractFileUnitName(aFilename: string): string;
912 var
913   p: Integer;
914 begin
915   Result:=ExtractFileName(aFilename);
916   if Result='' then exit;
917   for p:=length(Result) downto 1 do
918     case Result[p] of
919     '/','\': exit;
920     '.':
921       begin
922       Delete(Result,p,length(Result));
923       exit;
924       end;
925     end;
926 end;
927 
JSToStrnull928 function JSToStr(El: TJSElement): string;
929 var
930   aWriter: TBufferWriter;
931   aJSWriter: TJSWriter;
932 begin
933   aJSWriter:=nil;
934   aWriter:=TBufferWriter.Create(1000);
935   try
936     aJSWriter:=TJSWriter.Create(aWriter);
937     aJSWriter.IndentSize:=2;
938     aJSWriter.WriteJS(El);
939     Result:=aWriter.AsString;
940   finally
941     aJSWriter.Free;
942     aWriter.Free;
943   end;
944 end;
945 
CheckSrcDiffnull946 function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
947 // search diff, ignore changes in spaces
948 const
949   SpaceChars = [#9,#10,#13,' '];
950 var
951   ExpectedP, ActualP: PChar;
952 
FindLineEndnull953   function FindLineEnd(p: PChar): PChar;
954   begin
955     Result:=p;
956     while not (Result^ in [#0,#10,#13]) do inc(Result);
957   end;
958 
FindLineStartnull959   function FindLineStart(p, MinP: PChar): PChar;
960   begin
961     while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
962     Result:=p;
963   end;
964 
965   procedure SkipLineEnd(var p: PChar);
966   begin
967     if p^ in [#10,#13] then
968     begin
969       if (p[1] in [#10,#13]) and (p^<>p[1]) then
970         inc(p,2)
971       else
972         inc(p);
973     end;
974   end;
975 
976   procedure DiffFound;
977   var
978     ActLineStartP, ActLineEndP, p, StartPos: PChar;
979     ExpLine, ActLine: String;
980     i, LineNo, DiffLineNo: Integer;
981   begin
982     writeln('Diff found "',Msg,'". Lines:');
983     // write correct lines
984     p:=PChar(Expected);
985     LineNo:=0;
986     DiffLineNo:=0;
987     repeat
988       StartPos:=p;
989       while not (p^ in [#0,#10,#13]) do inc(p);
990       ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
991       SkipLineEnd(p);
992       inc(LineNo);
993       if (p<=ExpectedP) and (p^<>#0) then
994       begin
995         writeln('= ',ExpLine);
996       end else begin
997         // diff line
998         if DiffLineNo=0 then DiffLineNo:=LineNo;
999         // write actual line
1000         ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
1001         ActLineEndP:=FindLineEnd(ActualP);
1002         ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
1003         writeln('- ',ActLine);
1004         // write expected line
1005         writeln('+ ',ExpLine);
1006         // write empty line with pointer ^
1007         for i:=1 to 2+ExpectedP-StartPos do write(' ');
1008         writeln('^');
1009         Msg:='expected "'+ExpLine+'", but got "'+ActLine+'".';
1010         CheckSrcDiff:=false;
1011         // write up to three following actual lines to get some context
1012         for i:=1 to 3 do begin
1013           ActLineStartP:=ActLineEndP;
1014           SkipLineEnd(ActLineStartP);
1015           if ActLineStartP^=#0 then break;
1016           ActLineEndP:=FindLineEnd(ActLineStartP);
1017           ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
1018           writeln('~ ',ActLine);
1019         end;
1020         exit;
1021       end;
1022     until p^=#0;
1023 
1024     writeln('DiffFound Actual:-----------------------');
1025     writeln(Actual);
1026     writeln('DiffFound Expected:---------------------');
1027     writeln(Expected);
1028     writeln('DiffFound ------------------------------');
1029     Msg:='diff found, but lines are the same, internal error';
1030     CheckSrcDiff:=false;
1031   end;
1032 
1033 var
1034   IsSpaceNeeded: Boolean;
1035   LastChar, Quote: Char;
1036 begin
1037   Result:=true;
1038   Msg:='';
1039   if Expected='' then Expected:=' ';
1040   if Actual='' then Actual:=' ';
1041   ExpectedP:=PChar(Expected);
1042   ActualP:=PChar(Actual);
1043   repeat
1044     //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
1045     case ExpectedP^ of
1046     #0:
1047       begin
1048       // check that rest of Actual has only spaces
1049       while ActualP^ in SpaceChars do inc(ActualP);
1050       if ActualP^<>#0 then
1051         begin
1052         DiffFound;
1053         exit;
1054         end;
1055       exit(true);
1056       end;
1057     ' ',#9,#10,#13:
1058       begin
1059       // skip space in Expected
1060       IsSpaceNeeded:=false;
1061       if ExpectedP>PChar(Expected) then
1062         LastChar:=ExpectedP[-1]
1063       else
1064         LastChar:=#0;
1065       while ExpectedP^ in SpaceChars do inc(ExpectedP);
1066       if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
1067           and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
1068         IsSpaceNeeded:=true;
1069       if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
1070         begin
1071         DiffFound;
1072         exit;
1073         end;
1074       while ActualP^ in SpaceChars do inc(ActualP);
1075       end;
1076     '''','"':
1077       begin
1078       while ActualP^ in SpaceChars do inc(ActualP);
1079       if ExpectedP^<>ActualP^ then
1080         begin
1081         DiffFound;
1082         exit;
1083         end;
1084       Quote:=ExpectedP^;
1085       repeat
1086         inc(ExpectedP);
1087         inc(ActualP);
1088         if ExpectedP^<>ActualP^ then
1089           begin
1090           DiffFound;
1091           exit;
1092           end;
1093         if (ExpectedP^ in [#0,#10,#13]) then
1094           break
1095         else if (ExpectedP^=Quote) then
1096           begin
1097           inc(ExpectedP);
1098           inc(ActualP);
1099           break;
1100           end;
1101       until false;
1102       end;
1103     else
1104       while ActualP^ in SpaceChars do inc(ActualP);
1105       if ExpectedP^<>ActualP^ then
1106         begin
1107         DiffFound;
1108         exit;
1109         end;
1110       inc(ExpectedP);
1111       inc(ActualP);
1112     end;
1113   until false;
1114 end;
1115 
1116 { TTestEnginePasResolver }
1117 
1118 destructor TTestEnginePasResolver.Destroy;
1119 begin
1120   FreeAndNil(FStreamResolver);
1121   FreeAndNil(FParser);
1122   FreeAndNil(FScanner);
1123   FreeAndNil(FStreamResolver);
1124   if Module<>nil then
1125     begin
1126     Module.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
1127     FModule:=nil;
1128     end;
1129   inherited Destroy;
1130 end;
1131 
TTestEnginePasResolver.FindUnitnull1132 function TTestEnginePasResolver.FindUnit(const AName, InFilename: String;
1133   NameExpr, InFileExpr: TPasExpr): TPasModule;
1134 begin
1135   Result:=nil;
1136   if InFilename<>'' then
1137     RaiseNotYetImplemented(20180224101926,InFileExpr,'Use testcase tcunitsearch instead');
1138   if Assigned(OnFindUnit) then
1139     Result:=OnFindUnit(AName);
1140   if NameExpr=nil then ;
1141 end;
1142 
1143 procedure TTestEnginePasResolver.UsedInterfacesFinished(Section: TPasSection);
1144 begin
1145   // do not parse recursively
1146   // parse via the queue
1147   if Section=nil then ;
1148 end;
1149 
1150 { TCustomTestModule }
1151 
TCustomTestModule.GetMsgCountnull1152 function TCustomTestModule.GetMsgCount: integer;
1153 begin
1154   Result:=FHintMsgs.Count;
1155 end;
1156 
GetMsgsnull1157 function TCustomTestModule.GetMsgs(Index: integer): TTestHintMessage;
1158 begin
1159   Result:=TTestHintMessage(FHintMsgs[Index]);
1160 end;
1161 
GetResolverCountnull1162 function TCustomTestModule.GetResolverCount: integer;
1163 begin
1164   Result:=FModules.Count;
1165 end;
1166 
TCustomTestModule.GetResolversnull1167 function TCustomTestModule.GetResolvers(Index: integer
1168   ): TTestEnginePasResolver;
1169 begin
1170   Result:=TTestEnginePasResolver(FModules[Index]);
1171 end;
1172 
TCustomTestModule.OnPasResolverFindUnitnull1173 function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
1174   ): TPasModule;
1175 var
1176   DefNamespace: String;
1177 begin
1178   //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
1179   if (Pos('.',aUnitName)<1) then
1180     begin
1181     DefNamespace:=GetDefaultNamespace;
1182     if DefNamespace<>'' then
1183       begin
1184       Result:=LoadUnit(DefNamespace+'.'+aUnitName);
1185       if Result<>nil then exit;
1186       end;
1187     end;
1188   Result:=LoadUnit(aUnitName);
1189   if Result<>nil then exit;
1190   {$IFDEF VerbosePas2JS}
1191   writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
1192   {$ENDIF}
1193   Fail('can''t find unit "'+aUnitName+'"');
1194 end;
1195 
1196 procedure TCustomTestModule.OnParserLog(Sender: TObject; const Msg: String);
1197 var
1198   aParser: TPasParser;
1199   Item: TTestHintMessage;
1200 begin
1201   aParser:=Sender as TPasParser;
1202   Item:=TTestHintMessage.Create;
1203   Item.Id:=aParser.LastMsgNumber;
1204   Item.MsgType:=aParser.LastMsgType;
1205   Item.MsgNumber:=aParser.LastMsgNumber;
1206   Item.Msg:=Msg;
1207   Item.SourcePos:=aParser.Scanner.CurSourcePos;
1208   {$IFDEF VerbosePas2JS}
1209   writeln('TCustomTestModule.OnParserLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
1210   {$ENDIF}
1211   FHintMsgs.Add(Item);
1212 end;
1213 
1214 procedure TCustomTestModule.OnPasResolverLog(Sender: TObject; const Msg: String
1215   );
1216 var
1217   aResolver: TTestEnginePasResolver;
1218   Item: TTestHintMessage;
1219 begin
1220   aResolver:=Sender as TTestEnginePasResolver;
1221   Item:=TTestHintMessage.Create;
1222   Item.Id:=aResolver.LastMsgId;
1223   Item.MsgType:=aResolver.LastMsgType;
1224   Item.MsgNumber:=aResolver.LastMsgNumber;
1225   Item.Msg:=Msg;
1226   Item.SourcePos:=aResolver.LastSourcePos;
1227   {$IFDEF VerbosePas2JS}
1228   writeln('TCustomTestModule.OnPasResolverLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
1229   {$ENDIF}
1230   FHintMsgs.Add(Item);
1231 end;
1232 
1233 procedure TCustomTestModule.OnScannerLog(Sender: TObject; const Msg: String);
1234 var
1235   Item: TTestHintMessage;
1236   aScanner: TPas2jsPasScanner;
1237 begin
1238   aScanner:=Sender as TPas2jsPasScanner;
1239   Item:=TTestHintMessage.Create;
1240   Item.Id:=aScanner.LastMsgNumber;
1241   Item.MsgType:=aScanner.LastMsgType;
1242   Item.MsgNumber:=aScanner.LastMsgNumber;
1243   Item.Msg:=Msg;
1244   Item.SourcePos:=aScanner.CurSourcePos;
1245   {$IFDEF VerbosePas2JS}
1246   writeln('TCustomTestModule.OnScannerLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
1247   {$ENDIF}
1248   FHintMsgs.Add(Item);
1249 end;
1250 
LoadUnitnull1251 function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule;
1252 var
1253   i: Integer;
1254   CurEngine: TTestEnginePasResolver;
1255   CurUnitName: String;
1256 begin
1257   //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
1258   Result:=nil;
1259   if (Module.ClassType=TPasModule)
1260       and (CompareText(Module.Name,aUnitName)=0) then
1261     exit(Module);
1262 
1263   for i:=0 to ResolverCount-1 do
1264     begin
1265     CurEngine:=Resolvers[i];
1266     CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
1267     //writeln('TTestModule.FindUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
1268     if CompareText(aUnitName,CurUnitName)=0 then
1269       begin
1270       Result:=CurEngine.Module;
1271       if Result<>nil then exit;
1272       //writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
1273       FileResolver.FindSourceFile(aUnitName);
1274 
1275       CurEngine.StreamResolver:=TStreamResolver.Create;
1276       CurEngine.StreamResolver.OwnsStreams:=True;
1277       //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
1278       CurEngine.StreamResolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
1279       CurEngine.Scanner:=TPas2jsPasScanner.Create(CurEngine.StreamResolver);
1280       InitScanner(CurEngine.Scanner);
1281       CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.StreamResolver,CurEngine);
1282       CurEngine.Parser.Options:=po_tcmodules;
1283       if CompareText(CurUnitName,'System')=0 then
1284         CurEngine.Parser.ImplicitUses.Clear;
1285       CurEngine.Scanner.OpenFile(CurEngine.Filename);
1286       try
1287         CurEngine.Parser.NextToken;
1288         CurEngine.Parser.ParseUnit(CurEngine.FModule);
1289       except
1290         on E: Exception do
1291           HandleException(E);
1292       end;
1293       //writeln('TTestModule.FindUnit END ',CurUnitName);
1294       Result:=CurEngine.Module;
1295       exit;
1296       end;
1297     end;
1298 end;
1299 
1300 procedure TCustomTestModule.SetUp;
1301 begin
1302   {$IFDEF EnablePasTreeGlobalRefCount}
1303   FElementRefCountAtSetup:=TPasElement.GlobalRefCount;
1304   {$ENDIF}
1305 
1306   if FModules<>nil then
1307     begin
1308     writeln('TCustomTestModule.SetUp FModules<>nil');
1309     Halt;
1310     end;
1311 
1312   inherited SetUp;
1313   FSkipTests:=false;
1314   FSource:=TStringList.Create;
1315 
1316   FHub:=TPas2JSResolverHub.Create(Self);
1317   FModules:=TObjectList.Create(true);
1318 
1319   FFilename:='test1.pp';
1320   FFileResolver:=TStreamResolver.Create;
1321   FFileResolver.OwnsStreams:=True;
1322 
1323   FScanner:=TPas2jsPasScanner.Create(FFileResolver);
1324   InitScanner(FScanner);
1325 
1326   FEngine:=AddModule(Filename);
1327   FEngine.Scanner:=FScanner;
1328   FScanner.Resolver:=FEngine;
1329 
1330   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
1331   FParser.OnLog:=@OnParserLog;
1332   FEngine.Parser:=FParser;
1333   Parser.Options:=po_tcmodules;
1334 
1335   FModule:=Nil;
1336   FConverter:=CreateConverter;
1337 
1338   FExpectedErrorClass:=nil;
1339 end;
1340 
CreateConverternull1341 function TCustomTestModule.CreateConverter: TPasToJSConverter;
1342 begin
1343   Result:=TPasToJSConverter.Create;
1344   Result.Options:=co_tcmodules;
1345   Result.Globals:=TPasToJSConverterGlobals.Create(Result);
1346 end;
1347 
1348 procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
1349 begin
1350   aScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
1351   aScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
1352   aScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
1353 
1354   aScanner.AllowedBoolSwitches:=bsAllPas2jsBoolSwitches;
1355   aScanner.ReadOnlyBoolSwitches:=bsAllPas2jsBoolSwitchesReadOnly;
1356   aScanner.CurrentBoolSwitches:=bsAllPas2jsBoolSwitchesReadOnly+[bsHints,bsNotes,bsWarnings,bsWriteableConst];
1357 
1358   aScanner.AllowedValueSwitches:=vsAllPas2jsValueSwitches;
1359   aScanner.ReadOnlyValueSwitches:=vsAllPas2jsValueSwitchesReadOnly;
1360 
1361   aScanner.OnLog:=@OnScannerLog;
1362 
1363   aScanner.CompilerVersion:='Comp.Ver.tcmodules';
1364 end;
1365 
1366 procedure TCustomTestModule.TearDown;
1367 {$IFDEF CheckPasTreeRefCount}
1368 var
1369   El: TPasElement;
1370 {$ENDIF}
1371 var
1372   i: Integer;
1373   CurModule: TPasModule;
1374 begin
1375   FHintMsgs.Clear;
1376   FHintMsgsGood.Clear;
1377   FSkipTests:=false;
1378   FJSRegModuleCall:=nil;
1379   FJSModuleCallArgs:=nil;
1380   FJSImplentationUses:=nil;
1381   FJSInterfaceUses:=nil;
1382   FJSModuleSrc:=nil;
1383   FJSInitBody:=nil;
1384   FreeAndNil(FJSSource);
1385   FreeAndNil(FJSModule);
1386   FreeAndNil(FConverter);
1387   Engine.Clear;
1388   FreeAndNil(FSource);
1389   FreeAndNil(FFileResolver);
1390   if FModules<>nil then
1391     begin
1392     for i:=0 to FModules.Count-1 do
1393       begin
1394       CurModule:=TTestEnginePasResolver(FModules[i]).Module;
1395       if CurModule=nil then continue;
1396       //writeln('TCustomTestModule.TearDown ReleaseUsedUnits ',CurModule.Name,' ',CurModule.RefCount,' ',CurModule.RefIds.Text);
1397       CurModule.ReleaseUsedUnits;
1398       end;
1399     if FModule<>nil then
1400       FModule.ReleaseUsedUnits;
1401     for i:=0 to FModules.Count-1 do
1402       begin
1403       CurModule:=TTestEnginePasResolver(FModules[i]).Module;
1404       if CurModule=nil then continue;
1405       //writeln('TCustomTestModule.TearDown UsesReleased ',CurModule.Name,' ',CurModule.RefCount,' ',CurModule.RefIds.Text);
1406       end;
1407     FreeAndNil(FModules);
1408     ReleaseAndNil(TPasElement(FModule){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
1409     FEngine:=nil;
1410     end;
1411   FreeAndNil(FHub);
1412 
1413   inherited TearDown;
1414   {$IFDEF EnablePasTreeGlobalRefCount}
1415   if FElementRefCountAtSetup<>TPasElement.GlobalRefCount then
1416     begin
1417     writeln('TCustomTestModule.TearDown GlobalRefCount Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
1418     {$IFDEF CheckPasTreeRefCount}
1419     El:=TPasElement.FirstRefEl;
1420     while El<>nil do
1421       begin
1422       writeln('  ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
1423       for i:=0 to El.RefIds.Count-1 do
1424         writeln('    ',El.RefIds[i]);
1425       El:=El.NextRefEl;
1426       end;
1427     {$ENDIF}
1428     Halt;
1429     Fail('TCustomTestModule.TearDown Was='+IntToStr(FElementRefCountAtSetup)+' Now='+IntToStr(TPasElement.GlobalRefCount));
1430     end;
1431   {$ENDIF}
1432 end;
1433 
1434 procedure TCustomTestModule.Add(Line: string);
1435 begin
1436   Source.Add(Line);
1437 end;
1438 
1439 procedure TCustomTestModule.Add(const Lines: array of string);
1440 var
1441   i: Integer;
1442 begin
1443   for i:=low(Lines) to high(Lines) do
1444     Add(Lines[i]);
1445 end;
1446 
1447 procedure TCustomTestModule.StartParsing;
1448 var
1449   Src: String;
1450 begin
1451   Src:=Source.Text;
1452   FEngine.Source:=Src;
1453   FileResolver.AddStream(FileName,TStringStream.Create(Src));
1454   Scanner.OpenFile(FileName);
1455   Writeln('// Test : ',Self.TestName);
1456   Writeln(Src);
1457 end;
1458 
1459 procedure TCustomTestModule.ParseModuleQueue;
1460 var
1461   i: Integer;
1462   CurResolver: TTestEnginePasResolver;
1463   Found: Boolean;
1464   Section: TPasSection;
1465 begin
1466   // parse til exception or all modules finished
1467   while not SkipTests do
1468     begin
1469     Found:=false;
1470     for i:=0 to ResolverCount-1 do
1471       begin
1472       CurResolver:=Resolvers[i];
1473       if CurResolver.CurrentParser=nil then continue;
1474       if not CurResolver.CurrentParser.CanParseContinue(Section) then
1475         continue;
1476       CurResolver.Parser.ParseContinue;
1477       Found:=true;
1478       break;
1479       end;
1480     if not Found then break;
1481     end;
1482 
1483   for i:=0 to ResolverCount-1 do
1484     begin
1485     CurResolver:=Resolvers[i];
1486     if CurResolver.Parser=nil then
1487       begin
1488       if CurResolver.CurrentParser<>nil then
1489         Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' '+GetObjName(CurResolver.Parser)+'=Parser<>CurrentParser='+GetObjName(CurResolver.CurrentParser));
1490       continue;
1491       end;
1492     if CurResolver.Parser.CurModule<>nil then
1493       Fail('TCustomTestModule.ParseModuleQueue '+CurResolver.Filename+' NOT FINISHED CurModule='+GetObjName(CurResolver.Parser.CurModule));
1494     end;
1495 end;
1496 
1497 procedure TCustomTestModule.ParseModule;
1498 begin
1499   if SkipTests then exit;
1500   FFirstPasStatement:=nil;
1501   try
1502     StartParsing;
1503     Parser.ParseMain(FModule);
1504     ParseModuleQueue;
1505   except
1506     on E: Exception do
1507       HandleException(E);
1508   end;
1509   if SkipTests then exit;
1510 
1511   AssertNotNull('Module resulted in Module',Module);
1512   AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
1513   TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
1514 end;
1515 
1516 procedure TCustomTestModule.ParseProgram;
1517 begin
1518   if SkipTests then exit;
1519   ParseModule;
1520   if SkipTests then exit;
1521   AssertEquals('Has program',TPasProgram,Module.ClassType);
1522   FPasProgram:=TPasProgram(Module);
1523   AssertNotNull('Has program section',PasProgram.ProgramSection);
1524   AssertNotNull('Has initialization section',PasProgram.InitializationSection);
1525   if (PasProgram.InitializationSection.Elements.Count>0) then
1526     if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
1527       FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
1528 end;
1529 
1530 procedure TCustomTestModule.ParseUnit;
1531 begin
1532   if SkipTests then exit;
1533   ParseModule;
1534   if SkipTests then exit;
1535   AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
1536   AssertNotNull('Has interface section',Module.InterfaceSection);
1537   AssertNotNull('Has implementation section',Module.ImplementationSection);
1538   if (Module.InitializationSection<>nil)
1539       and (Module.InitializationSection.Elements.Count>0)
1540       and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
1541     FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
1542 end;
1543 
FindModuleWithFilenamenull1544 function TCustomTestModule.FindModuleWithFilename(aFilename: string
1545   ): TTestEnginePasResolver;
1546 var
1547   i: Integer;
1548 begin
1549   for i:=0 to ResolverCount-1 do
1550     if CompareText(Resolvers[i].Filename,aFilename)=0 then
1551       exit(Resolvers[i]);
1552   Result:=nil;
1553 end;
1554 
TCustomTestModule.AddModulenull1555 function TCustomTestModule.AddModule(aFilename: string
1556   ): TTestEnginePasResolver;
1557 begin
1558   //writeln('TTestModuleConverter.AddModule ',aFilename);
1559   if FindModuleWithFilename(aFilename)<>nil then
1560     Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
1561   Result:=TTestEnginePasResolver.Create;
1562   Result.Filename:=aFilename;
1563   Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
1564   Result.OnFindUnit:=@OnPasResolverFindUnit;
1565   Result.OnLog:=@OnPasResolverLog;
1566   Result.Hub:=Hub;
1567   FModules.Add(Result);
1568 end;
1569 
AddModuleWithSrcnull1570 function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
1571   ): TTestEnginePasResolver;
1572 begin
1573   Result:=AddModule(aFilename);
1574   Result.Source:=Src;
1575 end;
1576 
TCustomTestModule.AddModuleWithIntfImplSrcnull1577 function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
1578   ImplementationSrc: string): TTestEnginePasResolver;
1579 var
1580   Src: String;
1581 begin
1582   Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
1583   Src+=LineEnding;
1584   Src+='interface'+LineEnding;
1585   Src+=LineEnding;
1586   Src+=InterfaceSrc;
1587   Src+='implementation'+LineEnding;
1588   Src+=LineEnding;
1589   Src+=ImplementationSrc;
1590   Src+='end.'+LineEnding;
1591   Result:=AddModuleWithSrc(aFilename,Src);
1592 end;
1593 
1594 procedure TCustomTestModule.AddSystemUnit(Parts: TSystemUnitParts);
1595 var
1596   Intf, Impl: TStringList;
1597 begin
1598   Intf:=TStringList.Create;
1599   if supTInterfacedObject in Parts then Include(Parts,supTObject);
1600 
1601   // unit interface
1602   if [supTVarRec,supTypeInfo]*Parts<>[] then
1603     Intf.Add('{$modeswitch externalclass}');
1604   Intf.Add('type');
1605   Intf.Add('  integer=longint;');
1606   Intf.Add('  sizeint=nativeint;');
1607     //'const',
1608     //'  LineEnding = #10;',
1609     //'  DirectorySeparator = ''/'';',
1610     //'  DriveSeparator = '''';',
1611     //'  AllowDirectorySeparators : set of char = [''\'',''/''];',
1612     //'  AllowDriveSeparators : set of char = [];',
1613   if supTObject in Parts then
1614     Intf.AddStrings([
1615     'type',
1616     '  TClass = class of TObject;',
1617     '  TObject = class',
1618     '    constructor Create;',
1619     '    destructor Destroy; virtual;',
1620     '    class function ClassType: TClass; assembler;',
1621     '    class function ClassName: String; assembler;',
1622     '    class function ClassNameIs(const Name: string): boolean;',
1623     '    class function ClassParent: TClass; assembler;',
1624     '    class function InheritsFrom(aClass: TClass): boolean; assembler;',
1625     '    class function UnitName: String; assembler;',
1626     '    procedure AfterConstruction; virtual;',
1627     '    procedure BeforeDestruction;virtual;',
1628     '    function Equals(Obj: TObject): boolean; virtual;',
1629     '    function ToString: String; virtual;',
1630     '  end;']);
1631   if supTInterfacedObject in Parts then
1632     Intf.AddStrings([
1633     '  {$Interfaces COM}',
1634     '  IUnknown = interface',
1635     '    [''{00000000-0000-0000-C000-000000000046}'']',
1636     //'    function QueryInterface(const iid: TGuid; out obj): Integer;',
1637     '    function _AddRef: Integer;',
1638     '    function _Release: Integer;',
1639     '  end;',
1640     '  IInterface = IUnknown;',
1641     '  TInterfacedObject = class(TObject,IUnknown)',
1642     '  protected',
1643     '    fRefCount: Integer;',
1644     '    { implement methods of IUnknown }',
1645     //'    function QueryInterface(const iid: TGuid; out obj): Integer; virtual;',
1646     '    function _AddRef: Integer; virtual;',
1647     '    function _Release: Integer; virtual;',
1648     '  end;',
1649     '  TInterfacedClass = class of TInterfacedObject;',
1650     '',
1651     '']);
1652   if supTVarRec in Parts then
1653     Intf.AddStrings([
1654     'const',
1655     '  vtInteger       = 0;',
1656     '  vtBoolean       = 1;',
1657     '  vtJSValue       = 19;',
1658     'type',
1659     '  PVarRec = ^TVarRec;',
1660     '  TVarRec = record',
1661     '    VType : byte;',
1662     '    VJSValue: JSValue;',
1663     '    vInteger: longint external name ''VJSValue'';',
1664     '    vBoolean: boolean external name ''VJSValue'';',
1665     '  end;',
1666     '  TVarRecArray = array of TVarRec;',
1667     'function VarRecs: TVarRecArray; varargs;',
1668     '']);
1669   if supTypeInfo in Parts then
1670     begin
1671     Intf.AddStrings([
1672     'type',
1673     '  TTypeKind = (',
1674     '    tkUnknown,  // 0',
1675     '    tkInteger,  // 1',
1676     '    tkChar,     // 2 in Delphi/FPC tkWChar, tkUChar',
1677     '    tkString,   // 3 in Delphi/FPC tkSString, tkWString or tkUString',
1678     '    tkEnumeration, // 4',
1679     '    tkSet,      // 5',
1680     '    tkDouble,   // 6',
1681     '    tkBool,     // 7',
1682     '    tkProcVar,  // 8  function or procedure',
1683     '    tkMethod,   // 9  proc var of object',
1684     '    tkArray,    // 10 static array',
1685     '    tkDynArray, // 11',
1686     '    tkRecord,   // 12',
1687     '    tkClass,    // 13',
1688     '    tkClassRef, // 14',
1689     '    tkPointer,  // 15',
1690     '    tkJSValue,  // 16',
1691     '    tkRefToProcVar, // 17  variable of procedure type',
1692     '    tkInterface, // 18',
1693     '    //tkObject,',
1694     '    //tkSString,tkLString,tkAString,tkWString,',
1695     '    //tkVariant,',
1696     '    //tkWChar,',
1697     '    //tkInt64,',
1698     '    //tkQWord,',
1699     '    //tkInterfaceRaw,',
1700     '    //tkUString,tkUChar,',
1701     '    tkHelper,   // 19',
1702     '    //tkFile,',
1703     '    tkExtClass  // 20',
1704     '    );',
1705     '  TTypeKinds = set of TTypeKind;',
1706     '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
1707     '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
1708     '  end;',
1709     '  TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;',
1710     '  TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;',
1711     '  TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;',
1712     '  TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;',
1713     '  TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;',
1714     '  TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;',
1715     '  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
1716     '  TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;',
1717     '  TTypeInfoExtClass = class external name ''rtl.tTypeInfoExtClass''(TTypeInfo) end;',
1718     '  TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;',
1719     '  TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;',
1720     '  TTypeInfoHelper = class external name ''rtl.tTypeInfoHelper''(TTypeInfo) end;',
1721     '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
1722     '']);
1723     end;
1724   Intf.Add('var');
1725   Intf.Add('  ExitCode: Longint = 0;');
1726 
1727   // unit implementation
1728   Impl:=TStringList.Create;
1729   if supTObject in Parts then
1730     Impl.AddStrings([
1731       '// needed by ClassNameIs, the real SameText is in SysUtils',
1732       'function SameText(const s1, s2: String): Boolean; assembler;',
1733       'asm',
1734       'end;',
1735       'constructor TObject.Create; begin end;',
1736       'destructor TObject.Destroy; begin end;',
1737       'class function TObject.ClassType: TClass; assembler;',
1738       'asm',
1739       'end;',
1740       'class function TObject.ClassName: String; assembler;',
1741       'asm',
1742       'end;',
1743       'class function TObject.ClassNameIs(const Name: string): boolean;',
1744       'begin',
1745       '  Result:=SameText(Name,ClassName);',
1746       'end;',
1747       'class function TObject.ClassParent: TClass; assembler;',
1748       'asm',
1749       'end;',
1750       'class function TObject.InheritsFrom(aClass: TClass): boolean; assembler;',
1751       'asm',
1752       'end;',
1753       'class function TObject.UnitName: String; assembler;',
1754       'asm',
1755       'end;',
1756       'procedure TObject.AfterConstruction; begin end;',
1757       'procedure TObject.BeforeDestruction; begin end;',
1758       'function TObject.Equals(Obj: TObject): boolean;',
1759       'begin',
1760       '  Result:=Obj=Self;',
1761       'end;',
1762       'function TObject.ToString: String;',
1763       'begin',
1764       '  Result:=ClassName;',
1765       'end;'
1766       ]);
1767   if supTInterfacedObject in Parts then
1768     Impl.AddStrings([
1769     //'function TInterfacedObject.QueryInterface(const iid: TGuid; out obj): Integer;',
1770     //'begin',
1771     //'end;',
1772     'function TInterfacedObject._AddRef: Integer;',
1773     'begin',
1774     'end;',
1775     'function TInterfacedObject._Release: Integer;',
1776     'begin',
1777     'end;',
1778     '']);
1779   if supTVarRec in Parts then
1780     Impl.AddStrings([
1781     'function VarRecs: TVarRecArray; varargs;',
1782     'var',
1783     '  v: PVarRec;',
1784     'begin',
1785     '  v^.VType:=1;',
1786     '  v^.VJSValue:=2;',
1787     'end;',
1788     '']);
1789 
1790   try
1791     AddModuleWithIntfImplSrc('system.pp',Intf.Text,Impl.Text);
1792   finally
1793     Intf.Free;
1794     Impl.Free;
1795   end;
1796 end;
1797 
1798 procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean;
1799   SystemUnitParts: TSystemUnitParts);
1800 begin
1801   if NeedSystemUnit then
1802     AddSystemUnit(SystemUnitParts)
1803   else
1804     Parser.ImplicitUses.Clear;
1805   Add('program '+ExtractFileUnitName(Filename)+';');
1806   Add('');
1807 end;
1808 
1809 procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean;
1810   SystemUnitParts: TSystemUnitParts);
1811 begin
1812   if NeedSystemUnit then
1813     AddSystemUnit(SystemUnitParts)
1814   else
1815     Parser.ImplicitUses.Clear;
1816   Add('unit Test1;');
1817   Add('');
1818 end;
1819 
1820 procedure TCustomTestModule.ConvertModule;
1821 
1822   procedure CheckUsesList(UsesName: String; Arg: TJSArrayLiteralElement;
1823     out UsesLit: TJSArrayLiteral);
1824   var
1825     i: Integer;
1826     Item: TJSElement;
1827     Lit: TJSLiteral;
1828   begin
1829     UsesLit:=nil;
1830     AssertNotNull(UsesName+' uses section',Arg.Expr);
1831     if (Arg.Expr.ClassType=TJSLiteral) and TJSLiteral(Arg.Expr).Value.IsNull then
1832       exit; // null is ok
1833     AssertEquals(UsesName+' uses section param is array',TJSArrayLiteral,Arg.Expr.ClassType);
1834     FJSInterfaceUses:=TJSArrayLiteral(Arg.Expr);
1835     for i:=0 to FJSInterfaceUses.Elements.Count-1 do
1836       begin
1837       Item:=FJSInterfaceUses.Elements.Elements[i].Expr;
1838       AssertNotNull(UsesName+' uses section item['+IntToStr(i)+'].Expr',Item);
1839       AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is lit',TJSLiteral,Item.ClassType);
1840       Lit:=TJSLiteral(Item);
1841       AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is string lit',
1842         ord(jsbase.jstString),ord(Lit.Value.ValueType));
1843       end;
1844   end;
1845 
1846   procedure CheckFunctionParam(ParamName: string; Arg: TJSArrayLiteralElement;
1847     out Src: TJSSourceElements);
1848   var
1849     FunDecl: TJSFunctionDeclarationStatement;
1850     FunDef: TJSFuncDef;
1851     FunBody: TJSFunctionBody;
1852   begin
1853     Src:=nil;
1854     AssertNotNull(ParamName,Arg.Expr);
1855     AssertEquals(ParamName+' Arg.Expr type',TJSFunctionDeclarationStatement,Arg.Expr.ClassType);
1856     FunDecl:=Arg.Expr as TJSFunctionDeclarationStatement;
1857     AssertNotNull(ParamName+' FunDecl.AFunction',FunDecl.AFunction);
AssertEqualsnull1858     AssertEquals(ParamName+' FunDecl.AFunction type',TJSFuncDef,FunDecl.AFunction.ClassType);
asnull1859     FunDef:=FunDecl.AFunction as TJSFuncDef;
1860     AssertEquals(ParamName+' name empty','',String(FunDef.Name));
1861     AssertNotNull(ParamName+' body',FunDef.Body);
1862     AssertEquals(ParamName+' body type',TJSFunctionBody,FunDef.Body.ClassType);
1863     FunBody:=FunDef.Body as TJSFunctionBody;
1864     AssertNotNull(ParamName+' body.A',FunBody.A);
1865     AssertEquals(ParamName+' body.A type',TJSSourceElements,FunBody.A.ClassType);
1866     Src:=FunBody.A as TJSSourceElements;
1867   end;
1868 
1869 var
1870   ModuleNameExpr: TJSLiteral;
TJSFunctionDeclarationStatementnull1871   InitFunction: TJSFunctionDeclarationStatement;
1872   InitAssign: TJSSimpleAssignStatement;
1873   InitName: String;
1874   LastNode: TJSElement;
1875   Arg: TJSArrayLiteralElement;
1876 begin
1877   if SkipTests then exit;
1878   try
1879     FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
1880   except
1881     on E: Exception do
1882       HandleException(E);
1883   end;
1884   if SkipTests then exit;
1885   if ExpectedErrorClass<>nil then
1886     Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
1887 
1888   FJSSource:=TStringList.Create;
1889   FJSSource.Text:=ConvertJSModuleToString(JSModule);
1890   {$IFDEF VerbosePas2JS}
1891   writeln('TTestModule.ConvertModule JS:');
1892   write(FJSSource.Text);
1893   {$ENDIF}
1894 
1895   // rtl.module(...
1896   AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
1897   AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
1898   AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
1899   FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
1900   AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
1901   AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
1902   AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
1903   FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
1904 
1905   // parameter 'unitname'
1906   if JSModuleCallArgs.Elements.Count<1 then
1907     Fail('rtl.module first param unit missing');
1908   Arg:=JSModuleCallArgs.Elements.Elements[0];
1909   AssertNotNull('module name param',Arg.Expr);
1910   ModuleNameExpr:=Arg.Expr as TJSLiteral;
1911   AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
1912   if Module is TPasProgram then
1913     AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
1914   else
1915     AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
1916 
1917   // main uses section
1918   if JSModuleCallArgs.Elements.Count<2 then
1919     Fail('rtl.module second param main uses missing');
1920   Arg:=JSModuleCallArgs.Elements.Elements[1];
1921   CheckUsesList('interface',Arg,FJSInterfaceUses);
1922 
1923   // program/library/interface function()
ifnull1924   if JSModuleCallArgs.Elements.Count<3 then
1925     Fail('rtl.module third param intf-function missing');
1926   Arg:=JSModuleCallArgs.Elements.Elements[2];
1927   CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
1928 
1929   // search for $mod.$init or $mod.$main - the last statement
1930   if Module is TPasProgram then
1931     begin
1932     InitName:='$main';
1933     AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
1934     end
1935   else
1936     InitName:='$init';
1937   FJSInitBody:=nil;
1938   if JSModuleSrc.Statements.Count>0 then
1939     begin
1940     LastNode:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node;
1941     if LastNode is TJSSimpleAssignStatement then
1942       begin
1943       InitAssign:=LastNode as TJSSimpleAssignStatement;
1944       if GetDottedIdentifier(InitAssign.LHS)='$mod.'+InitName then
1945         begin
1946         InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
1947         FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
1948         end
1949       else if Module is TPasProgram then
1950         CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
1951       end;
1952     end;
1953 
1954   // optional: implementation uses section
1955   if JSModuleCallArgs.Elements.Count<4 then
1956     exit;
1957   Arg:=JSModuleCallArgs.Elements.Elements[3];
1958   CheckUsesList('implementation',Arg,FJSImplentationUses);
1959 
1960   // optional: implementation function()
ifnull1961   if JSModuleCallArgs.Elements.Count<5 then
1962     exit;
1963   Arg:=JSModuleCallArgs.Elements.Elements[4];
1964   CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
1965 end;
1966 
1967 procedure TCustomTestModule.ConvertProgram;
1968 begin
1969   Add('end.');
1970   ParseProgram;
1971   ConvertModule;
1972 end;
1973 
1974 procedure TCustomTestModule.ConvertUnit;
1975 begin
1976   Add('end.');
1977   ParseUnit;
1978   ConvertModule;
1979 end;
1980 
TCustomTestModule.ConvertJSModuleToStringnull1981 function TCustomTestModule.ConvertJSModuleToString(El: TJSElement): string;
1982 begin
1983   Result:=tcmodules.JSToStr(El);
1984 end;
1985 
1986 procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
1987   DottedName: string);
1988 begin
1989   if DottedName='' then
1990     begin
1991     AssertNull(Msg,El);
1992     end
1993   else
1994     begin
1995     AssertNotNull(Msg,El);
1996     AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
1997     end;
1998 end;
1999 
TCustomTestModule.GetDottedIdentifiernull2000 function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
2001 begin
2002   if El=nil then
2003     Result:=''
2004   else if El is TJSPrimaryExpressionIdent then
2005     Result:=String(TJSPrimaryExpressionIdent(El).Name)
2006   else if El is TJSDotMemberExpression then
2007     Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
2008   else
2009     AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
2010 end;
2011 
2012 procedure TCustomTestModule.CheckSource(Msg, Statements: String;
2013   InitStatements: string; ImplStatements: string);
2014 var
2015   ActualSrc, ExpectedSrc, InitName: String;
2016 begin
2017   ActualSrc:=JSToStr(JSModuleSrc);
2018   ExpectedSrc:=
2019     'var $mod = this;'+LineEnding
2020    +Statements;
2021   if coUseStrict in Converter.Options then
2022     ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
2023   if Module is TPasProgram then
2024     InitName:='$main'
2025   else
2026     InitName:='$init';
2027   if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
2028     ExpectedSrc:=ExpectedSrc+LineEnding
2029       +'$mod.'+InitName+' = function () {'+LineEnding
2030       +InitStatements
2031       +'};'+LineEnding;
2032   //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
2033   //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
2034   CheckDiff(Msg,ExpectedSrc,ActualSrc);
2035 
2036   if (JSImplementationSrc<>nil) then
2037     begin
2038     ActualSrc:=JSToStr(JSImplementationSrc);
2039     ExpectedSrc:=
2040       'var $mod = this;'+LineEnding
2041      +'var $impl = $mod.$impl;'+LineEnding
2042      +ImplStatements;
2043     end
2044   else
2045     begin
2046     ActualSrc:='';
2047     ExpectedSrc:=ImplStatements;
2048     end;
2049   //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
2050   //writeln('TCustomTestModule.CheckSource Expected: ',ExpectedSrc);
2051 
2052   CheckDiff(Msg,ExpectedSrc,ActualSrc);
2053 end;
2054 
2055 procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
2056 // search diff, ignore changes in spaces
2057 var
2058   s: string;
2059 begin
2060   if CheckSrcDiff(Expected,Actual,s) then exit;
2061   Fail(Msg+': '+s);
2062 end;
2063 
2064 procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string);
2065 var
2066   aResolver: TTestEnginePasResolver;
2067   aConverter: TPasToJSConverter;
2068   aJSModule: TJSSourceElements;
2069   ActualSrc: String;
2070 begin
2071   aResolver:=GetResolver(Filename);
2072   AssertNotNull('missing resolver of unit '+Filename,aResolver);
2073   {$IFDEF VerbosePas2JS}
2074   writeln('CheckUnit '+Filename+' converting ...');
2075   {$ENDIF}
2076   aConverter:=CreateConverter;
2077   aJSModule:=nil;
2078   try
2079     try
2080       aJSModule:=aConverter.ConvertPasElement(aResolver.Module,aResolver) as TJSSourceElements;
2081     except
2082       on E: Exception do
2083         HandleException(E);
2084     end;
2085     ActualSrc:=ConvertJSModuleToString(aJSModule);
2086     {$IFDEF VerbosePas2JS}
2087     writeln('TTestModule.CheckUnit ',Filename,' Pas:');
2088     write(aResolver.Source);
2089     writeln('TTestModule.CheckUnit ',Filename,' JS:');
2090     write(ActualSrc);
2091     {$ENDIF}
2092     CheckDiff('Converted unit: "'+ChangeFileExt(Filename,'.js')+'"',ExpectedSrc,ActualSrc);
2093   finally
2094     aJSModule.Free;
2095     aConverter.Free;
2096   end;
2097 end;
2098 
2099 procedure TCustomTestModule.CheckHint(MsgType: TMessageType;
2100   MsgNumber: integer; Msg: string; Marker: PSrcMarker);
2101 var
2102   i: Integer;
2103   Item: TTestHintMessage;
2104   Expected,Actual: string;
2105 begin
2106   //writeln('TCustomTestModule.CheckHint MsgCount=',MsgCount);
2107   for i:=0 to MsgCount-1 do
2108     begin
2109     Item:=Msgs[i];
2110     if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
2111     if (Marker<>nil) then
2112       begin
2113       if Item.SourcePos.Row<>cardinal(Marker^.Row) then continue;
2114       if (Item.SourcePos.Column<cardinal(Marker^.StartCol))
2115           or (Item.SourcePos.Column>cardinal(Marker^.EndCol)) then continue;
2116       end;
2117     // found
2118     FHintMsgsGood.Add(Item);
2119     str(Item.MsgType,Actual);
2120     str(MsgType,Expected);
2121     AssertEquals('MsgType',Expected,Actual);
2122     exit;
2123     end;
2124 
2125   // needed message missing -> show emitted messages
2126   WriteSources('',0,0);
2127   for i:=0 to MsgCount-1 do
2128     begin
2129     Item:=Msgs[i];
2130     write('TCustomTestModule.CheckHint ',i,'/',MsgCount,' ',Item.MsgType,
2131       ' ('+IntToStr(Item.MsgNumber),')');
2132     if Marker<>nil then
2133       write(' '+ExtractFileName(Item.SourcePos.FileName),'(',Item.SourcePos.Row,',',Item.SourcePos.Column,')');
2134     writeln(' {',Item.Msg,'}');
2135     end;
2136   str(MsgType,Expected);
2137   Actual:='Missing '+Expected+' ('+IntToStr(MsgNumber)+')';
2138   if Marker<>nil then
2139     Actual:=Actual+' '+ExtractFileName(Marker^.Filename)+'('+IntToStr(Marker^.Row)+','+IntToStr(Marker^.StartCol)+'..'+IntToStr(Marker^.EndCol)+')';
2140   Actual:=Actual+' '+Msg;
2141   Fail(Actual);
2142 end;
2143 
2144 procedure TCustomTestModule.CheckResolverUnexpectedHints(WithSourcePos: boolean
2145   );
2146 var
2147   i: Integer;
2148   s, Txt: String;
2149   Msg: TTestHintMessage;
2150 begin
2151   for i:=0 to MsgCount-1 do
2152     begin
2153     Msg:=Msgs[i];
2154     if FHintMsgsGood.IndexOf(Msg)>=0 then continue;
2155     s:='';
2156     str(Msg.MsgType,s);
2157     Txt:='Unexpected resolver message found ['+IntToStr(Msg.Id)+'] '
2158       +s+': ('+IntToStr(Msg.MsgNumber)+')';
2159     if WithSourcePos then
2160       Txt:=Txt+' '+ExtractFileName(Msg.SourcePos.FileName)+'('+IntToStr(Msg.SourcePos.Row)+','+IntToStr(Msg.SourcePos.Column)+')';
2161     Txt:=Txt+' {'+Msg.Msg+'}';
2162     Fail(Txt);
2163     end;
2164 end;
2165 
2166 procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
2167   MsgNumber: integer);
2168 begin
2169   ExpectedErrorClass:=EScannerError;
2170   ExpectedErrorMsg:=Msg;
2171   ExpectedErrorNumber:=MsgNumber;
2172 end;
2173 
2174 procedure TCustomTestModule.SetExpectedParserError(Msg: string;
2175   MsgNumber: integer);
2176 begin
2177   ExpectedErrorClass:=EParserError;
2178   ExpectedErrorMsg:=Msg;
2179   ExpectedErrorNumber:=MsgNumber;
2180 end;
2181 
2182 procedure TCustomTestModule.SetExpectedPasResolverError(Msg: string;
2183   MsgNumber: integer);
2184 begin
2185   ExpectedErrorClass:=EPasResolve;
2186   ExpectedErrorMsg:=Msg;
2187   ExpectedErrorNumber:=MsgNumber;
2188 end;
2189 
2190 procedure TCustomTestModule.SetExpectedConverterError(Msg: string;
2191   MsgNumber: integer);
2192 begin
2193   ExpectedErrorClass:=EPas2JS;
2194   ExpectedErrorMsg:=Msg;
2195   ExpectedErrorNumber:=MsgNumber;
2196 end;
2197 
IsErrorExpectednull2198 function TCustomTestModule.IsErrorExpected(E: Exception): boolean;
2199 var
2200   MsgNumber: Integer;
2201   Msg: String;
2202 begin
2203   Result:=false;
2204   if (ExpectedErrorClass=nil) or (ExpectedErrorClass<>E.ClassType) then exit;
2205   Msg:=E.Message;
2206   if E is EPas2JS then
2207     MsgNumber:=EPas2JS(E).MsgNumber
2208   else if E is EPasResolve then
2209     MsgNumber:=EPasResolve(E).MsgNumber
2210   else if E is EParserError then
2211     MsgNumber:=Parser.LastMsgNumber
2212   else if E is EScannerError then
2213     begin
2214     MsgNumber:=Scanner.LastMsgNumber;
2215     Msg:=Scanner.LastMsg;
2216     end
2217   else
2218     MsgNumber:=0;
2219   Result:=(MsgNumber=ExpectedErrorNumber) and (Msg=ExpectedErrorMsg);
2220   if Result then
2221     SkipTests:=true;
2222 end;
2223 
2224 procedure TCustomTestModule.HandleScannerError(E: EScannerError);
2225 begin
2226   if IsErrorExpected(E) then exit;
2227   WriteSources(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn);
2228   writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
2229     +' '+Scanner.CurFilename
2230     +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
2231   FailException(E);
2232 end;
2233 
2234 procedure TCustomTestModule.HandleParserError(E: EParserError);
2235 begin
2236   if IsErrorExpected(E) then exit;
2237   WriteSources(E.Filename,E.Row,E.Column);
2238   writeln('ERROR: TCustomTestModule.HandleParserError '+E.ClassName+':'+E.Message
2239     +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
2240     +' MainModuleScannerLine="'+Scanner.CurLine+'"'
2241     );
2242   FailException(E);
2243 end;
2244 
2245 procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
2246 var
2247   P: TPasSourcePos;
2248 begin
2249   if IsErrorExpected(E) then exit;
2250   P:=E.SourcePos;
2251   WriteSources(P.FileName,P.Row,P.Column);
2252   writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
2253     +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
2254   FailException(E);
2255 end;
2256 
2257 procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
2258 var
2259   Row, Col: integer;
2260 begin
2261   if IsErrorExpected(E) then exit;
2262   Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
2263   WriteSources(E.PasElement.SourceFilename,Row,Col);
2264   writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
2265     +' '+E.PasElement.SourceFilename
2266     +'('+IntToStr(Row)+','+IntToStr(Col)+')');
2267   FailException(E);
2268 end;
2269 
2270 procedure TCustomTestModule.HandleException(E: Exception);
2271 begin
2272   if E is EScannerError then
2273     HandleScannerError(EScannerError(E))
2274   else if E is EParserError then
2275     HandleParserError(EParserError(E))
2276   else if E is EPasResolve then
2277     HandlePasResolveError(EPasResolve(E))
2278   else if E is EPas2JS then
2279     HandlePas2JSError(EPas2JS(E))
2280   else
2281     begin
2282     if IsErrorExpected(E) then exit;
2283     if not (E is EAssertionFailedError) then
2284       begin
2285       WriteSources('',0,0);
2286       writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
2287       end;
2288     FailException(E);
2289     end;
2290 end;
2291 
2292 procedure TCustomTestModule.FailException(E: Exception);
2293 var
2294   MsgNumber: Integer;
2295 begin
2296   if ExpectedErrorClass<>nil then
2297   begin
2298     if FExpectedErrorClass=E.ClassType then
2299     begin
2300       if E is EPas2JS then
2301         MsgNumber:=EPas2JS(E).MsgNumber
2302       else if E is EPasResolve then
2303         MsgNumber:=EPasResolve(E).MsgNumber
2304       else if E is EParserError then
2305         MsgNumber:=Parser.LastMsgNumber
2306       else if E is EScannerError then
2307         MsgNumber:=Scanner.LastMsgNumber
2308       else
2309         MsgNumber:=0;
2310       AssertEquals('Expected error message ('+IntToStr(ExpectedErrorNumber)+')','{'+ExpectedErrorMsg+'}','{'+E.Message+'}');
2311       AssertEquals('Expected {'+ExpectedErrorMsg+'}, but got msg {'+E.Message+'} number',
2312         ExpectedErrorNumber,MsgNumber);
2313     end else begin
2314       AssertEquals('Wrong exception class',ExpectedErrorClass.ClassName,E.ClassName);
2315     end;
2316   end;
2317   Fail(E.Message);
2318 end;
2319 
2320 procedure TCustomTestModule.WriteSources(const aFilename: string; aRow,
2321   aCol: integer);
2322 var
2323   IsSrc: Boolean;
2324   i, j: Integer;
2325   SrcLines: TStringList;
2326   Line: string;
2327   aModule: TTestEnginePasResolver;
2328 begin
2329   writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
2330   for i:=0 to ResolverCount-1 do
2331     begin
2332     aModule:=Resolvers[i];
2333     SrcLines:=TStringList.Create;
2334     try
2335       SrcLines.Text:=aModule.Source;
2336       IsSrc:=ExtractFilename(aModule.Filename)=ExtractFileName(aFilename);
2337       writeln('Testcode:-File="',aModule.Filename,'"----------------------------------:');
2338       for j:=1 to SrcLines.Count do
2339         begin
2340         Line:=SrcLines[j-1];
2341         if IsSrc and (j=aRow) then
2342           begin
2343           write('*');
2344           Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
2345           end;
2346         writeln(Format('%:4d: ',[j]),Line);
2347         end;
2348     finally
2349       SrcLines.Free;
2350     end;
2351     end;
2352 end;
2353 
TCustomTestModule.IndexOfResolvernull2354 function TCustomTestModule.IndexOfResolver(const Filename: string): integer;
2355 var
2356   i: Integer;
2357 begin
2358   for i:=0 to ResolverCount-1 do
2359     if Filename=Resolvers[i].Filename then exit(i);
2360   Result:=-1;
2361 end;
2362 
GetResolvernull2363 function TCustomTestModule.GetResolver(const Filename: string
2364   ): TTestEnginePasResolver;
2365 var
2366   i: Integer;
2367 begin
2368   i:=IndexOfResolver(Filename);
2369   if i<0 then exit(nil);
2370   Result:=Resolvers[i];
2371 end;
2372 
GetDefaultNamespacenull2373 function TCustomTestModule.GetDefaultNamespace: string;
2374 var
2375   C: TClass;
2376 begin
2377   Result:='';
2378   if FModule=nil then exit;
2379   C:=FModule.ClassType;
2380   if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
2381     Result:=Engine.DefaultNameSpace;
2382 end;
2383 
2384 constructor TCustomTestModule.Create;
2385 begin
2386   inherited Create;
2387   FHintMsgs:=TObjectList.Create(true);
2388   FHintMsgsGood:=TFPList.Create;
2389 end;
2390 
2391 destructor TCustomTestModule.Destroy;
2392 begin
2393   FreeAndNil(FHintMsgs);
2394   FreeAndNil(FHintMsgsGood);
2395   inherited Destroy;
2396 end;
2397 
2398 { TTestModule }
2399 
2400 procedure TTestModule.TestReservedWords;
2401 var
2402   i: integer;
2403 begin
2404   for i:=low(JSReservedWords) to High(JSReservedWords)-1 do
2405     if CompareStr(JSReservedWords[i],JSReservedWords[i+1])>=0 then
2406       Fail('20170203135442 '+JSReservedWords[i]+' >= '+JSReservedWords[i+1]);
2407   for i:=low(JSReservedGlobalWords) to High(JSReservedGlobalWords)-1 do
2408     if CompareStr(JSReservedGlobalWords[i],JSReservedGlobalWords[i+1])>=0 then
2409       Fail('20170203135443 '+JSReservedGlobalWords[i]+' >= '+JSReservedGlobalWords[i+1]);
2410 end;
2411 
2412 procedure TTestModule.TestEmptyProgram;
2413 begin
2414   StartProgram(false);
2415   Add('begin');
2416   ConvertProgram;
2417   CheckSource('TestEmptyProgram','','');
2418 end;
2419 
2420 procedure TTestModule.TestEmptyProgramUseStrict;
2421 begin
2422   Converter.Options:=Converter.Options+[coUseStrict];
2423   StartProgram(false);
2424   Add('begin');
2425   ConvertProgram;
2426   CheckSource('TestEmptyProgramUseStrict','','');
2427 end;
2428 
2429 procedure TTestModule.TestEmptyUnit;
2430 begin
2431   StartUnit(false);
2432   Add('interface');
2433   Add('implementation');
2434   ConvertUnit;
2435   CheckSource('TestEmptyUnit',
2436     LinesToStr([
2437     ]),
2438     '');
2439 end;
2440 
2441 procedure TTestModule.TestEmptyUnitUseStrict;
2442 begin
2443   Converter.Options:=Converter.Options+[coUseStrict];
2444   StartUnit(false);
2445   Add('interface');
2446   Add('implementation');
2447   ConvertUnit;
2448   CheckSource('TestEmptyUnitUseStrict',
2449     LinesToStr([
2450     ''
2451     ]),
2452     '');
2453 end;
2454 
2455 procedure TTestModule.TestDottedUnitNames;
2456 begin
2457   AddModuleWithIntfImplSrc('NS1.Unit2.pas',
2458     LinesToStr([
2459     'var iV: longint;'
2460     ]),
2461     '');
2462 
2463   FFilename:='ns1.test1.pp';
2464   StartProgram(true);
2465   Add('uses unIt2;');
2466   Add('var');
2467   Add('  i: longint;');
2468   Add('begin');
2469   Add('  i:=iv;');
2470   Add('  i:=uNit2.iv;');
2471   Add('  i:=Ns1.TEst1.i;');
2472   ConvertProgram;
2473   CheckSource('TestDottedUnitNames',
2474     LinesToStr([
2475     'this.i = 0;',
2476     '']),
2477     LinesToStr([ // this.$init
2478     '$mod.i = pas["NS1.Unit2"].iV;',
2479     '$mod.i = pas["NS1.Unit2"].iV;',
2480     '$mod.i = $mod.i;',
2481     '']) );
2482 end;
2483 
2484 procedure TTestModule.TestDottedUnitNameImpl;
2485 begin
2486   AddModuleWithIntfImplSrc('TEST.UnitA.pas',
2487     LinesToStr([
2488     'type',
2489     '  TObject = class end;',
2490     '  TTestA = class',
2491     '  end;'
2492     ]),
2493     LinesToStr(['uses TEST.UnitB;'])
2494     );
2495   AddModuleWithIntfImplSrc('TEST.UnitB.pas',
2496     LinesToStr([
2497     'uses TEST.UnitA;',
2498     'type TTestB = class(TTestA);'
2499     ]),
2500     ''
2501     );
2502   StartProgram(true);
2503   Add('uses TEST.UnitA;');
2504   Add('begin');
2505   ConvertProgram;
2506   CheckSource('TestDottedUnitNameImpl',
2507     LinesToStr([
2508     '']),
2509     LinesToStr([ // this.$init
2510     '']) );
2511   CheckUnit('TEST.UnitA.pas',
2512     LinesToStr([
2513     'rtl.module("TEST.UnitA", ["system"], function () {',
2514     '  var $mod = this;',
2515     '  rtl.createClass($mod, "TObject", null, function () {',
2516     '    this.$init = function () {',
2517     '    };',
2518     '    this.$final = function () {',
2519     '    };',
2520     '  });',
2521     '  rtl.createClass($mod, "TTestA", $mod.TObject, function () {',
2522     '  });',
2523     '}, ["TEST.UnitB"]);'
2524     ]));
2525   CheckUnit('TEST.UnitB.pas',
2526     LinesToStr([
2527     'rtl.module("TEST.UnitB", ["system","TEST.UnitA"], function () {',
2528     '  var $mod = this;',
2529     '  rtl.createClass($mod, "TTestB", pas["TEST.UnitA"].TTestA, function () {',
2530     '  });',
2531     '});'
2532     ]));
2533 end;
2534 
2535 procedure TTestModule.TestDottedUnitExpr;
2536 begin
2537   AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
2538     LinesToStr([
2539     'procedure DoIt;'
2540     ]),
2541     'procedure DoIt; begin end;');
2542 
2543   FFilename:='Ns1.SubNs1.Test1.pp';
2544   StartProgram(true);
2545   Add('uses Ns2.sUbnS2.unIt2;');
2546   Add('var');
2547   Add('  i: longint;');
2548   Add('begin');
2549   Add('  ns2.subns2.unit2.doit;');
2550   Add('  i:=Ns1.SubNS1.TEst1.i;');
2551   ConvertProgram;
2552   CheckSource('TestDottedUnitExpr',
2553     LinesToStr([
2554     'this.i = 0;',
2555     '']),
2556     LinesToStr([ // this.$init
2557     'pas["NS2.SubNs2.Unit2"].DoIt();',
2558     '$mod.i = $mod.i;',
2559     '']) );
2560 end;
2561 
2562 procedure TTestModule.Test_ModeFPCFail;
2563 begin
2564   StartProgram(false);
2565   Add('{$mode FPC}');
2566   Add('begin');
2567   SetExpectedScannerError('Invalid mode: "FPC"',nErrInvalidMode);
2568   ConvertProgram;
2569 end;
2570 
2571 procedure TTestModule.Test_ModeSwitchCBlocksFail;
2572 begin
2573   StartProgram(false);
2574   Add('{$modeswitch cblocks-}');
2575   Add('begin');
2576   ConvertProgram;
2577   CheckHint(mtWarning,nErrInvalidModeSwitch,'Warning: test1.pp(3,23) : Invalid mode switch: "cblocks"');
2578   CheckResolverUnexpectedHints();
2579 end;
2580 
2581 procedure TTestModule.TestUnit_UseSystem;
2582 begin
2583   StartUnit(true);
2584   Add([
2585   'interface',
2586   'var i: integer;',
2587   'implementation']);
2588   ConvertUnit;
2589   CheckSource('TestUnit_UseSystem',
2590     LinesToStr([
2591     'this.i = 0;',
2592     '']),
2593     LinesToStr([
2594     '']) );
2595 end;
2596 
2597 procedure TTestModule.TestUnit_Intf1Impl2Intf1;
2598 begin
2599   AddModuleWithIntfImplSrc('unit1.pp',
2600     LinesToStr([
2601     'type number = longint;']),
2602     LinesToStr([
2603     'uses test1;',
2604     'procedure DoIt;',
2605     'begin',
2606     '  i:=3;',
2607     'end;']));
2608 
2609   StartUnit(true);
2610   Add([
2611   'interface',
2612   'uses unit1;',
2613   'var i: number;',
2614   'implementation']);
2615   ConvertUnit;
2616   CheckSource('TestUnit_Intf1Impl2Intf1',
2617     LinesToStr([
2618     'this.i = 0;',
2619     '']),
2620     LinesToStr([
2621     '']) );
2622 end;
2623 
2624 procedure TTestModule.TestIncludeVersion;
2625 begin
2626   StartProgram(false);
2627   Add([
2628   'var',
2629   '  s: string;',
2630   '  i: word;',
2631   'begin',
2632   '  s:={$I %line%};',
2633   '  i:={$I %linenum%};',
2634   '  s:={$I %currentroutine%};',
2635   '  s:={$I %pas2jsversion%};',
2636   '  s:={$I %pas2jstarget%};',
2637   '  s:={$I %pas2jstargetos%};',
2638   '  s:={$I %pas2jstargetcpu%};',
2639   '  s:={$I %file%};',
2640   '']);
2641   ConvertProgram;
2642   CheckSource('TestIncludeVersion',
2643     LinesToStr([
2644     'this.s="";',
2645     'this.i = 0;']),
2646     LinesToStr([
2647     '$mod.s = "7";',
2648     '$mod.i = 8;',
2649     '$mod.s = "<anonymous>";',
2650     '$mod.s = "Comp.Ver.tcmodules";',
2651     '$mod.s = "Browser";',
2652     '$mod.s = "Browser";',
2653     '$mod.s = "ECMAScript5";',
2654     '$mod.s = "test1.pp";',
2655     '']));
2656 end;
2657 
2658 procedure TTestModule.TestVarInt;
2659 begin
2660   StartProgram(false);
2661   Add('var MyI: longint;');
2662   Add('begin');
2663   ConvertProgram;
2664   CheckSource('TestVarInt','this.MyI=0;','');
2665 end;
2666 
2667 procedure TTestModule.TestVarBaseTypes;
2668 begin
2669   StartProgram(false);
2670   Add('var');
2671   Add('  i: longint;');
2672   Add('  s: string;');
2673   Add('  c: char;');
2674   Add('  b: boolean;');
2675   Add('  d: double;');
2676   Add('  i2: longint = 3;');
2677   Add('  s2: string = ''foo'';');
2678   Add('  c2: char = ''4'';');
2679   Add('  b2: boolean = true;');
2680   Add('  d2: double = 5.6;');
2681   Add('  i3: longint = $707;');
2682   Add('  i4: nativeint = 9007199254740991;');
2683   Add('  i5: nativeint = -9007199254740991-1;');
2684   Add('  i6: nativeint =   $fffffffffffff;');
2685   Add('  i7: nativeint = -$fffffffffffff-1;');
2686   Add('  i8: byte = 00;');
2687   Add('  u8: nativeuint =  $fffffffffffff;');
2688   Add('  u9: nativeuint =  $0000000000000;');
2689   Add('  u10: nativeuint = $00ff00;');
2690   Add('begin');
2691   ConvertProgram;
2692   CheckSource('TestVarBaseTypes',
2693     LinesToStr([
2694     'this.i = 0;',
2695     'this.s = "";',
2696     'this.c = "";',
2697     'this.b = false;',
2698     'this.d = 0.0;',
2699     'this.i2 = 3;',
2700     'this.s2 = "foo";',
2701     'this.c2 = "4";',
2702     'this.b2 = true;',
2703     'this.d2 = 5.6;',
2704     'this.i3 = 0x707;',
2705     'this.i4 = 9007199254740991;',
2706     'this.i5 = -9007199254740991-1;',
2707     'this.i6 = 0xfffffffffffff;',
2708     'this.i7 =-0xfffffffffffff-1;',
2709     'this.i8 = 0;',
2710     'this.u8 = 0xfffffffffffff;',
2711     'this.u9 = 0x0;',
2712     'this.u10 = 0xff00;'
2713     ]),
2714     '');
2715 end;
2716 
2717 procedure TTestModule.TestBaseTypeSingleFail;
2718 begin
2719   StartProgram(false);
2720   Add('var s: single;');
2721   SetExpectedPasResolverError('identifier not found "single"',PasResolveEval.nIdentifierNotFound);
2722   ConvertProgram;
2723 end;
2724 
2725 procedure TTestModule.TestBaseTypeExtendedFail;
2726 begin
2727   StartProgram(false);
2728   Add('var e: extended;');
2729   SetExpectedPasResolverError('identifier not found "extended"',PasResolveEval.nIdentifierNotFound);
2730   ConvertProgram;
2731 end;
2732 
2733 procedure TTestModule.TestConstBaseTypes;
2734 begin
2735   StartProgram(false);
2736   Add('const');
2737   Add('  i: longint = 3;');
2738   Add('  s: string = ''foo'';');
2739   Add('  c: char = ''4'';');
2740   Add('  b: boolean = true;');
2741   Add('  d: double = 5.6;');
2742   Add('  e = low(word);');
2743   Add('  f = high(word);');
2744   Add('begin');
2745   ConvertProgram;
2746   CheckSource('TestVarBaseTypes',
2747     LinesToStr([
2748     'this.i=3;',
2749     'this.s="foo";',
2750     'this.c="4";',
2751     'this.b=true;',
2752     'this.d=5.6;',
2753     'this.e = 0;',
2754     'this.f = 65535;'
2755     ]),
2756     '');
2757 end;
2758 
2759 procedure TTestModule.TestAliasTypeRef;
2760 begin
2761   StartProgram(false);
2762   Add('type');
2763   Add('  a=longint;');
2764   Add('  b=a;');
2765   Add('var');
2766   Add('  c: A;');
2767   Add('  d: B;');
2768   Add('begin');
2769   ConvertProgram;
2770   CheckSource('TestAliasTypeRef',
2771     LinesToStr([ // statements
2772     'this.c = 0;',
2773     'this.d = 0;'
2774     ]),
2775     LinesToStr([ // this.$main
2776     ''
2777     ]));
2778 end;
2779 
2780 procedure TTestModule.TestTypeCast_BaseTypes;
2781 begin
2782   StartProgram(false);
2783   Add([
2784   'var',
2785   '  i: longint;',
2786   '  b: boolean;',
2787   '  d: double;',
2788   '  s: string;',
2789   '  c: char;',
2790   'begin',
2791   '  i:=longint(i);',
2792   '  i:=longint(b);',
2793   '  b:=boolean(b);',
2794   '  b:=boolean(i);',
2795   '  d:=double(d);',
2796   '  d:=double(i);',
2797   '  s:=string(s);',
2798   '  s:=string(c);',
2799   '  c:=char(c);',
2800   '  c:=char(i);',
2801   '  c:=char(65);',
2802   '  c:=char(#10);',
2803   '  c:=char(#$E000);',
2804   '']);
2805   ConvertProgram;
2806   CheckSource('TestAliasTypeRef',
2807     LinesToStr([ // statements
2808     'this.i = 0;',
2809     'this.b = false;',
2810     'this.d = 0.0;',
2811     'this.s = "";',
2812     'this.c = "";',
2813     '']),
2814     LinesToStr([ // this.$main
2815     '$mod.i = $mod.i;',
2816     '$mod.i = ($mod.b ? 1 : 0);',
2817     '$mod.b = $mod.b;',
2818     '$mod.b = $mod.i != 0;',
2819     '$mod.d = $mod.d;',
2820     '$mod.d = $mod.i;',
2821     '$mod.s = $mod.s;',
2822     '$mod.s = $mod.c;',
2823     '$mod.c = $mod.c;',
2824     '$mod.c = String.fromCharCode($mod.i);',
2825     '$mod.c = "A";',
2826     '$mod.c = "\n";',
2827     '$mod.c = "";',
2828     '']));
2829 end;
2830 
2831 procedure TTestModule.TestTypeCast_AliasBaseTypes;
2832 begin
2833   StartProgram(false);
2834   Add('type');
2835   Add('  integer = longint;');
2836   Add('  TYesNo = boolean;');
2837   Add('  TFloat = double;');
2838   Add('  TCaption = string;');
2839   Add('  TChar = char;');
2840   Add('var');
2841   Add('  i: integer;');
2842   Add('  b: TYesNo;');
2843   Add('  d: TFloat;');
2844   Add('  s: TCaption;');
2845   Add('  c: TChar;');
2846   Add('begin');
2847   Add('  i:=integer(i);');
2848   Add('  i:=integer(b);');
2849   Add('  b:=TYesNo(b);');
2850   Add('  b:=TYesNo(i);');
2851   Add('  d:=TFloat(d);');
2852   Add('  d:=TFloat(i);');
2853   Add('  s:=TCaption(s);');
2854   Add('  s:=TCaption(c);');
2855   Add('  c:=TChar(c);');
2856   ConvertProgram;
2857   CheckSource('TestAliasTypeRef',
2858     LinesToStr([ // statements
2859     'this.i = 0;',
2860     'this.b = false;',
2861     'this.d = 0.0;',
2862     'this.s = "";',
2863     'this.c = "";',
2864     '']),
2865     LinesToStr([ // this.$main
2866     '$mod.i = $mod.i;',
2867     '$mod.i = ($mod.b ? 1 : 0);',
2868     '$mod.b = $mod.b;',
2869     '$mod.b = $mod.i != 0;',
2870     '$mod.d = $mod.d;',
2871     '$mod.d = $mod.i;',
2872     '$mod.s = $mod.s;',
2873     '$mod.s = $mod.c;',
2874     '$mod.c = $mod.c;',
2875     '']));
2876 end;
2877 
2878 procedure TTestModule.TestEmptyProc;
2879 begin
2880   StartProgram(false);
2881   Add('procedure Test;');
2882   Add('begin');
2883   Add('end;');
2884   Add('begin');
2885   ConvertProgram;
2886   CheckSource('TestEmptyProc',
2887     LinesToStr([ // statements
2888     'this.Test = function () {',
2889     '};'
2890     ]),
2891     LinesToStr([ // this.$main
2892     ''
2893     ]));
2894 end;
2895 
2896 procedure TTestModule.TestProcOneParam;
2897 begin
2898   StartProgram(false);
2899   Add('procedure ProcA(i: longint);');
2900   Add('begin');
2901   Add('end;');
2902   Add('begin');
2903   Add('  PROCA(3);');
2904   ConvertProgram;
2905   CheckSource('TestProcOneParam',
2906     LinesToStr([ // statements
2907     'this.ProcA = function (i) {',
2908     '};'
2909     ]),
2910     LinesToStr([ // this.$main
2911     '$mod.ProcA(3);'
2912     ]));
2913 end;
2914 
2915 procedure TTestModule.TestFunctionWithoutParams;
2916 begin
2917   StartProgram(false);
2918   Add('function FuncA: longint;');
2919   Add('begin');
2920   Add('end;');
2921   Add('var i: longint;');
2922   Add('begin');
2923   Add('  I:=FUNCA();');
2924   Add('  I:=FUNCA;');
2925   Add('  FUNCA();');
2926   Add('  FUNCA;');
2927   ConvertProgram;
2928   CheckSource('TestProcWithoutParams',
2929     LinesToStr([ // statements
2930     'this.FuncA = function () {',
2931     '  var Result = 0;',
2932     '  return Result;',
2933     '};',
2934     'this.i=0;'
2935     ]),
2936     LinesToStr([ // this.$main
2937     '$mod.i=$mod.FuncA();',
2938     '$mod.i=$mod.FuncA();',
2939     '$mod.FuncA();',
2940     '$mod.FuncA();'
2941     ]));
2942 end;
2943 
2944 procedure TTestModule.TestProcedureWithoutParams;
2945 begin
2946   StartProgram(false);
2947   Add('procedure ProcA;');
2948   Add('begin');
2949   Add('end;');
2950   Add('begin');
2951   Add('  PROCA();');
2952   Add('  PROCA;');
2953   ConvertProgram;
2954   CheckSource('TestProcWithoutParams',
2955     LinesToStr([ // statements
2956     'this.ProcA = function () {',
2957     '};'
2958     ]),
2959     LinesToStr([ // this.$main
2960     '$mod.ProcA();',
2961     '$mod.ProcA();'
2962     ]));
2963 end;
2964 
2965 procedure TTestModule.TestIncDec;
2966 begin
2967   StartProgram(false);
2968   Add([
2969   'procedure DoIt(var i: longint);',
2970   'begin',
2971   '  inc(i);',
2972   '  inc(i,2);',
2973   'end;',
2974   'var',
2975   '  Bar: longint;',
2976   'begin',
2977   '  inc(bar);',
2978   '  inc(bar,2);',
2979   '  dec(bar);',
2980   '  dec(bar,3);',
2981   '']);
2982   ConvertProgram;
2983   CheckSource('TestIncDec',
2984     LinesToStr([ // statements
2985     'this.DoIt = function (i) {',
2986     '  i.set(i.get()+1);',
2987     '  i.set(i.get()+2);',
2988     '};',
2989     'this.Bar = 0;'
2990     ]),
2991     LinesToStr([ // this.$main
2992     '$mod.Bar+=1;',
2993     '$mod.Bar+=2;',
2994     '$mod.Bar-=1;',
2995     '$mod.Bar-=3;'
2996     ]));
2997 end;
2998 
2999 procedure TTestModule.TestLoHiFpcMode;
3000 begin
3001   StartProgram(false);
3002   Add([
3003   '{$mode objfpc}',
3004   'const',
3005   '  LoByte1 = Lo(Word($1234));',
3006   '  HiByte1 = Hi(Word($1234));',
3007   '  LoByte2 = Lo(SmallInt($1234));',
3008   '  HiByte2 = Hi(SmallInt($1234));',
3009   '  LoWord1 = Lo($1234CDEF);',
3010   '  HiWord1 = Hi($1234CDEF);',
3011   '  LoWord2 = Lo(-$1234CDEF);',
3012   '  HiWord2 = Hi(-$1234CDEF);',
3013   '  lo4:byte=lo(byte($34));',
3014   '  hi4:byte=hi(byte($34));',
3015   '  lo5:byte=lo(shortint(-$34));',
3016   '  hi5:byte=hi(shortint(-$34));',
3017   '  lo6:longword=lo($123456789ABCD);',
3018   '  hi6:longword=hi($123456789ABCD);',
3019   '  lo7:longword=lo(-$123456789ABCD);',
3020   '  hi7:longword=hi(-$123456789ABCD);',
3021   'var',
3022   '  b: Byte;',
3023   '  ss: shortint;',
3024   '  w: Word;',
3025   '  si: SmallInt;',
3026   '  lw: LongWord;',
3027   '  li: LongInt;',
3028   '  b2: Byte;',
3029   '  ni: nativeint;',
3030   'begin',
3031   '  w := $1234;',
3032   '  ss := -$12;',
3033   '  b := lo(ss);',
3034   '  b := HI(ss);',
3035   '  b := lo(w);',
3036   '  b := HI(w);',
3037   '  b2 := lo(b);',
3038   '  b2 := hi(b);',
3039   '  lw := $1234CDEF;',
3040   '  w := lo(lw);',
3041   '  w := hi(lw);',
3042   '  ni := $123456789ABCD;',
3043   '  lw := lo(ni);',
3044   '  lw := hi(ni);',
3045   '']);
3046   ConvertProgram;
3047   CheckSource('TestLoHiFpcMode',
3048     LinesToStr([ // statements
3049     'this.LoByte1 = 0x1234 & 0xFF;',
3050     'this.HiByte1 = (0x1234 >> 8) & 0xFF;',
3051     'this.LoByte2 = 0x1234 & 0xFF;',
3052     'this.HiByte2 = (0x1234 >> 8) & 0xFF;',
3053     'this.LoWord1 = 0x1234CDEF & 0xFFFF;',
3054     'this.HiWord1 = (0x1234CDEF >> 16) & 0xFFFF;',
3055     'this.LoWord2 = -0x1234CDEF & 0xFFFF;',
3056     'this.HiWord2 = (-0x1234CDEF >> 16) & 0xFFFF;',
3057     'this.lo4 = 0x34 & 0xF;',
3058     'this.hi4 = (0x34 >> 4) & 0xF;',
3059     'this.lo5 = (((-0x34 & 255) << 24) >> 24) & 0xFF;',
3060     'this.hi5 = ((((-0x34 & 255) << 24) >> 24) >> 8) & 0xFF;',
3061     'this.lo6 = 0x123456789ABCD >>> 0;',
3062     'this.hi6 = 74565 >>> 0;',
3063     'this.lo7 = -0x123456789ABCD >>> 0;',
3064     'this.hi7 = Math.floor(-0x123456789ABCD / 4294967296) >>> 0;',
3065     'this.b = 0;',
3066     'this.ss = 0;',
3067     'this.w = 0;',
3068     'this.si = 0;',
3069     'this.lw = 0;',
3070     'this.li = 0;',
3071     'this.b2 = 0;',
3072     'this.ni = 0;',
3073     '']),
3074     LinesToStr([ // this.$main
3075     '$mod.w = 0x1234;',
3076     '$mod.ss = -0x12;',
3077     '$mod.b = $mod.ss & 0xFF;',
3078     '$mod.b = ($mod.ss >> 8) & 0xFF;',
3079     '$mod.b = $mod.w & 0xFF;',
3080     '$mod.b = ($mod.w >> 8) & 0xFF;',
3081     '$mod.b2 = $mod.b & 0xF;',
3082     '$mod.b2 = ($mod.b >> 4) & 0xF;',
3083     '$mod.lw = 0x1234CDEF;',
3084     '$mod.w = $mod.lw & 0xFFFF;',
3085     '$mod.w = ($mod.lw >> 16) & 0xFFFF;',
3086     '$mod.ni = 0x123456789ABCD;',
3087     '$mod.lw = $mod.ni >>> 0;',
3088     '$mod.lw = Math.floor($mod.ni / 4294967296) >>> 0;',
3089     '']));
3090 end;
3091 
3092 procedure TTestModule.TestLoHiDelphiMode;
3093 begin
3094   StartProgram(false);
3095   Add([
3096   '{$mode delphi}',
3097   'const',
3098   '  LoByte1 = Lo(Word($1234));',
3099   '  HiByte1 = Hi(Word($1234));',
3100   '  LoByte2 = Lo(SmallInt($1234));',
3101   '  HiByte2 = Hi(SmallInt($1234));',
3102   '  LoByte3 = Lo($1234CDEF);',
3103   '  HiByte3 = Hi($1234CDEF);',
3104   '  LoByte4 = Lo(-$1234CDEF);',
3105   '  HiByte4 = Hi(-$1234CDEF);',
3106   'var',
3107   '  b: Byte;',
3108   '  w: Word;',
3109   '  si: SmallInt;',
3110   '  lw: LongWord;',
3111   '  li: LongInt;',
3112   'begin',
3113   '  w := $1234;',
3114   '  b := lo(w);',
3115   '  b := HI(w);',
3116   '  lw := $1234CDEF;',
3117   '  b := lo(lw);',
3118   '  b := hi(lw);',
3119   '']);
3120   ConvertProgram;
3121   CheckSource('TestLoHiDelphiMode',
3122     LinesToStr([ // statements
3123     'this.LoByte1 = 0x1234 & 0xFF;',
3124     'this.HiByte1 = (0x1234 >> 8) & 0xFF;',
3125     'this.LoByte2 = 0x1234 & 0xFF;',
3126     'this.HiByte2 = (0x1234 >> 8) & 0xFF;',
3127     'this.LoByte3 = 0x1234CDEF & 0xFF;',
3128     'this.HiByte3 = (0x1234CDEF >> 8) & 0xFF;',
3129     'this.LoByte4 = -0x1234CDEF & 0xFF;',
3130     'this.HiByte4 = (-0x1234CDEF >> 8) & 0xFF;',
3131     'this.b = 0;',
3132     'this.w = 0;',
3133     'this.si = 0;',
3134     'this.lw = 0;',
3135     'this.li = 0;'
3136     ]),
3137     LinesToStr([ // this.$main
3138     '$mod.w = 0x1234;',
3139     '$mod.b = $mod.w & 0xFF;',
3140     '$mod.b = ($mod.w >> 8) & 0xFF;',
3141     '$mod.lw = 0x1234CDEF;',
3142     '$mod.b = $mod.lw & 0xFF;',
3143     '$mod.b = ($mod.lw >> 8) & 0xFF;'
3144     ]));
3145 end;
3146 
3147 procedure TTestModule.TestAssignments;
3148 begin
3149   StartProgram(false);
3150   Parser.Options:=Parser.Options+[po_cassignments];
3151   Add('var');
3152   Add('  Bar:longint;');
3153   Add('begin');
3154   Add('  bar:=3;');
3155   Add('  bar+=4;');
3156   Add('  bar-=5;');
3157   Add('  bar*=6;');
3158   ConvertProgram;
3159   CheckSource('TestAssignments',
3160     LinesToStr([ // statements
3161     'this.Bar = 0;'
3162     ]),
3163     LinesToStr([ // this.$main
3164     '$mod.Bar=3;',
3165     '$mod.Bar+=4;',
3166     '$mod.Bar-=5;',
3167     '$mod.Bar*=6;'
3168     ]));
3169 end;
3170 
3171 procedure TTestModule.TestArithmeticOperators1;
3172 begin
3173   StartProgram(false);
3174   Add('var');
3175   Add('  vA,vB,vC:longint;');
3176   Add('begin');
3177   Add('  va:=1;');
3178   Add('  vb:=va+va;');
3179   Add('  vb:=va div vb;');
3180   Add('  vb:=va mod vb;');
3181   Add('  vb:=va+va*vb+va div vb;');
3182   Add('  vc:=-va;');
3183   Add('  va:=va-vb;');
3184   Add('  vb:=va;');
3185   Add('  if va<vb then vc:=va else vc:=vb;');
3186   ConvertProgram;
3187   CheckSource('TestArithmeticOperators1',
3188     LinesToStr([ // statements
3189     'this.vA = 0;',
3190     'this.vB = 0;',
3191     'this.vC = 0;'
3192     ]),
3193     LinesToStr([ // this.$main
3194     '$mod.vA = 1;',
3195     '$mod.vB = $mod.vA + $mod.vA;',
3196     '$mod.vB = Math.floor($mod.vA / $mod.vB);',
3197     '$mod.vB = $mod.vA % $mod.vB;',
3198     '$mod.vB = $mod.vA + ($mod.vA * $mod.vB) + Math.floor($mod.vA / $mod.vB);',
3199     '$mod.vC = -$mod.vA;',
3200     '$mod.vA = $mod.vA - $mod.vB;',
3201     '$mod.vB = $mod.vA;',
3202     'if ($mod.vA < $mod.vB){ $mod.vC = $mod.vA } else $mod.vC = $mod.vB;'
3203     ]));
3204 end;
3205 
3206 procedure TTestModule.TestLogicalOperators;
3207 begin
3208   StartProgram(false);
3209   Add('var');
3210   Add('  vA,vB,vC:boolean;');
3211   Add('begin');
3212   Add('  va:=vb and vc;');
3213   Add('  va:=vb or vc;');
3214   Add('  va:=vb xor vc;');
3215   Add('  va:=true and vc;');
3216   Add('  va:=(vb and vc) or (va and vb);');
3217   Add('  va:=not vb;');
3218   ConvertProgram;
3219   CheckSource('TestLogicalOperators',
3220     LinesToStr([ // statements
3221     'this.vA = false;',
3222     'this.vB = false;',
3223     'this.vC = false;'
3224     ]),
3225     LinesToStr([ // this.$main
3226     '$mod.vA = $mod.vB && $mod.vC;',
3227     '$mod.vA = $mod.vB || $mod.vC;',
3228     '$mod.vA = $mod.vB ^ $mod.vC;',
3229     '$mod.vA = true && $mod.vC;',
3230     '$mod.vA = ($mod.vB && $mod.vC) || ($mod.vA && $mod.vB);',
3231     '$mod.vA = !$mod.vB;'
3232     ]));
3233 end;
3234 
3235 procedure TTestModule.TestBitwiseOperators;
3236 begin
3237   StartProgram(false);
3238   Add([
3239   'var',
3240   '  vA,vB,vC:longint;',
3241   '  X,Y,Z: nativeint;',
3242   'begin',
3243   '  va:=vb and vc;',
3244   '  va:=vb or vc;',
3245   '  va:=vb xor vc;',
3246   '  va:=vb shl vc;',
3247   '  va:=vb shr vc;',
3248   '  va:=3 and vc;',
3249   '  va:=(vb and vc) or (va and vb);',
3250   '  va:=not vb;',
3251   '  X:=Y and Z;',
3252   '  X:=Y and va;',
3253   '  X:=Y or Z;',
3254   '  X:=Y or va;',
3255   '  X:=Y xor Z;',
3256   '  X:=Y xor va;',
3257   '']);
3258   ConvertProgram;
3259   CheckSource('TestBitwiseOperators',
3260     LinesToStr([ // statements
3261     'this.vA = 0;',
3262     'this.vB = 0;',
3263     'this.vC = 0;',
3264     'this.X = 0;',
3265     'this.Y = 0;',
3266     'this.Z = 0;',
3267     '']),
3268     LinesToStr([ // this.$main
3269     '$mod.vA = $mod.vB & $mod.vC;',
3270     '$mod.vA = $mod.vB | $mod.vC;',
3271     '$mod.vA = $mod.vB ^ $mod.vC;',
3272     '$mod.vA = $mod.vB << $mod.vC;',
3273     '$mod.vA = $mod.vB >>> $mod.vC;',
3274     '$mod.vA = 3 & $mod.vC;',
3275     '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
3276     '$mod.vA = ~$mod.vB;',
3277     '$mod.X = rtl.and($mod.Y, $mod.Z);',
3278     '$mod.X = $mod.Y & $mod.vA;',
3279     '$mod.X = rtl.or($mod.Y, $mod.Z);',
3280     '$mod.X = rtl.or($mod.Y, $mod.vA);',
3281     '$mod.X = rtl.xor($mod.Y, $mod.Z);',
3282     '$mod.X = rtl.xor($mod.Y, $mod.vA);',
3283     '']));
3284 end;
3285 
3286 procedure TTestModule.TestBitwiseOperatorsLongword;
3287 begin
3288   StartProgram(false);
3289   Add([
3290   'var',
3291   '  a,b,c:longword;',
3292   '  i: longint;',
3293   'begin',
3294   '  a:=$12345678;',
3295   '  b:=$EDCBA987;',
3296   '  c:=not a;',
3297   '  c:=a and b;',
3298   '  c:=a and $ffff0000;',
3299   '  c:=a or b;',
3300   '  c:=a or $ff00ff00;',
3301   '  c:=a xor b;',
3302   '  c:=a xor $f0f0f0f0;',
3303   '  c:=a shl 1;',
3304   '  c:=a shl 16;',
3305   '  c:=a shl 24;',
3306   '  c:=a shl b;',
3307   '  c:=a shr 1;',
3308   '  c:=a shr 16;',
3309   '  c:=a shr 24;',
3310   '  c:=a shr b;',
3311   '  c:=(b and c) or (a and b);',
3312   '  c:=i and a;',
3313   '  c:=i or a;',
3314   '  c:=i xor a;',
3315   '']);
3316   ConvertProgram;
3317   CheckSource('TestBitwiseOperatorsLongword',
3318     LinesToStr([ // statements
3319     'this.a = 0;',
3320     'this.b = 0;',
3321     'this.c = 0;',
3322     'this.i = 0;',
3323     '']),
3324     LinesToStr([ // this.$main
3325     '$mod.a = 0x12345678;',
3326     '$mod.b = 0xEDCBA987;',
3327     '$mod.c = rtl.lw(~$mod.a);',
3328     '$mod.c = rtl.lw($mod.a & $mod.b);',
3329     '$mod.c = rtl.lw($mod.a & 0xffff0000);',
3330     '$mod.c = rtl.lw($mod.a | $mod.b);',
3331     '$mod.c = rtl.lw($mod.a | 0xff00ff00);',
3332     '$mod.c = rtl.lw($mod.a ^ $mod.b);',
3333     '$mod.c = rtl.lw($mod.a ^ 0xf0f0f0f0);',
3334     '$mod.c = rtl.lw($mod.a << 1);',
3335     '$mod.c = rtl.lw($mod.a << 16);',
3336     '$mod.c = rtl.lw($mod.a << 24);',
3337     '$mod.c = rtl.lw($mod.a << $mod.b);',
3338     '$mod.c = rtl.lw($mod.a >>> 1);',
3339     '$mod.c = rtl.lw($mod.a >>> 16);',
3340     '$mod.c = rtl.lw($mod.a >>> 24);',
3341     '$mod.c = rtl.lw($mod.a >>> $mod.b);',
3342     '$mod.c = rtl.lw(rtl.lw($mod.b & $mod.c) | rtl.lw($mod.a & $mod.b));',
3343     '$mod.c = $mod.i & $mod.a;',
3344     '$mod.c = $mod.i | $mod.a;',
3345     '$mod.c = $mod.i ^ $mod.a;',
3346     '']));
3347 end;
3348 
3349 procedure TTestModule.TestPrgProcVar;
3350 begin
3351   StartProgram(false);
3352   Add('procedure Proc1;');
3353   Add('type');
3354   Add('  t1=longint;');
3355   Add('var');
3356   Add('  vA:t1;');
3357   Add('begin');
3358   Add('end;');
3359   Add('begin');
3360   ConvertProgram;
3361   CheckSource('TestPrgProcVar',
3362     LinesToStr([ // statements
3363     'this.Proc1 = function () {',
3364     '  var vA=0;',
3365     '};'
3366     ]),
3367     LinesToStr([ // this.$main
3368     ''
3369     ]));
3370 end;
3371 
3372 procedure TTestModule.TestUnitProcVar;
3373 begin
3374   StartUnit(false);
3375   Add('interface');
3376   Add('');
3377   Add('type tA=string; // unit scope');
3378   Add('procedure Proc1;');
3379   Add('');
3380   Add('implementation');
3381   Add('');
3382   Add('procedure Proc1;');
3383   Add('type tA=longint; // local proc scope');
3384   Add('var  v1:tA; // using local tA');
3385   Add('begin');
3386   Add('end;');
3387   Add('var  v2:tA; // using interface tA');
3388   ConvertUnit;
3389   CheckSource('TestUnitProcVar',
3390     LinesToStr([ // statements
3391     'var $impl = $mod.$impl;',
3392     'this.Proc1 = function () {',
3393     '  var v1 = 0;',
3394     '};',
3395     '']),
3396     // this.$init
3397     '',
3398     // implementation
3399     LinesToStr([
3400     '$impl.v2 = "";',
3401     '']));
3402 end;
3403 
3404 procedure TTestModule.TestImplProc;
3405 begin
3406   StartUnit(false);
3407   Add('interface');
3408   Add('');
3409   Add('procedure Proc1;');
3410   Add('');
3411   Add('implementation');
3412   Add('');
3413   Add('procedure Proc1; begin end;');
3414   Add('procedure Proc2; begin end;');
3415   Add('initialization');
3416   Add('  Proc1;');
3417   Add('  Proc2;');
3418   ConvertUnit;
3419   CheckSource('TestImplProc',
3420     LinesToStr([ // statements
3421     'var $impl = $mod.$impl;',
3422     'this.Proc1 = function () {',
3423     '};',
3424     '']),
3425     LinesToStr([ // this.$init
3426     '$mod.Proc1();',
3427     '$impl.Proc2();',
3428     '']),
3429     LinesToStr([ // implementation
3430     '$impl.Proc2 = function () {',
3431     '};',
3432     ''])
3433     );
3434 end;
3435 
3436 procedure TTestModule.TestFunctionResult;
3437 begin
3438   StartProgram(false);
3439   Add('function Func1: longint;');
3440   Add('begin');
3441   Add('  Result:=3;');
3442   Add('  Func1:=4;');
3443   Add('end;');
3444   Add('begin');
3445   ConvertProgram;
3446   CheckSource('TestFunctionResult',
3447     LinesToStr([ // statements
3448     'this.Func1 = function () {',
3449     '  var Result = 0;',
3450     '  Result = 3;',
3451     '  Result = 4;',
3452     '  return Result;',
3453     '};'
3454     ]),
3455     '');
3456 end;
3457 
3458 procedure TTestModule.TestNestedProc;
3459 begin
3460   StartProgram(false);
3461   Add([
3462   'var vInUnit: longint;',
3463   'function DoIt(pA,pD: longint): longint;',
3464   'var',
3465   '  vB: longint;',
3466   '  vC: longint;',
3467   '  function Nesty(pA: longint): longint; ',
3468   '  var vB: longint;',
3469   '  begin',
3470   '    Result:=pa+vb+vc+pd+vInUnit;',
3471   '    nesty:=3;',
3472   '    doit:=4;',
3473   '    exit;',
3474   '  end;',
3475   'begin',
3476   '  Result:=pa+vb+vc;',
3477   '  doit:=6;',
3478   '  exit;',
3479   'end;',
3480   'begin']);
3481   ConvertProgram;
3482   CheckSource('TestNestedProc',
3483     LinesToStr([ // statements
3484     'this.vInUnit = 0;',
3485     'this.DoIt = function (pA, pD) {',
3486     '  var Result = 0;',
3487     '  var vB = 0;',
3488     '  var vC = 0;',
3489     '  function Nesty(pA) {',
3490     '    var Result$1 = 0;',
3491     '    var vB = 0;',
3492     '    Result$1 = pA + vB + vC + pD + $mod.vInUnit;',
3493     '    Result$1 = 3;',
3494     '    Result = 4;',
3495     '    return Result$1;',
3496     '    return Result$1;',
3497     '  };',
3498     '  Result = pA + vB + vC;',
3499     '  Result = 6;',
3500     '  return Result;',
3501     '  return Result;',
3502     '};'
3503     ]),
3504     '');
3505 end;
3506 
3507 procedure TTestModule.TestNestedProc_ResultString;
3508 begin
3509   StartProgram(false);
3510   Add([
3511   'function DoIt: string;',
3512   '  function Nesty: string; ',
3513   '  begin',
3514   '    nesty:=#65#66;',
3515   '    nesty[1]:=#67;',
3516   '    doit:=#68;',
3517   '    doit[2]:=#69;',
3518   '  end;',
3519   'begin',
3520   '  doit:=#70;',
3521   '  doit[3]:=#71;',
3522   'end;',
3523   'begin']);
3524   ConvertProgram;
3525   CheckSource('TestNestedProc_ResultString',
3526     LinesToStr([ // statements
3527     'this.DoIt = function () {',
3528     '  var Result = "";',
3529     '  function Nesty() {',
3530     '    var Result$1 = "";',
3531     '    Result$1 = "AB";',
3532     '    Result$1 = rtl.setCharAt(Result$1, 0, "C");',
3533     '    Result = "D";',
3534     '    Result = rtl.setCharAt(Result, 1, "E");',
3535     '    return Result$1;',
3536     '  };',
3537     '  Result = "F";',
3538     '  Result = rtl.setCharAt(Result, 2, "G");',
3539     '  return Result;',
3540     '};'
3541     ]),
3542     '');
3543 end;
3544 
3545 procedure TTestModule.TestForwardProc;
3546 begin
3547   StartProgram(false);
3548   Add('procedure FuncA(Bar: longint); forward;');
3549   Add('procedure FuncB(Bar: longint);');
3550   Add('begin');
3551   Add('  funca(bar);');
3552   Add('end;');
3553   Add('procedure funca(bar: longint);');
3554   Add('begin');
3555   Add('  if bar=3 then ;');
3556   Add('end;');
3557   Add('begin');
3558   Add('  funca(4);');
3559   Add('  funcb(5);');
3560   ConvertProgram;
3561   CheckSource('TestForwardProc',
3562     LinesToStr([ // statements'
3563     'this.FuncB = function (Bar) {',
3564     '  $mod.FuncA(Bar);',
3565     '};',
3566     'this.FuncA = function (Bar) {',
3567     '  if (Bar === 3);',
3568     '};'
3569     ]),
3570     LinesToStr([
3571     '$mod.FuncA(4);',
3572     '$mod.FuncB(5);'
3573     ])
3574     );
3575 end;
3576 
3577 procedure TTestModule.TestNestedForwardProc;
3578 begin
3579   StartProgram(false);
3580   Add('procedure FuncA;');
3581   Add('  procedure FuncB(i: longint); forward;');
3582   Add('  procedure FuncC(i: longint);');
3583   Add('  begin');
3584   Add('    funcb(i);');
3585   Add('  end;');
3586   Add('  procedure FuncB(i: longint);');
3587   Add('  begin');
3588   Add('    if i=3 then ;');
3589   Add('  end;');
3590   Add('begin');
3591   Add('  funcc(4)');
3592   Add('end;');
3593   Add('begin');
3594   Add('  funca;');
3595   ConvertProgram;
3596   CheckSource('TestNestedForwardProc',
3597     LinesToStr([ // statements'
3598     'this.FuncA = function () {',
3599     '  function FuncC(i) {',
3600     '    FuncB(i);',
3601     '  };',
3602     '  function FuncB(i) {',
3603     '    if (i === 3);',
3604     '  };',
3605     '  FuncC(4);',
3606     '};'
3607     ]),
3608     LinesToStr([
3609     '$mod.FuncA();'
3610     ])
3611     );
3612 end;
3613 
3614 procedure TTestModule.TestAssignFunctionResult;
3615 begin
3616   StartProgram(false);
3617   Add('function Func1: longint;');
3618   Add('begin');
3619   Add('end;');
3620   Add('var i: longint;');
3621   Add('begin');
3622   Add('  i:=func1();');
3623   Add('  i:=func1()+func1();');
3624   ConvertProgram;
3625   CheckSource('TestAssignFunctionResult',
3626     LinesToStr([ // statements
3627      'this.Func1 = function () {',
3628      '  var Result = 0;',
3629      '  return Result;',
3630      '};',
3631      'this.i = 0;'
3632     ]),
3633     LinesToStr([
3634     '$mod.i = $mod.Func1();',
3635     '$mod.i = $mod.Func1() + $mod.Func1();'
3636     ]));
3637 end;
3638 
3639 procedure TTestModule.TestFunctionResultInCondition;
3640 begin
3641   StartProgram(false);
3642   Add('function Func1: longint;');
3643   Add('begin');
3644   Add('end;');
3645   Add('function Func2: boolean;');
3646   Add('begin');
3647   Add('end;');
3648   Add('var i: longint;');
3649   Add('begin');
3650   Add('  if func2 then ;');
3651   Add('  if i=func1() then ;');
3652   Add('  if i=func1 then ;');
3653   ConvertProgram;
3654   CheckSource('TestFunctionResultInCondition',
3655     LinesToStr([ // statements
3656      'this.Func1 = function () {',
3657      '  var Result = 0;',
3658      '  return Result;',
3659      '};',
3660      'this.Func2 = function () {',
3661      '  var Result = false;',
3662      '  return Result;',
3663      '};',
3664      'this.i = 0;'
3665     ]),
3666     LinesToStr([
3667     'if ($mod.Func2());',
3668     'if ($mod.i === $mod.Func1());',
3669     'if ($mod.i === $mod.Func1());'
3670     ]));
3671 end;
3672 
3673 procedure TTestModule.TestFunctionResultInForLoop;
3674 begin
3675   StartProgram(false);
3676   Add([
3677   'function Func1(a: array of longint): longint;',
3678   'begin',
3679   '  for Result:=High(a) downto Low(a) do if a[Result]=0 then exit;',
3680   '  for Result in a do if a[Result]=0 then exit;',
3681   'end;',
3682   'begin',
3683   '  Func1([1,2,3])']);
3684   ConvertProgram;
3685   CheckSource('TestFunctionResultInForLoop',
3686     LinesToStr([ // statements
3687     'this.Func1 = function (a) {',
3688     '  var Result = 0;',
3689     '  for (var $l = rtl.length(a) - 1; $l >= 0; $l--) {',
3690     '    Result = $l;',
3691     '    if (a[Result] === 0) return Result;',
3692     '  };',
3693     '  for (var $in = a, $l1 = 0, $end = rtl.length($in) - 1; $l1 <= $end; $l1++) {',
3694     '    Result = $in[$l1];',
3695     '    if (a[Result] === 0) return Result;',
3696     '  };',
3697     '  return Result;',
3698     '};',
3699     '']),
3700     LinesToStr([
3701     '$mod.Func1([1, 2, 3]);'
3702     ]));
3703 end;
3704 
3705 procedure TTestModule.TestFunctionResultInTypeCast;
3706 begin
3707   StartProgram(false);
3708   Add([
3709   'function GetInt: longint;',
3710   'begin',
3711   'end;',
3712   'begin',
3713   '  if Byte(GetInt)=0 then ;',
3714   '']);
3715   ConvertProgram;
3716   CheckSource('TestFunctionResultInTypeCast',
3717     LinesToStr([ // statements
3718     'this.GetInt = function () {',
3719     '  var Result = 0;',
3720     '  return Result;',
3721     '};',
3722     '']),
3723     LinesToStr([
3724     'if (($mod.GetInt() & 255) === 0) ;'
3725     ]));
3726 end;
3727 
3728 procedure TTestModule.TestExit;
3729 begin
3730   StartProgram(false);
3731   Add('procedure ProcA;');
3732   Add('begin');
3733   Add('  exit;');
3734   Add('end;');
3735   Add('function FuncB: longint;');
3736   Add('begin');
3737   Add('  exit;');
3738   Add('  exit(3);');
3739   Add('end;');
3740   Add('function FuncC: string;');
3741   Add('begin');
3742   Add('  exit;');
3743   Add('  exit(''a'');');
3744   Add('  exit(''abc'');');
3745   Add('end;');
3746   Add('begin');
3747   Add('  exit;');
3748   Add('  exit(1);');
3749   ConvertProgram;
3750   CheckSource('TestExit',
3751     LinesToStr([ // statements
3752     'this.ProcA = function () {',
3753     '  return;',
3754     '};',
3755     'this.FuncB = function () {',
3756     '  var Result = 0;',
3757     '  return Result;',
3758     '  return 3;',
3759     '  return Result;',
3760     '};',
3761     'this.FuncC = function () {',
3762     '  var Result = "";',
3763     '  return Result;',
3764     '  return "a";',
3765     '  return "abc";',
3766     '  return Result;',
3767     '};'
3768     ]),
3769     LinesToStr([
3770     'return;',
3771     'return 1;',
3772     '']));
3773 end;
3774 
3775 procedure TTestModule.TestExit_ResultInFinally;
3776 begin
3777   StartProgram(false);
3778   Add([
3779   'function Run: word;',
3780   'begin',
3781   '  try',
3782   '    exit(3);', // no Result in finally -> use return 3
3783   '  finally',
3784   '  end;',
3785   'end;',
3786   'function Fly: word;',
3787   'begin',
3788   '  try',
3789   '    exit(3);',
3790   '  finally',
3791   '    if Result>0 then ;',
3792   '  end;',
3793   'end;',
3794   'function Jump: word;',
3795   'begin',
3796   '  try',
3797   '    try',
3798   '      exit(4);',
3799   '    finally',
3800   '    end;',
3801   '  finally',
3802   '    if Result>0 then ;',
3803   '  end;',
3804   'end;',
3805   'begin',
3806   '']);
3807   ConvertProgram;
3808   CheckSource('TestExit_ResultInFinally',
3809     LinesToStr([ // statements
3810     'this.Run = function () {',
3811     '  var Result = 0;',
3812     '  try {',
3813     '    return 3;',
3814     '  } finally {',
3815     '  };',
3816     '  return Result;',
3817     '};',
3818     'this.Fly = function () {',
3819     '  var Result = 0;',
3820     '  try {',
3821     '    Result = 3;',
3822     '    return Result;',
3823     '  } finally {',
3824     '    if (Result > 0) ;',
3825     '  };',
3826     '  return Result;',
3827     '};',
3828     'this.Jump = function () {',
3829     '  var Result = 0;',
3830     '  try {',
3831     '    try {',
3832     '      Result = 4;',
3833     '      return Result;',
3834     '    } finally {',
3835     '    };',
3836     '  } finally {',
3837     '    if (Result > 0) ;',
3838     '  };',
3839     '  return Result;',
3840     '};',
3841     '']),
3842     LinesToStr([
3843     '']));
3844 end;
3845 
3846 procedure TTestModule.TestBreak;
3847 begin
3848   StartProgram(false);
3849   Add([
3850   'var',
3851   '  i: longint;',
3852   'begin',
3853   '  repeat',
3854   '    break;',
3855   '  until true;',
3856   '  while true do',
3857   '    break;',
3858   '  for i:=1 to 2 do',
3859   '    break;']);
3860   ConvertProgram;
3861   CheckSource('TestBreak',
3862     LinesToStr([ // statements
3863     'this.i = 0;'
3864     ]),
3865     LinesToStr([
3866     'do {',
3867     '  break;',
3868     '} while (!true);',
3869     'while (true) break;',
3870     'for ($mod.i = 1; $mod.i <= 2; $mod.i++) break;',
3871     '']));
3872 end;
3873 
3874 procedure TTestModule.TestBreakAsVar;
3875 begin
3876   StartProgram(false);
3877   Add([
3878   'procedure DoIt(break: boolean);',
3879   'begin',
3880   '  if break then ;',
3881   'end;',
3882   'var',
3883   '  break: boolean;',
3884   'begin',
3885   '  if break then ;']);
3886   ConvertProgram;
3887   CheckSource('TestBreakAsVar',
3888     LinesToStr([ // statements
3889     'this.DoIt = function (Break) {',
3890     '  if (Break) ;',
3891     '};',
3892     'this.Break = false;',
3893     '']),
3894     LinesToStr([
3895     'if($mod.Break) ;',
3896     '']));
3897 end;
3898 
3899 procedure TTestModule.TestContinue;
3900 begin
3901   StartProgram(false);
3902   Add('var i: longint;');
3903   Add('begin');
3904   Add('  repeat');
3905   Add('    continue;');
3906   Add('  until true;');
3907   Add('  while true do');
3908   Add('    continue;');
3909   Add('  for i:=1 to 2 do');
3910   Add('    continue;');
3911   ConvertProgram;
3912   CheckSource('TestContinue',
3913     LinesToStr([ // statements
3914     'this.i = 0;'
3915     ]),
3916     LinesToStr([
3917     'do {',
3918     '  continue;',
3919     '} while (!true);',
3920     'while (true) continue;',
3921     'for ($mod.i = 1; $mod.i <= 2; $mod.i++) continue;',
3922     '']));
3923 end;
3924 
3925 procedure TTestModule.TestProc_External;
3926 begin
3927   StartProgram(false);
3928   Add('procedure Foo; external name ''console.log'';');
3929   Add('function Bar: longint; external name ''get.item'';');
3930   Add('function Bla(s: string): longint; external name ''apply.something'';');
3931   Add('var');
3932   Add('  i: longint;');
3933   Add('begin');
3934   Add('  Foo;');
3935   Add('  i:=Bar;');
3936   Add('  i:=Bla(''abc'');');
3937   ConvertProgram;
3938   CheckSource('TestProc_External',
3939     LinesToStr([ // statements
3940     'this.i = 0;'
3941     ]),
3942     LinesToStr([
3943     'console.log();',
3944     '$mod.i = get.item();',
3945     '$mod.i = apply.something("abc");'
3946     ]));
3947 end;
3948 
3949 procedure TTestModule.TestProc_ExternalOtherUnit;
3950 begin
3951   AddModuleWithIntfImplSrc('unit2.pas',
3952     LinesToStr([
3953     'procedure Now; external name ''Date.now'';',
3954     'procedure DoIt;'
3955     ]),
3956     'procedure doit; begin end;');
3957 
3958   StartUnit(true);
3959   Add('interface');
3960   Add('uses unit2;');
3961   Add('implementation');
3962   Add('begin');
3963   Add('  now;');
3964   Add('  now();');
3965   Add('  uNit2.now;');
3966   Add('  uNit2.now();');
3967   Add('  doit;');
3968   Add('  uNit2.doit;');
3969   ConvertUnit;
3970   CheckSource('TestProc_ExternalOtherUnit',
3971     LinesToStr([
3972     '']),
3973     LinesToStr([
3974     'Date.now();',
3975     'Date.now();',
3976     'Date.now();',
3977     'Date.now();',
3978     'pas.unit2.DoIt();',
3979     'pas.unit2.DoIt();',
3980     '']));
3981 end;
3982 
3983 procedure TTestModule.TestProc_Asm;
3984 begin
3985   StartProgram(false);
3986   Add([
3987   '{$mode delphi}',
3988   'function DoIt: longint;',
3989   'begin;',
3990   '  asm',
3991   '  { a:{ b:{}, c:[]}, d:''1'' };',
3992   '  end;',
3993   '  asm console.log(); end;',
3994   '  asm',
3995   '    s = "'' ";',
3996   '    s = ''" '';',
3997   '    s = s + "world" + "''";',
3998   '    // end',
3999   '    s = ''end'';',
4000   '    s = "end";',
4001   '    s = "foo\"bar";',
4002   '    s = ''a\''b'';',
4003   '    s =  `${expr}\`-"-''-`;',
4004   '    s = `multi',
4005   'line`;',
4006   '  end;',
4007   'end;',
4008   'procedure Fly;',
4009   'asm',
4010   '  return;',
4011   'end;',
4012   'begin']);
4013   ConvertProgram;
4014   CheckSource('TestProc_Asm',
4015     LinesToStr([ // statements
4016     'this.DoIt = function () {',
4017     '  var Result = 0;',
4018     '  { a:{ b:{}, c:[]}, d:''1'' };',
4019     '  console.log();',
4020     '  s = "'' ";',
4021     '  s = ''" '';',
4022     '  s = s + "world" + "''";',
4023     '  // end',
4024     '  s = ''end'';',
4025     '  s = "end";',
4026     '  s = "foo\"bar";',
4027     '  s = ''a\''b'';',
4028     '  s =  `${expr}\`-"-''-`;',
4029     '  s = `multi',
4030     'line`;',
4031     '  return Result;',
4032     '};',
4033     'this.Fly = function () {',
4034     '  return;',
4035     '};',
4036     '']),
4037     LinesToStr([
4038     ''
4039     ]));
4040 end;
4041 
4042 procedure TTestModule.TestProc_Assembler;
4043 begin
4044   StartProgram(false);
4045   Add('function DoIt: longint; assembler;');
4046   Add('asm');
4047   Add('{ a:{ b:{}, c:[]}, d:''1'' };');
4048   Add('end;');
4049   Add('begin');
4050   ConvertProgram;
4051   CheckSource('TestProc_Assembler',
4052     LinesToStr([ // statements
4053     'this.DoIt = function () {',
4054     '  { a:{ b:{}, c:[]}, d:''1'' };',
4055     '};'
4056     ]),
4057     LinesToStr([
4058     ''
4059     ]));
4060 end;
4061 
4062 procedure TTestModule.TestProc_VarParam;
4063 begin
4064   StartProgram(false);
4065   Add('type integer = longint;');
4066   Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
4067   Add('var vJ: integer;');
4068   Add('begin');
4069   Add('  vg:=vg+1;');
4070   Add('  vj:=vh+2;');
4071   Add('  vi:=vi+3;');
4072   Add('  doit(vg,vg,vg);');
4073   Add('  doit(vh,vh,vj);');
4074   Add('  doit(vi,vi,vi);');
4075   Add('  doit(vj,vj,vj);');
4076   Add('end;');
4077   Add('var i: integer;');
4078   Add('begin');
4079   Add('  doit(i,i,i);');
4080   ConvertProgram;
4081   CheckSource('TestProc_VarParam',
4082     LinesToStr([ // statements
4083     'this.DoIt = function (vG,vH,vI) {',
4084     '  var vJ = 0;',
4085     '  vG = vG + 1;',
4086     '  vJ = vH + 2;',
4087     '  vI.set(vI.get()+3);',
4088     '  $mod.DoIt(vG, vG, {',
4089     '    get: function () {',
4090     '      return vG;',
4091     '    },',
4092     '    set: function (v) {',
4093     '      vG = v;',
4094     '    }',
4095     '  });',
4096     '  $mod.DoIt(vH, vH, {',
4097     '    get: function () {',
4098     '      return vJ;',
4099     '    },',
4100     '    set: function (v) {',
4101     '      vJ = v;',
4102     '    }',
4103     '  });',
4104     '  $mod.DoIt(vI.get(), vI.get(), vI);',
4105     '  $mod.DoIt(vJ, vJ, {',
4106     '    get: function () {',
4107     '      return vJ;',
4108     '    },',
4109     '    set: function (v) {',
4110     '      vJ = v;',
4111     '    }',
4112     '  });',
4113     '};',
4114     'this.i = 0;'
4115     ]),
4116     LinesToStr([
4117     '$mod.DoIt($mod.i,$mod.i,{',
4118     '  p: $mod,',
4119     '  get: function () {',
4120     '      return this.p.i;',
4121     '    },',
4122     '  set: function (v) {',
4123     '      this.p.i = v;',
4124     '    }',
4125     '});'
4126     ]));
4127 end;
4128 
4129 procedure TTestModule.TestProc_VarParamString;
4130 begin
4131   StartProgram(false);
4132   Add(['type TCaption = string;',
4133   'procedure DoIt(vA: TCaption; var vB: TCaption; out vC: TCaption);',
4134   'var c: char;',
4135   'begin',
4136   '  va[1]:=c;',
4137   '  vb[2]:=c;',
4138   '  vc[3]:=c;',
4139   'end;',
4140   'begin']);
4141   ConvertProgram;
4142   CheckSource('TestProc_VarParamString',
4143     LinesToStr([ // statements
4144     'this.DoIt = function (vA,vB,vC) {',
4145     '  var c = "";',
4146     '  vA = rtl.setCharAt(vA, 0, c);',
4147     '  vB.set(rtl.setCharAt(vB.get(), 1, c));',
4148     '  vC.set(rtl.setCharAt(vC.get(), 2, c));',
4149     '};',
4150     '']),
4151     LinesToStr([
4152     ]));
4153 end;
4154 
4155 procedure TTestModule.TestProc_VarParamV;
4156 begin
4157   StartProgram(false);
4158   Add([
4159   'procedure Inc2(var i: longint);',
4160   'begin',
4161   '  i:=i+2;',
4162   'end;',
4163   'procedure DoIt(v: longint);',
4164   'var p: array of longint;',
4165   'begin',
4166   '  Inc2(v);',
4167   '  Inc2(p[v]);',
4168   'end;',
4169   'begin']);
4170   ConvertProgram;
4171   CheckSource('TestProc_VarParamV',
4172     LinesToStr([ // statements
4173     'this.Inc2 = function (i) {',
4174     '  i.set(i.get()+2);',
4175     '};',
4176     'this.DoIt = function (v) {',
4177     '  var p = [];',
4178     '  $mod.Inc2({get: function () {',
4179     '    return v;',
4180     '  }, set: function (w) {',
4181     '    v = w;',
4182     '  }});',
4183     '  $mod.Inc2({',
4184     '    a: v,',
4185     '    p: p,',
4186     '    get: function () {',
4187     '        return this.p[this.a];',
4188     '      },',
4189     '    set: function (v) {',
4190     '        this.p[this.a] = v;',
4191     '      }',
4192     '  });',
4193     '};',
4194     '']),
4195     LinesToStr([
4196     '']));
4197 end;
4198 
4199 procedure TTestModule.TestProc_Overload;
4200 begin
4201   StartProgram(false);
4202   Add('procedure DoIt(vI: longint); begin end;');
4203   Add('procedure DoIt(vI, vJ: longint); begin end;');
4204   Add('procedure DoIt(vD: double); begin end;');
4205   Add('begin');
4206   Add('  DoIt(1);');
4207   Add('  DoIt(2,3);');
4208   Add('  DoIt(4.5);');
4209   ConvertProgram;
4210   CheckSource('TestProcedureOverload',
4211     LinesToStr([ // statements
4212     'this.DoIt = function (vI) {',
4213     '};',
4214     'this.DoIt$1 = function (vI, vJ) {',
4215     '};',
4216     'this.DoIt$2 = function (vD) {',
4217     '};',
4218     '']),
4219     LinesToStr([
4220     '$mod.DoIt(1);',
4221     '$mod.DoIt$1(2, 3);',
4222     '$mod.DoIt$2(4.5);',
4223     '']));
4224 end;
4225 
4226 procedure TTestModule.TestProc_OverloadForward;
4227 begin
4228   StartProgram(false);
4229   Add('procedure DoIt(vI: longint); forward;');
4230   Add('procedure DoIt(vI, vJ: longint); begin end;');
4231   Add('procedure doit(vi: longint); begin end;');
4232   Add('begin');
4233   Add('  doit(1);');
4234   Add('  doit(2,3);');
4235   ConvertProgram;
4236   CheckSource('TestProcedureOverloadForward',
4237     LinesToStr([ // statements
4238     'this.DoIt$1 = function (vI, vJ) {',
4239     '};',
4240     'this.DoIt = function (vI) {',
4241     '};',
4242     '']),
4243     LinesToStr([
4244     '$mod.DoIt(1);',
4245     '$mod.DoIt$1(2, 3);',
4246     '']));
4247 end;
4248 
4249 procedure TTestModule.TestProc_OverloadIntfImpl;
4250 begin
4251   StartUnit(false);
4252   Add('interface');
4253   Add('procedure DoIt(vI: longint);');
4254   Add('procedure DoIt(vI, vJ: longint);');
4255   Add('implementation');
4256   Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
4257   Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
4258   Add('procedure DoIt(vi: longint); begin end;');
4259   Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
4260   Add('procedure DoIt(vi, vj: longint); begin end;');
4261   Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
4262   Add('begin');
4263   Add('  doit(1);');
4264   Add('  doit(2,3);');
4265   Add('  doit(4,5,6);');
4266   Add('  doit(7,8,9,10);');
4267   Add('  doit(11,12,13,14,15);');
4268   ConvertUnit;
4269   CheckSource('TestProcedureOverloadUnit',
4270     LinesToStr([ // statements
4271     'var $impl = $mod.$impl;',
4272     'this.DoIt = function (vI) {',
4273     '};',
4274     'this.DoIt$1 = function (vI, vJ) {',
4275     '};',
4276     '']),
4277     LinesToStr([ // this.$init
4278     '$mod.DoIt(1);',
4279     '$mod.DoIt$1(2, 3);',
4280     '$impl.DoIt$3(4,5,6);',
4281     '$impl.DoIt$4(7,8,9,10);',
4282     '$impl.DoIt$2(11,12,13,14,15);',
4283     '']),
4284     LinesToStr([ // implementation
4285     '$impl.DoIt$3 = function (vI, vJ, vK) {',
4286     '};',
4287     '$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
4288     '};',
4289     '$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
4290     '};',
4291     '']));
4292 end;
4293 
4294 procedure TTestModule.TestProc_OverloadNested;
4295 begin
4296   StartProgram(false);
4297   Add([
4298   'procedure doit(vA: longint);',
4299   '  procedure DoIt(vA, vB: longint); overload;',
4300   '  begin',
4301   '    doit(1);',
4302   '    doit(1,2);',
4303   '  end;',
4304   '  procedure doit(vA, vB, vC: longint);',
4305   '  begin',
4306   '    doit(1);',
4307   '    doit(1,2);',
4308   '    doit(1,2,3);',
4309   '  end;',
4310   'begin',
4311   '  doit(1);',
4312   '  doit(1,2);',
4313   '  doit(1,2,3);',
4314   'end;',
4315   'begin // main',
4316   '  doit(1);']);
4317   ConvertProgram;
4318   CheckSource('TestProcedureOverloadNested',
4319     LinesToStr([ // statements
4320     'this.doit = function (vA) {',
4321     '  function DoIt$1(vA, vB) {',
4322     '    $mod.doit(1);',
4323     '    DoIt$1(1, 2);',
4324     '  };',
4325     '  function doit$2(vA, vB, vC) {',
4326     '    $mod.doit(1);',
4327     '    DoIt$1(1, 2);',
4328     '    doit$2(1, 2, 3);',
4329     '  };',
4330     '  $mod.doit(1);',
4331     '  DoIt$1(1, 2);',
4332     '  doit$2(1, 2, 3);',
4333     '};',
4334     '']),
4335     LinesToStr([
4336     '$mod.doit(1);',
4337     '']));
4338 end;
4339 
4340 procedure TTestModule.TestProc_OverloadNestedForward;
4341 begin
4342   StartProgram(false);
4343   Add([
4344   'procedure DoIt(vA: longint); overload; forward;',
4345   'procedure DoIt(vB, vC: longint); overload;',
4346   'begin // 2 param overload',
4347   '  doit(1);',
4348   '  doit(1,2);',
4349   'end;',
4350   'procedure doit(vA: longint);',
4351   '  procedure DoIt(vA, vB, vC: longint); overload; forward;',
4352   '  procedure DoIt(vA, vB, vC, vD: longint); overload;',
4353   '  begin // 4 param overload',
4354   '    doit(1);',
4355   '    doit(1,2);',
4356   '    doit(1,2,3);',
4357   '    doit(1,2,3,4);',
4358   '  end;',
4359   '  procedure doit(vA, vB, vC: longint);',
4360   '    procedure DoIt(vA, vB, vC, vD, vE: longint); overload; forward;',
4361   '    procedure DoIt(vA, vB, vC, vD, vE, vF: longint); overload;',
4362   '    begin // 6 param overload',
4363   '      doit(1);',
4364   '      doit(1,2);',
4365   '      doit(1,2,3);',
4366   '      doit(1,2,3,4);',
4367   '      doit(1,2,3,4,5);',
4368   '      doit(1,2,3,4,5,6);',
4369   '    end;',
4370   '    procedure doit(vA, vB, vC, vD, vE: longint);',
4371   '    begin // 5 param overload',
4372   '      doit(1);',
4373   '      doit(1,2);',
4374   '      doit(1,2,3);',
4375   '      doit(1,2,3,4);',
4376   '      doit(1,2,3,4,5);',
4377   '      doit(1,2,3,4,5,6);',
4378   '    end;',
4379   '  begin // 3 param overload',
4380   '    doit(1);',
4381   '    doit(1,2);',
4382   '    doit(1,2,3);',
4383   '    doit(1,2,3,4);',
4384   '    doit(1,2,3,4,5);',
4385   '    doit(1,2,3,4,5,6);',
4386   '  end;',
4387   'begin // 1 param overload',
4388   '  doit(1);',
4389   '  doit(1,2);',
4390   '  doit(1,2,3);',
4391   '  doit(1,2,3,4);',
4392   'end;',
4393   'begin // main',
4394   '  doit(1);',
4395   '  doit(1,2);']);
4396   ConvertProgram;
4397   CheckSource('TestProc_OverloadNestedForward',
4398     LinesToStr([ // statements
4399     'this.DoIt$1 = function (vB, vC) {',
4400     '  $mod.DoIt(1);',
4401     '  $mod.DoIt$1(1, 2);',
4402     '};',
4403     'this.DoIt = function (vA) {',
4404     '  function DoIt$3(vA, vB, vC, vD) {',
4405     '    $mod.DoIt(1);',
4406     '    $mod.DoIt$1(1, 2);',
4407     '    DoIt$2(1, 2, 3);',
4408     '    DoIt$3(1, 2, 3, 4);',
4409     '  };',
4410     '  function DoIt$2(vA, vB, vC) {',
4411     '    function DoIt$5(vA, vB, vC, vD, vE, vF) {',
4412     '      $mod.DoIt(1);',
4413     '      $mod.DoIt$1(1, 2);',
4414     '      DoIt$2(1, 2, 3);',
4415     '      DoIt$3(1, 2, 3, 4);',
4416     '      DoIt$4(1, 2, 3, 4, 5);',
4417     '      DoIt$5(1, 2, 3, 4, 5, 6);',
4418     '    };',
4419     '    function DoIt$4(vA, vB, vC, vD, vE) {',
4420     '      $mod.DoIt(1);',
4421     '      $mod.DoIt$1(1, 2);',
4422     '      DoIt$2(1, 2, 3);',
4423     '      DoIt$3(1, 2, 3, 4);',
4424     '      DoIt$4(1, 2, 3, 4, 5);',
4425     '      DoIt$5(1, 2, 3, 4, 5, 6);',
4426     '    };',
4427     '    $mod.DoIt(1);',
4428     '    $mod.DoIt$1(1, 2);',
4429     '    DoIt$2(1, 2, 3);',
4430     '    DoIt$3(1, 2, 3, 4);',
4431     '    DoIt$4(1, 2, 3, 4, 5);',
4432     '    DoIt$5(1, 2, 3, 4, 5, 6);',
4433     '  };',
4434     '  $mod.DoIt(1);',
4435     '  $mod.DoIt$1(1, 2);',
4436     '  DoIt$2(1, 2, 3);',
4437     '  DoIt$3(1, 2, 3, 4);',
4438     '};',
4439     '']),
4440     LinesToStr([
4441     '$mod.DoIt(1);',
4442     '$mod.DoIt$1(1, 2);',
4443     '']));
4444 end;
4445 
4446 procedure TTestModule.TestProc_OverloadUnitCycle;
4447 begin
4448   AddModuleWithIntfImplSrc('Unit2.pas',
4449     LinesToStr([
4450     'type',
4451     '  TObject = class',
4452     '    procedure DoIt(b: boolean); virtual; abstract;',
4453     '    procedure DoIt(i: longint); virtual; abstract;',
4454     '  end;',
4455     '']),
4456     'uses test1;');
4457   StartUnit(true);
4458   Add([
4459   'interface',
4460   'uses unit2;',
4461   'type',
4462   '  TEagle = class(TObject)',
4463   '    procedure DoIt(b: boolean); override;',
4464   '    procedure DoIt(i: longint); override;',
4465   '  end;',
4466   'implementation',
4467   'procedure TEagle.DoIt(b: boolean); begin end;',
4468   'procedure TEagle.DoIt(i: longint); begin end;',
4469   '']);
4470   ConvertUnit;
4471   CheckSource('TestProc_OverloadUnitCycle',
4472     LinesToStr([ // statements
4473     'rtl.createClass($mod, "TEagle", pas.Unit2.TObject, function () {',
4474     '  this.DoIt = function (b) {',
4475     '  };',
4476     '  this.DoIt$1 = function (i) {',
4477     '  };',
4478     '});',
4479     '']),
4480     '',
4481     LinesToStr([
4482     '']));
4483 end;
4484 
4485 procedure TTestModule.TestProc_Varargs;
4486 begin
4487   StartProgram(false);
4488   Add([
4489   'procedure ProcA(i:longint); varargs; external name ''ProcA'';',
4490   'procedure ProcB; varargs; external name ''ProcB'';',
4491   'procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';',
4492   'function GetIt: longint; begin end;',
4493   'begin',
4494   '  ProcA(1);',
4495   '  ProcA(1,2);',
4496   '  ProcA(1,2.0);',
4497   '  ProcA(1,2,3);',
4498   '  ProcA(1,''2'');',
4499   '  ProcA(2,'''');',
4500   '  ProcA(3,false);',
4501   '  ProcB;',
4502   '  ProcB();',
4503   '  ProcB(4);',
4504   '  ProcB(''foo'');',
4505   '  ProcC;',
4506   '  ProcC();',
4507   '  ProcC(4);',
4508   '  ProcC(5,''foo'');',
4509   '  ProcB(GetIt);',
4510   '  ProcB(GetIt());',
4511   '  ProcB(GetIt,GetIt());']);
4512   ConvertProgram;
4513   CheckSource('TestProc_Varargs',
4514     LinesToStr([ // statements
4515     'this.GetIt = function () {',
4516     '  var Result = 0;',
4517     '  return Result;',
4518     '};',
4519     '']),
4520     LinesToStr([
4521     'ProcA(1);',
4522     'ProcA(1, 2);',
4523     'ProcA(1, 2.0);',
4524     'ProcA(1, 2, 3);',
4525     'ProcA(1, "2");',
4526     'ProcA(2, "");',
4527     'ProcA(3, false);',
4528     'ProcB();',
4529     'ProcB();',
4530     'ProcB(4);',
4531     'ProcB("foo");',
4532     'ProcC(17);',
4533     'ProcC(17);',
4534     'ProcC(4);',
4535     'ProcC(5, "foo");',
4536     'ProcB($mod.GetIt());',
4537     'ProcB($mod.GetIt());',
4538     'ProcB($mod.GetIt(), $mod.GetIt());',
4539     '']));
4540 end;
4541 
4542 procedure TTestModule.TestProc_ConstOrder;
4543 begin
4544   StartProgram(false);
4545   Add([
4546   'const A = 3;',
4547   'const B = A+1;',
4548   'procedure DoIt;',
4549   'const C = A+1;',
4550   'const D = B+1;',
4551   'const E = D+C+B+A;',
4552   'begin',
4553   'end;',
4554   'begin'
4555   ]);
4556   ConvertProgram;
4557   CheckSource('TestProc_ConstOrder',
4558     LinesToStr([ // statements
4559     'this.A = 3;',
4560     'this.B = 3 + 1;',
4561     'var C = 3 + 1;',
4562     'var D = 4 + 1;',
4563     'var E = 5 + 4 + 4 + 3;',
4564     'this.DoIt = function () {',
4565     '};',
4566     '']),
4567     LinesToStr([
4568     ''
4569     ]));
4570 end;
4571 
4572 procedure TTestModule.TestProc_DuplicateConst;
4573 begin
4574   StartProgram(false);
4575   Add([
4576   'const A = 1;',
4577   'procedure DoIt;',
4578   'const A = 2;',
4579   '  procedure SubIt;',
4580   '  const A = 21;',
4581   '  begin',
4582   '  end;',
4583   'begin',
4584   'end;',
4585   'procedure DoSome;',
4586   'const A = 3;',
4587   'begin',
4588   'end;',
4589   'begin'
4590   ]);
4591   ConvertProgram;
4592   CheckSource('TestProc_DuplicateConst',
4593     LinesToStr([ // statements
4594     'this.A = 1;',
4595     'var A$1 = 2;',
4596     'var A$2 = 21;',
4597     'this.DoIt = function () {',
4598     '  function SubIt() {',
4599     '  };',
4600     '};',
4601     'var A$3 = 3;',
4602     'this.DoSome = function () {',
4603     '};',
4604     '']),
4605     LinesToStr([
4606     ''
4607     ]));
4608 end;
4609 
4610 procedure TTestModule.TestProc_LocalVarAbsolute;
4611 begin
4612   StartProgram(false);
4613   Add([
4614   'type',
4615   '  TObject = class',
4616   '    Index: longint;',
4617   '    procedure DoAbs(Item: pointer);',
4618   '  end;',
4619   'procedure TObject.DoAbs(Item: pointer);',
4620   'var',
4621   '  o: TObject absolute Item;',
4622   'begin',
4623   '  if o.Index<o.Index then o.Index:=o.Index;',
4624   'end;',
4625   'procedure DoIt(i: longint; p: pointer);',
4626   'var',
4627   '  d: double absolute i;',
4628   '  s: string absolute d;',
4629   '  oi: TObject absolute i;',
4630   '  op: TObject absolute p;',
4631   'begin',
4632   '  if d=d then d:=d;',
4633   '  if s=s then s:=s;',
4634   '  if oi.Index<oi.Index then oi.Index:=oi.Index;',
4635   '  if op.Index=op.Index then op.Index:=op.Index;',
4636   'end;',
4637   'begin']);
4638   ConvertProgram;
4639   CheckSource('TestProc_LocalVarAbsolute',
4640     LinesToStr([ // statements
4641     'rtl.createClass($mod, "TObject", null, function () {',
4642     '  this.$init = function () {',
4643     '    this.Index = 0;',
4644     '  };',
4645     '  this.$final = function () {',
4646     '  };',
4647     '  this.DoAbs = function (Item) {',
4648     '    if (Item.Index < Item.Index) Item.Index = Item.Index;',
4649     '  };',
4650     '});',
4651     'this.DoIt = function (i, p) {',
4652     '  if (i === i) i = i;',
4653     '  if (i === i) i = i;',
4654     '  if (i.Index < i.Index) i.Index = i.Index;',
4655     '  if (p.Index === p.Index) p.Index = p.Index;',
4656     '};'
4657     ]),
4658     LinesToStr([
4659     ]));
4660 end;
4661 
4662 procedure TTestModule.TestProc_LocalVarInit;
4663 begin
4664   StartProgram(false);
4665   Add([
4666   'type TBytes = array of byte;',
4667   'procedure DoIt;',
4668   'const c = 4;',
4669   'var',
4670   '  b: byte = 1;',
4671   '  w: word = 2+c;',
4672   '  p: pointer = nil;',
4673   '  Buffer: TBytes = nil;',
4674   'begin',
4675   'end;',
4676   'begin']);
4677   ConvertProgram;
4678   CheckSource('TestProc_LocalVarInit',
4679     LinesToStr([ // statements
4680     'var c = 4;',
4681     'this.DoIt = function () {',
4682     '  var b = 1;',
4683     '  var w = 2 + 4;',
4684     '  var p = null;',
4685     '  var Buffer = [];',
4686     '};',
4687     '']),
4688     LinesToStr([
4689     ]));
4690 end;
4691 
4692 procedure TTestModule.TestProc_ReservedWords;
4693 begin
4694   StartProgram(false);
4695   Add([
4696   'procedure Date(ArrayBuffer: longint);',
4697   'const',
4698   '  NaN: longint = 3;',
4699   'var',
4700   '  &Boolean: longint;',
4701   '  procedure Error(ArrayBuffer: longint);',
4702   '  begin',
4703   '  end;',
4704   'begin',
4705   '  Nan:=&bOolean;',
4706   'end;',
4707   'begin',
4708   '  Date(1);']);
4709   ConvertProgram;
4710   CheckSource('TestProc_ReservedWords',
4711     LinesToStr([ // statements
4712     'var naN = 3;',
4713     'this.Date = function (arrayBuffer) {',
4714     '  var boolean = 0;',
4715     '  function error(arrayBuffer) {',
4716     '  };',
4717     '  naN = boolean;',
4718     '};',
4719     '']),
4720     LinesToStr([
4721     '  $mod.Date(1);'
4722     ]));
4723 end;
4724 
4725 procedure TTestModule.TestProc_ConstRefWord;
4726 begin
4727   StartProgram(false);
4728   Add([
4729   'procedure Run(constref w: word);',
4730   'var l: word;',
4731   'begin',
4732   '  l:=w;',
4733   '  Run(w);',
4734   '  Run(l);',
4735   'end;',
4736   'procedure Fly(a: word; var b: word; out c: word; const d: word; constref e: word);',
4737   'begin',
4738   '  Run(a);',
4739   '  Run(b);',
4740   '  Run(c);',
4741   '  Run(d);',
4742   '  Run(e);',
4743   'end;',
4744   'begin',
4745   '  Run(1);']);
4746   ConvertProgram;
4747   CheckHint(mtWarning,nConstRefNotForXAsConst,'ConstRef not yet implemented for Word. Treating as Const');
4748   CheckSource('TestProc_ConstRefWord',
4749     LinesToStr([ // statements
4750     'this.Run = function (w) {',
4751     '  var l = 0;',
4752     '  l = w;',
4753     '  $mod.Run(w);',
4754     '  $mod.Run(l);',
4755     '};',
4756     'this.Fly = function (a, b, c, d, e) {',
4757     '  $mod.Run(a);',
4758     '  $mod.Run(b.get());',
4759     '  $mod.Run(c.get());',
4760     '  $mod.Run(d);',
4761     '  $mod.Run(e);',
4762     '};',
4763     '']),
4764     LinesToStr([
4765     '$mod.Run(1);'
4766     ]));
4767 end;
4768 
4769 procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
4770 begin
4771   StartProgram(false);
4772   Add([
4773   '{$mode objfpc}',
4774   'type',
4775   '  TFunc = reference to function(x: word): word;',
4776   'var Func: TFunc;',
4777   'procedure DoIt(a: word);',
4778   'begin',
4779   '  Func:=function(b:word): word',
4780   '  begin',
4781   '    Result:=a+b;',
4782   '    exit(b);',
4783   '    exit(Result);',
4784   '  end;',// test semicolon
4785   '  a:=3;',
4786   'end;',
4787   'begin',
4788   '  Func:=function(c:word):word begin',
4789   '    Result:=3+c;',
4790   '    exit(c);',
4791   '    exit(Result);',
4792   '  end;']);
4793   ConvertProgram;
4794   CheckSource('TestAnonymousProc_Assign_ObjFPC',
4795     LinesToStr([ // statements
4796     'this.Func = null;',
4797     'this.DoIt = function (a) {',
4798     '  $mod.Func = function (b) {',
4799     '    var Result = 0;',
4800     '    Result = a + b;',
4801     '    return b;',
4802     '    return Result;',
4803     '    return Result;',
4804     '  };',
4805     '  a = 3;',
4806     '};',
4807     '']),
4808     LinesToStr([
4809     '$mod.Func = function (c) {',
4810     '  var Result = 0;',
4811     '  Result = 3 + c;',
4812     '  return c;',
4813     '  return Result;',
4814     '  return Result;',
4815     '};',
4816     '']));
4817 end;
4818 
4819 procedure TTestModule.TestAnonymousProc_Assign_Delphi;
4820 begin
4821   StartProgram(false);
4822   Add([
4823   '{$mode delphi}',
4824   'type',
4825   '  TProc = reference to procedure(x: word);',
4826   'procedure DoIt(a: word);',
4827   'var Proc: TProc;',
4828   'begin',
4829   '  Proc:=procedure(b:word) begin end;',
4830   'end;',
4831   'var Proc: TProc;',
4832   'begin',
4833   '  Proc:=procedure(c:word) begin end;',
4834   '']);
4835   ConvertProgram;
4836   CheckSource('TestAnonymousProc_Assign_Delphi',
4837     LinesToStr([ // statements
4838     'this.DoIt = function (a) {',
4839     '  var Proc = null;',
4840     '  Proc = function (b) {',
4841     '  };',
4842     '};',
4843     'this.Proc = null;',
4844     '']),
4845     LinesToStr([
4846     '$mod.Proc = function (c) {',
4847     '};',
4848     '']));
4849 end;
4850 
4851 procedure TTestModule.TestAnonymousProc_Arg;
4852 begin
4853   StartProgram(false);
4854   Add([
4855   'type',
4856   '  TProc = reference to procedure;',
4857   '  TFunc = reference to function(x: word): word;',
4858   'procedure DoMore(f,g: TProc);',
4859   'begin',
4860   'end;',
4861   'procedure DoOdd(v: jsvalue);',
4862   'begin',
4863   'end;',
4864   'procedure DoIt(f: TFunc);',
4865   'begin',
4866   '  DoIt(function(b:word): word',
4867   '    begin',
4868   '      Result:=1+b;',
4869   '    end);',
4870   '  DoMore(procedure begin end, procedure begin end);',
4871   '  DoOdd(procedure begin end);',
4872   'end;',
4873   'begin',
4874   '  DoMore(procedure begin end,',
4875   '    procedure assembler asm',
4876   '      console.log("c");',
4877   '    end);',
4878   '']);
4879   ConvertProgram;
4880   CheckSource('TestAnonymousProc_Arg',
4881     LinesToStr([ // statements
4882     'this.DoMore = function (f, g) {',
4883     '};',
4884     'this.DoOdd = function (v) {',
4885     '};',
4886     'this.DoIt = function (f) {',
4887     '  $mod.DoIt(function (b) {',
4888     '    var Result = 0;',
4889     '    Result = 1 + b;',
4890     '    return Result;',
4891     '  });',
4892     '  $mod.DoMore(function () {',
4893     '  }, function () {',
4894     '  });',
4895     '  $mod.DoOdd(function () {',
4896     '  });',
4897     '};',
4898     '']),
4899     LinesToStr([
4900     '$mod.DoMore(function () {',
4901     '}, function () {',
4902     '  console.log("c");',
4903     '});',
4904     '']));
4905 end;
4906 
4907 procedure TTestModule.TestAnonymousProc_Typecast;
4908 begin
4909   StartProgram(false);
4910   Add([
4911   'type',
4912   '  TProc = reference to procedure(w: word);',
4913   '  TArr = array of word;',
4914   '  TFuncArr = reference to function: TArr;',
4915   'procedure DoIt(p: TProc);',
4916   'var',
4917   '  w: word;',
4918   '  a: TArr;',
4919   'begin',
4920   '  p:=TProc(procedure(b: smallint) begin end);',
4921   '  a:=TFuncArr(function: TArr begin end)();',
4922   '  w:=TFuncArr(function: TArr begin end)()[3];',
4923   'end;',
4924   'begin']);
4925   ConvertProgram;
4926   CheckSource('TestAnonymousProc_Typecast',
4927     LinesToStr([ // statements
4928     'this.DoIt = function (p) {',
4929     '  var w = 0;',
4930     '  var a = [];',
4931     '  p = function (b) {',
4932     '  };',
4933     '  a = function () {',
4934     '    var Result = [];',
4935     '    return Result;',
4936     '  }();',
4937     '  w = function () {',
4938     '    var Result = [];',
4939     '    return Result;',
4940     '  }()[3];',
4941     '};',
4942     '']),
4943     LinesToStr([
4944     '']));
4945 end;
4946 
4947 procedure TTestModule.TestAnonymousProc_With;
4948 begin
4949   StartProgram(false);
4950   Add([
4951   'type',
4952   '  TProc = reference to procedure(w: word);',
4953   '  TObject = class',
4954   '    b: boolean;',
4955   '  end;',
4956   'var',
4957   '  p: TProc;',
4958   '  bird: TObject;',
4959   'begin',
4960   '  with bird do',
4961   '    p:=procedure(w: word)',
4962   '      begin',
4963   '        b:=w>2;',
4964   '      end;',
4965   '']);
4966   ConvertProgram;
4967   CheckSource('TestAnonymousProc_With',
4968     LinesToStr([ // statements
4969     'rtl.createClass($mod, "TObject", null, function () {',
4970     '  this.$init = function () {',
4971     '    this.b = false;',
4972     '  };',
4973     '  this.$final = function () {',
4974     '  };',
4975     '});',
4976     'this.p = null;',
4977     'this.bird = null;',
4978     '']),
4979     LinesToStr([
4980     'var $with = $mod.bird;',
4981     '$mod.p = function (w) {',
4982     '  $with.b = w > 2;',
4983     '};',
4984     '']));
4985 end;
4986 
4987 procedure TTestModule.TestAnonymousProc_ExceptOn;
4988 begin
4989   StartProgram(false);
4990   Add([
4991   'type',
4992   '  TProc = reference to procedure;',
4993   '  TObject = class',
4994   '    b: boolean;',
4995   '  end;',
4996   'procedure DoIt;',
4997   'var',
4998   '  p: TProc;',
4999   'begin',
5000   '  try',
5001   '  except',
5002   '    on E: TObject do',
5003   '    p:=procedure',
5004   '      begin',
5005   '        E.b:=true;',
5006   '      end;',
5007   '  end;',
5008   'end;',
5009   'begin']);
5010   ConvertProgram;
5011   CheckSource('TestAnonymousProc_ExceptOn',
5012     LinesToStr([ // statements
5013     'rtl.createClass($mod, "TObject", null, function () {',
5014     '  this.$init = function () {',
5015     '    this.b = false;',
5016     '  };',
5017     '  this.$final = function () {',
5018     '  };',
5019     '});',
5020     'this.DoIt = function () {',
5021     '  var p = null;',
5022     '  try {} catch ($e) {',
5023     '    if ($mod.TObject.isPrototypeOf($e)) {',
5024     '      var E = $e;',
5025     '      p = function () {',
5026     '        E.b = true;',
5027     '      };',
5028     '    } else throw $e',
5029     '  };',
5030     '};',
5031     '']),
5032     LinesToStr([
5033     '']));
5034 end;
5035 
5036 procedure TTestModule.TestAnonymousProc_Nested;
5037 begin
5038   StartProgram(false);
5039   Add([
5040   'type',
5041   '  TProc = reference to procedure;',
5042   '  TObject = class',
5043   '    i: byte;',
5044   '    procedure DoIt;',
5045   '  end;',
5046   'procedure TObject.DoIt;',
5047   'var',
5048   '  p: TProc;',
5049   '  procedure Sub;',
5050   '  begin',
5051   '    p:=procedure',
5052   '      begin',
5053   '        i:=3;',
5054   '        Self.i:=4;',
5055   '        p:=procedure',
5056   '            procedure SubSub;',
5057   '            begin',
5058   '              i:=13;',
5059   '              Self.i:=14;',
5060   '            end;',
5061   '          begin',
5062   '            i:=13;',
5063   '            Self.i:=14;',
5064   '          end;',
5065   '      end;',
5066   '  end;',
5067   'begin',
5068   'end;',
5069   'begin']);
5070   ConvertProgram;
5071   CheckSource('TestAnonymousProc_Nested',
5072     LinesToStr([ // statements
5073     'rtl.createClass($mod, "TObject", null, function () {',
5074     '  this.$init = function () {',
5075     '    this.i = 0;',
5076     '  };',
5077     '  this.$final = function () {',
5078     '  };',
5079     '  this.DoIt = function () {',
5080     '    var $Self = this;',
5081     '    var p = null;',
5082     '    function Sub() {',
5083     '      p = function () {',
5084     '        $Self.i = 3;',
5085     '        $Self.i = 4;',
5086     '        p = function () {',
5087     '          function SubSub() {',
5088     '            $Self.i = 13;',
5089     '            $Self.i = 14;',
5090     '          };',
5091     '          $Self.i = 13;',
5092     '          $Self.i = 14;',
5093     '        };',
5094     '      };',
5095     '    };',
5096     '  };',
5097     '});',
5098     '']),
5099     LinesToStr([
5100     '']));
5101 end;
5102 
5103 procedure TTestModule.TestAnonymousProc_NestedAssignResult;
5104 begin
5105   StartProgram(false);
5106   Add([
5107   'type',
5108   '  TProc = reference to procedure;',
5109   'function DoIt: TProc;',
5110   '  function Sub: TProc;',
5111   '  begin',
5112   '    Result:=procedure',
5113   '      begin',
5114   '        Sub:=procedure',
5115   '            procedure SubSub;',
5116   '            begin',
5117   '              Result:=nil;',
5118   '              Sub:=nil;',
5119   '              DoIt:=nil;',
5120   '            end;',
5121   '          begin',
5122   '            Result:=nil;',
5123   '            Sub:=nil;',
5124   '            DoIt:=nil;',
5125   '          end;',
5126   '      end;',
5127   '  end;',
5128   'begin',
5129   'end;',
5130   'begin']);
5131   ConvertProgram;
5132   CheckSource('TestAnonymousProc_NestedAssignResult',
5133     LinesToStr([ // statements
5134     'this.DoIt = function () {',
5135     '  var Result = null;',
5136     '  function Sub() {',
5137     '    var Result$1 = null;',
5138     '    Result$1 = function () {',
5139     '      Result$1 = function () {',
5140     '        function SubSub() {',
5141     '          Result$1 = null;',
5142     '          Result$1 = null;',
5143     '          Result = null;',
5144     '        };',
5145     '        Result$1 = null;',
5146     '        Result$1 = null;',
5147     '        Result = null;',
5148     '      };',
5149     '    };',
5150     '    return Result$1;',
5151     '  };',
5152     '  return Result;',
5153     '};',
5154     '']),
5155     LinesToStr([
5156     '']));
5157 end;
5158 
5159 procedure TTestModule.TestAnonymousProc_Class;
5160 begin
5161   StartProgram(false);
5162   Add([
5163   'type',
5164   '  TProc = reference to procedure;',
5165   '  TEvent = procedure of object;',
5166   '  TObject = class',
5167   '    Size: word;',
5168   '    function GetIt: TProc;',
5169   '    procedure DoIt; virtual; abstract;',
5170   '  end;',
5171   'function TObject.GetIt: TProc;',
5172   'begin',
5173   '  Result:=procedure',
5174   '    var p: TEvent;',
5175   '    begin',
5176   '      Size:=Size;',
5177   '      Size:=Self.Size;',
5178   '      p:=@DoIt;',
5179   '      p:=@Self.DoIt;',
5180   '    end;',
5181   'end;',
5182   'begin']);
5183   ConvertProgram;
5184   CheckSource('TestAnonymousProc_Class',
5185     LinesToStr([ // statements
5186     'rtl.createClass($mod, "TObject", null, function () {',
5187     '  this.$init = function () {',
5188     '    this.Size = 0;',
5189     '  };',
5190     '  this.$final = function () {',
5191     '  };',
5192     '  this.GetIt = function () {',
5193     '    var $Self = this;',
5194     '    var Result = null;',
5195     '    Result = function () {',
5196     '      var p = null;',
5197     '      $Self.Size = $Self.Size;',
5198     '      $Self.Size = $Self.Size;',
5199     '      p = rtl.createCallback($Self, "DoIt");',
5200     '      p = rtl.createCallback($Self, "DoIt");',
5201     '    };',
5202     '    return Result;',
5203     '  };',
5204     '});',
5205     '']),
5206     LinesToStr([
5207     '']));
5208 end;
5209 
5210 procedure TTestModule.TestAnonymousProc_ForLoop;
5211 begin
5212   StartProgram(false);
5213   Add([
5214   'type TProc = reference to procedure;',
5215   'procedure Foo(p: TProc);',
5216   'begin',
5217   'end;',
5218   'procedure DoIt;',
5219   'var i: word;',
5220   '  a: word;',
5221   'begin',
5222   '  for i:=1 to 10 do begin',
5223   '    Foo(procedure begin a:=3; end);',
5224   '  end;',
5225   'end;',
5226   'begin',
5227   '  DoIt;']);
5228   ConvertProgram;
5229   CheckSource('TestAnonymousProc_ForLoop',
5230     LinesToStr([ // statements
5231     'this.Foo = function (p) {',
5232     '};',
5233     'this.DoIt = function () {',
5234     '  var i = 0;',
5235     '  var a = 0;',
5236     '  for (i = 1; i <= 10; i++) {',
5237     '    $mod.Foo(function () {',
5238     '      a = 3;',
5239     '    });',
5240     '  };',
5241     '};',
5242     '']),
5243     LinesToStr([
5244     '$mod.DoIt();'
5245     ]));
5246 end;
5247 
5248 procedure TTestModule.TestEnum_Name;
5249 begin
5250   StartProgram(false);
5251   Add('type TMyEnum = (Red, Green, Blue);');
5252   Add('var e: TMyEnum;');
5253   Add('var f: TMyEnum = Blue;');
5254   Add('begin');
5255   Add('  e:=green;');
5256   Add('  e:=default(TMyEnum);');
5257   ConvertProgram;
5258   CheckSource('TestEnumName',
5259     LinesToStr([ // statements
5260     'this.TMyEnum = {',
5261     '  "0":"Red",',
5262     '  Red:0,',
5263     '  "1":"Green",',
5264     '  Green:1,',
5265     '  "2":"Blue",',
5266     '  Blue:2',
5267     '  };',
5268     'this.e = 0;',
5269     'this.f = $mod.TMyEnum.Blue;'
5270     ]),
5271     LinesToStr([
5272     '$mod.e=$mod.TMyEnum.Green;',
5273     '$mod.e=$mod.TMyEnum.Red;'
5274     ]));
5275 end;
5276 
5277 procedure TTestModule.TestEnum_Number;
5278 begin
5279   Converter.Options:=Converter.Options+[coEnumNumbers];
5280   StartProgram(false);
5281   Add('type TMyEnum = (Red, Green);');
5282   Add('var');
5283   Add('  e: TMyEnum;');
5284   Add('  f: TMyEnum = Green;');
5285   Add('  i: longint;');
5286   Add('begin');
5287   Add('  e:=green;');
5288   Add('  i:=longint(e);');
5289   ConvertProgram;
5290   CheckSource('TestEnumNumber',
5291     LinesToStr([ // statements
5292     'this.TMyEnum = {',
5293     '  "0":"Red",',
5294     '  Red:0,',
5295     '  "1":"Green",',
5296     '  Green:1',
5297     '  };',
5298     'this.e = 0;',
5299     'this.f = 1;',
5300     'this.i = 0;'
5301     ]),
5302     LinesToStr([
5303     '$mod.e=1;',
5304     '$mod.i=$mod.e;'
5305     ]));
5306 end;
5307 
5308 procedure TTestModule.TestEnum_ConstFail;
5309 begin
5310   StartProgram(false);
5311   Add([
5312   'type TMyEnum = (Red = 100, Green = 101);',
5313   'var',
5314   '  e: TMyEnum;',
5315   '  f: TMyEnum = Green;',
5316   'begin',
5317   '  e:=green;']);
5318   SetExpectedPasResolverError('not yet implemented: Red:TPasEnumValue [20180126202434] "enum const"',3002);
5319   ConvertProgram;
5320 end;
5321 
5322 procedure TTestModule.TestEnum_Functions;
5323 begin
5324   StartProgram(false);
5325   Add([
5326   'type TMyEnum = (Red, Green);',
5327   'procedure DoIt(var e: TMyEnum; var i: word);',
5328   'var',
5329   '  v: longint;',
5330   '  s: string;',
5331   'begin',
5332   '  val(s,e,v);',
5333   '  val(s,e,i);',
5334   'end;',
5335   'var',
5336   '  e: TMyEnum;',
5337   '  i: longint;',
5338   '  s: string;',
5339   '  b: boolean;',
5340   'begin',
5341   '  i:=ord(red);',
5342   '  i:=ord(green);',
5343   '  i:=ord(e);',
5344   '  i:=ord(b);',
5345   '  e:=low(tmyenum);',
5346   '  e:=low(e);',
5347   '  b:=low(boolean);',
5348   '  e:=high(tmyenum);',
5349   '  e:=high(e);',
5350   '  b:=high(boolean);',
5351   '  e:=pred(green);',
5352   '  e:=pred(e);',
5353   '  b:=pred(b);',
5354   '  e:=succ(red);',
5355   '  e:=succ(e);',
5356   '  b:=succ(b);',
5357   '  e:=tmyenum(1);',
5358   '  e:=tmyenum(i);',
5359   '  s:=str(e);',
5360   '  str(e,s);',
5361   '  str(red,s);',
5362   '  s:=str(e:3);',
5363   '  writestr(s,e:3,red);',
5364   '  val(s,e,i);',
5365   '  e:=TMyEnum(i);',
5366   '  i:=longint(e);']);
5367   ConvertProgram;
5368   CheckSource('TestEnum_Functions',
5369     LinesToStr([ // statements
5370     'this.TMyEnum = {',
5371     '  "0":"Red",',
5372     '  Red:0,',
5373     '  "1":"Green",',
5374     '  Green:1',
5375     '  };',
5376     'this.DoIt = function (e, i) {',
5377     '  var v = 0;',
5378     '  var s = "";',
5379     '  e.set(rtl.valEnum(s, $mod.TMyEnum, function (w) {',
5380     '    v = w;',
5381     '  }));',
5382     '  e.set(rtl.valEnum(s, $mod.TMyEnum, i.set));',
5383     '};',
5384     'this.e = 0;',
5385     'this.i = 0;',
5386     'this.s = "";',
5387     'this.b = false;',
5388     '']),
5389     LinesToStr([
5390     '$mod.i=$mod.TMyEnum.Red;',
5391     '$mod.i=$mod.TMyEnum.Green;',
5392     '$mod.i=$mod.e;',
5393     '$mod.i=$mod.b+0;',
5394     '$mod.e=$mod.TMyEnum.Red;',
5395     '$mod.e=$mod.TMyEnum.Red;',
5396     '$mod.b=false;',
5397     '$mod.e=$mod.TMyEnum.Green;',
5398     '$mod.e=$mod.TMyEnum.Green;',
5399     '$mod.b=true;',
5400     '$mod.e=$mod.TMyEnum.Green-1;',
5401     '$mod.e=$mod.e-1;',
5402     '$mod.b=false;',
5403     '$mod.e=$mod.TMyEnum.Red+1;',
5404     '$mod.e=$mod.e+1;',
5405     '$mod.b=true;',
5406     '$mod.e=1;',
5407     '$mod.e=$mod.i;',
5408     '$mod.s = $mod.TMyEnum[$mod.e];',
5409     '$mod.s = $mod.TMyEnum[$mod.e];',
5410     '$mod.s = $mod.TMyEnum[$mod.TMyEnum.Red];',
5411     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
5412     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3)+$mod.TMyEnum[$mod.TMyEnum.Red];',
5413     '$mod.e = rtl.valEnum($mod.s, $mod.TMyEnum, function (v) {',
5414     '  $mod.i = v;',
5415     '});',
5416     '$mod.e=$mod.i;',
5417     '$mod.i=$mod.e;',
5418     '']));
5419 end;
5420 
5421 procedure TTestModule.TestEnum_AsParams;
5422 begin
5423   StartProgram(false);
5424   Add('type TEnum = (Red,Blue);');
5425   Add('procedure DoIt(vG: TEnum; const vH: TEnum; var vI: TEnum);');
5426   Add('var vJ: TEnum;');
5427   Add('begin');
5428   Add('  vg:=vg;');
5429   Add('  vj:=vh;');
5430   Add('  vi:=vi;');
5431   Add('  doit(vg,vg,vg);');
5432   Add('  doit(vh,vh,vj);');
5433   Add('  doit(vi,vi,vi);');
5434   Add('  doit(vj,vj,vj);');
5435   Add('end;');
5436   Add('var i: TEnum;');
5437   Add('begin');
5438   Add('  doit(i,i,i);');
5439   ConvertProgram;
5440   CheckSource('TestEnum_AsParams',
5441     LinesToStr([ // statements
5442     'this.TEnum = {',
5443     '  "0": "Red",',
5444     '  Red: 0,',
5445     '  "1": "Blue",',
5446     '  Blue: 1',
5447     '};',
5448     'this.DoIt = function (vG,vH,vI) {',
5449     '  var vJ = 0;',
5450     '  vG = vG;',
5451     '  vJ = vH;',
5452     '  vI.set(vI.get());',
5453     '  $mod.DoIt(vG, vG, {',
5454     '    get: function () {',
5455     '      return vG;',
5456     '    },',
5457     '    set: function (v) {',
5458     '      vG = v;',
5459     '    }',
5460     '  });',
5461     '  $mod.DoIt(vH, vH, {',
5462     '    get: function () {',
5463     '      return vJ;',
5464     '    },',
5465     '    set: function (v) {',
5466     '      vJ = v;',
5467     '    }',
5468     '  });',
5469     '  $mod.DoIt(vI.get(), vI.get(), vI);',
5470     '  $mod.DoIt(vJ, vJ, {',
5471     '    get: function () {',
5472     '      return vJ;',
5473     '    },',
5474     '    set: function (v) {',
5475     '      vJ = v;',
5476     '    }',
5477     '  });',
5478     '};',
5479     'this.i = 0;'
5480     ]),
5481     LinesToStr([
5482     '$mod.DoIt($mod.i,$mod.i,{',
5483     '  p: $mod,',
5484     '  get: function () {',
5485     '      return this.p.i;',
5486     '    },',
5487     '  set: function (v) {',
5488     '      this.p.i = v;',
5489     '    }',
5490     '});'
5491     ]));
5492 end;
5493 
5494 procedure TTestModule.TestEnumRange_Array;
5495 begin
5496   StartProgram(false);
5497   Add([
5498   'type',
5499   '  TEnum = (Red, Green, Blue);',
5500   '  TEnumRg = green..blue;',
5501   '  TArr = array[TEnumRg] of byte;',
5502   '  TArr2 = array[green..blue] of byte;',
5503   'var',
5504   '  a: TArr;',
5505   '  b: TArr = (3,4);',
5506   '  c: TArr2 = (5,6);',
5507   'begin',
5508   '  a[green] := b[blue];',
5509   '  c[green] := c[blue];',
5510   '']);
5511   ConvertProgram;
5512   CheckSource('TestEnumRange_Array',
5513     LinesToStr([ // statements
5514     'this.TEnum = {',
5515     '  "0": "Red",',
5516     '  Red: 0,',
5517     '  "1": "Green",',
5518     '  Green: 1,',
5519     '  "2": "Blue",',
5520     '  Blue: 2',
5521     '};',
5522     'this.a = rtl.arraySetLength(null, 0, 2);',
5523     'this.b = [3, 4];',
5524     'this.c = [5, 6];',
5525     '']),
5526     LinesToStr([
5527     '  $mod.a[$mod.TEnum.Green - 1] = $mod.b[$mod.TEnum.Blue - 1];',
5528     '  $mod.c[$mod.TEnum.Green - 1] = $mod.c[$mod.TEnum.Blue - 1];',
5529     '']));
5530 end;
5531 
5532 procedure TTestModule.TestEnum_ForIn;
5533 begin
5534   StartProgram(false);
5535   Add([
5536   'type',
5537   '  TEnum = (Red, Green, Blue);',
5538   '  TEnumRg = green..blue;',
5539   '  TArr = array[TEnum] of byte;',
5540   '  TArrRg = array[TEnumRg] of byte;',
5541   'var',
5542   '  e: TEnum;',
5543   '  a1: TArr = (3,4,5);',
5544   '  a2: TArrRg = (11,12);',
5545   '  b: byte;',
5546   'begin',
5547   '  for e in TEnum do ;',
5548   '  for e in TEnumRg do ;',
5549   '  for e in TArr do ;',
5550   '  for e in TArrRg do ;',
5551   '  for b in a1 do ;',
5552   '  for b in a2 do ;',
5553   '']);
5554   ConvertProgram;
5555   CheckSource('TestEnum_ForIn',
5556     LinesToStr([ // statements
5557     'this.TEnum = {',
5558     '  "0": "Red",',
5559     '  Red: 0,',
5560     '  "1": "Green",',
5561     '  Green: 1,',
5562     '  "2": "Blue",',
5563     '  Blue: 2',
5564     '};',
5565     'this.e = 0;',
5566     'this.a1 = [3, 4, 5];',
5567     'this.a2 = [11, 12];',
5568     'this.b = 0;',
5569     '']),
5570     LinesToStr([
5571     '  for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
5572     '  for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
5573     '  for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
5574     '  for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
5575     '  for (var $in = $mod.a1, $l = 0, $end = rtl.length($in) - 1; $l <= $end; $l++) $mod.b = $in[$l];',
5576     '  for (var $in1 = $mod.a2, $l1 = 0, $end1 = rtl.length($in1) - 1; $l1 <= $end1; $l1++) $mod.b = $in1[$l1];',
5577     '']));
5578 end;
5579 
5580 procedure TTestModule.TestEnum_ScopedNumber;
5581 begin
5582   Converter.Options:=Converter.Options+[coEnumNumbers];
5583   StartProgram(false);
5584   Add([
5585   'type',
5586   '  TEnum = (Red, Green);',
5587   'var',
5588   '  e: TEnum;',
5589   'begin',
5590   '  e:=TEnum.Green;',
5591   '']);
5592   ConvertProgram;
5593   CheckSource('TestEnum_ScopedNumber',
5594     LinesToStr([ // statements
5595     'this.TEnum = {',
5596     '  "0": "Red",',
5597     '  Red: 0,',
5598     '  "1": "Green",',
5599     '  Green: 1',
5600     '};',
5601     'this.e = 0;',
5602     '']),
5603     LinesToStr([
5604     '$mod.e = 1;']));
5605 end;
5606 
5607 procedure TTestModule.TestEnum_InFunction;
5608 begin
5609   StartProgram(false);
5610   Add([
5611   'const TEnum = 3;',
5612   'procedure DoIt;',
5613   'type',
5614   '  TEnum = (Red, Green, Blue);',
5615   '  procedure Sub;',
5616   '  type',
5617   '    TEnumSub = (Left, Right);',
5618   '  var',
5619   '    es: TEnumSub;',
5620   '  begin',
5621   '    es:=Left;',
5622   '  end;',
5623   'var',
5624   '  e, e2: TEnum;',
5625   'begin',
5626   '  if e in [red,blue] then e2:=e;',
5627   'end;',
5628   'begin']);
5629   ConvertProgram;
5630   CheckSource('TestEnum_InFunction',
5631     LinesToStr([ // statements
5632     'this.TEnum = 3;',
5633     'var TEnum$1 = {',
5634     '  "0":"Red",',
5635     '  Red:0,',
5636     '  "1":"Green",',
5637     '  Green:1,',
5638     '  "2":"Blue",',
5639     '  Blue:2',
5640     '  };',
5641     'var TEnumSub = {',
5642     '  "0": "Left",',
5643     '  Left: 0,',
5644     '  "1": "Right",',
5645     '  Right: 1',
5646     '};',
5647     'this.DoIt = function () {',
5648     '  function Sub() {',
5649     '    var es = 0;',
5650     '    es = TEnumSub.Left;',
5651     '  };',
5652     '  var e = 0;',
5653     '  var e2 = 0;',
5654     '  if (e in rtl.createSet(TEnum$1.Red, TEnum$1.Blue)) e2 = e;',
5655     '};',
5656     '']),
5657     LinesToStr([
5658     '']));
5659 end;
5660 
5661 procedure TTestModule.TestSet_Enum;
5662 begin
5663   StartProgram(false);
5664   Add([
5665   'type',
5666   '  TColor = (Red, Green, Blue);',
5667   '  TColors = set of TColor;',
5668   'var',
5669   '  c: TColor;',
5670   '  s: TColors;',
5671   '  t: TColors = [];',
5672   '  u: TColors = [Red];',
5673   'begin',
5674   '  s:=[];',
5675   '  s:=[Green];',
5676   '  s:=[Green,Blue];',
5677   '  s:=[Red..Blue];',
5678   '  s:=[Red,Green..Blue];',
5679   '  s:=[Red,c];',
5680   '  s:=t;',
5681   '  s:=default(TColors);',
5682   '']);
5683   ConvertProgram;
5684   CheckSource('TestSet',
5685     LinesToStr([ // statements
5686     'this.TColor = {',
5687     '  "0":"Red",',
5688     '  Red:0,',
5689     '  "1":"Green",',
5690     '  Green:1,',
5691     '  "2":"Blue",',
5692     '  Blue:2',
5693     '  };',
5694     'this.c = 0;',
5695     'this.s = {};',
5696     'this.t = {};',
5697     'this.u = rtl.createSet($mod.TColor.Red);'
5698     ]),
5699     LinesToStr([
5700     '$mod.s={};',
5701     '$mod.s=rtl.createSet($mod.TColor.Green);',
5702     '$mod.s=rtl.createSet($mod.TColor.Green,$mod.TColor.Blue);',
5703     '$mod.s=rtl.createSet(null,$mod.TColor.Red,$mod.TColor.Blue);',
5704     '$mod.s=rtl.createSet($mod.TColor.Red,null,$mod.TColor.Green,$mod.TColor.Blue);',
5705     '$mod.s=rtl.createSet($mod.TColor.Red,$mod.c);',
5706     '$mod.s=rtl.refSet($mod.t);',
5707     '$mod.s={};',
5708     '']));
5709 end;
5710 
5711 procedure TTestModule.TestSet_Operators;
5712 begin
5713   StartProgram(false);
5714   Add('type');
5715   Add('  TColor = (Red, Green, Blue);');
5716   Add('  TColors = set of tcolor;');
5717   Add('var');
5718   Add('  vC: TColor;');
5719   Add('  vS: TColors;');
5720   Add('  vT: TColors;');
5721   Add('  vU: TColors;');
5722   Add('  B: boolean;');
5723   Add('begin');
5724   Add('  include(vs,green);');
5725   Add('  exclude(vs,vc);');
5726   Add('  vs:=vt+vu;');
5727   Add('  vs:=vt+[red];');
5728   Add('  vs:=[red]+vt;');
5729   Add('  vs:=[red]+[green];');
5730   Add('  vs:=vt-vu;');
5731   Add('  vs:=vt-[red];');
5732   Add('  vs:=[red]-vt;');
5733   Add('  vs:=[red]-[green];');
5734   Add('  vs:=vt*vu;');
5735   Add('  vs:=vt*[red];');
5736   Add('  vs:=[red]*vt;');
5737   Add('  vs:=[red]*[green];');
5738   Add('  vs:=vt><vu;');
5739   Add('  vs:=vt><[red];');
5740   Add('  vs:=[red]><vt;');
5741   Add('  vs:=[red]><[green];');
5742   Add('  b:=vt=vu;');
5743   Add('  b:=vt=[red];');
5744   Add('  b:=[red]=vt;');
5745   Add('  b:=[red]=[green];');
5746   Add('  b:=vt<>vu;');
5747   Add('  b:=vt<>[red];');
5748   Add('  b:=[red]<>vt;');
5749   Add('  b:=[red]<>[green];');
5750   Add('  b:=vt<=vu;');
5751   Add('  b:=vt<=[red];');
5752   Add('  b:=[red]<=vt;');
5753   Add('  b:=[red]<=[green];');
5754   Add('  b:=vt>=vu;');
5755   Add('  b:=vt>=[red];');
5756   Add('  b:=[red]>=vt;');
5757   Add('  b:=[red]>=[green];');
5758   ConvertProgram;
5759   CheckSource('TestSet_Operators',
5760     LinesToStr([ // statements
5761     'this.TColor = {',
5762     '  "0":"Red",',
5763     '  Red:0,',
5764     '  "1":"Green",',
5765     '  Green:1,',
5766     '  "2":"Blue",',
5767     '  Blue:2',
5768     '  };',
5769     'this.vC = 0;',
5770     'this.vS = {};',
5771     'this.vT = {};',
5772     'this.vU = {};',
5773     'this.B = false;'
5774     ]),
5775     LinesToStr([
5776     '$mod.vS = rtl.includeSet($mod.vS,$mod.TColor.Green);',
5777     '$mod.vS = rtl.excludeSet($mod.vS,$mod.vC);',
5778     '$mod.vS = rtl.unionSet($mod.vT, $mod.vU);',
5779     '$mod.vS = rtl.unionSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5780     '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5781     '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5782     '$mod.vS = rtl.diffSet($mod.vT, $mod.vU);',
5783     '$mod.vS = rtl.diffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5784     '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5785     '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5786     '$mod.vS = rtl.intersectSet($mod.vT, $mod.vU);',
5787     '$mod.vS = rtl.intersectSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5788     '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5789     '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5790     '$mod.vS = rtl.symDiffSet($mod.vT, $mod.vU);',
5791     '$mod.vS = rtl.symDiffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5792     '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5793     '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5794     '$mod.B = rtl.eqSet($mod.vT, $mod.vU);',
5795     '$mod.B = rtl.eqSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5796     '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5797     '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5798     '$mod.B = rtl.neSet($mod.vT, $mod.vU);',
5799     '$mod.B = rtl.neSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5800     '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5801     '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5802     '$mod.B = rtl.leSet($mod.vT, $mod.vU);',
5803     '$mod.B = rtl.leSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5804     '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5805     '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5806     '$mod.B = rtl.geSet($mod.vT, $mod.vU);',
5807     '$mod.B = rtl.geSet($mod.vT, rtl.createSet($mod.TColor.Red));',
5808     '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
5809     '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
5810     '']));
5811 end;
5812 
5813 procedure TTestModule.TestSet_Operator_In;
5814 begin
5815   StartProgram(false);
5816   Add('type');
5817   Add('  TColor = (Red, Green, Blue);');
5818   Add('  TColors = set of tcolor;');
5819   Add('var');
5820   Add('  vC: tcolor;');
5821   Add('  vT: tcolors;');
5822   Add('  B: boolean;');
5823   Add('begin');
5824   Add('  b:=red in vt;');
5825   Add('  b:=vc in vt;');
5826   Add('  b:=green in [red..blue];');
5827   Add('  b:=vc in [red..blue];');
5828   Add('  ');
5829   Add('  if red in vt then ;');
5830   Add('  while vC in vt do ;');
5831   Add('  repeat');
5832   Add('  until vC in vt;');
5833   ConvertProgram;
5834   CheckSource('TestSet_Operator_In',
5835     LinesToStr([ // statements
5836     'this.TColor = {',
5837     '  "0":"Red",',
5838     '  Red:0,',
5839     '  "1":"Green",',
5840     '  Green:1,',
5841     '  "2":"Blue",',
5842     '  Blue:2',
5843     '  };',
5844     'this.vC = 0;',
5845     'this.vT = {};',
5846     'this.B = false;'
5847     ]),
5848     LinesToStr([
5849     '$mod.B = $mod.TColor.Red in $mod.vT;',
5850     '$mod.B = $mod.vC in $mod.vT;',
5851     '$mod.B = $mod.TColor.Green in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
5852     '$mod.B = $mod.vC in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
5853     'if ($mod.TColor.Red in $mod.vT) ;',
5854     'while ($mod.vC in $mod.vT) {',
5855     '};',
5856     'do {',
5857     '} while (!($mod.vC in $mod.vT));',
5858     '']));
5859 end;
5860 
5861 procedure TTestModule.TestSet_Functions;
5862 begin
5863   StartProgram(false);
5864   Add('type');
5865   Add('  TMyEnum = (Red, Green);');
5866   Add('  TMyEnums = set of TMyEnum;');
5867   Add('var');
5868   Add('  e: TMyEnum;');
5869   Add('  s: TMyEnums;');
5870   Add('begin');
5871   Add('  e:=Low(TMyEnums);');
5872   Add('  e:=Low(s);');
5873   Add('  e:=High(TMyEnums);');
5874   Add('  e:=High(s);');
5875   ConvertProgram;
5876   CheckSource('TestSetFunctions',
5877     LinesToStr([ // statements
5878     'this.TMyEnum = {',
5879     '  "0":"Red",',
5880     '  Red:0,',
5881     '  "1":"Green",',
5882     '  Green:1',
5883     '  };',
5884     'this.e = 0;',
5885     'this.s = {};'
5886     ]),
5887     LinesToStr([
5888     '$mod.e=$mod.TMyEnum.Red;',
5889     '$mod.e=$mod.TMyEnum.Red;',
5890     '$mod.e=$mod.TMyEnum.Green;',
5891     '$mod.e=$mod.TMyEnum.Green;',
5892     '']));
5893 end;
5894 
5895 procedure TTestModule.TestSet_PassAsArgClone;
5896 begin
5897   StartProgram(false);
5898   Add('type');
5899   Add('  TMyEnum = (Red, Green);');
5900   Add('  TMyEnums = set of TMyEnum;');
5901   Add('procedure DoDefault(s: tmyenums); begin end;');
5902   Add('procedure DoConst(const s: tmyenums); begin end;');
5903   Add('var');
5904   Add('  aSet: tmyenums;');
5905   Add('begin');
5906   Add('  dodefault(aset);');
5907   Add('  doconst(aset);');
5908   ConvertProgram;
5909   CheckSource('TestSetFunctions',
5910     LinesToStr([ // statements
5911     'this.TMyEnum = {',
5912     '  "0":"Red",',
5913     '  Red:0,',
5914     '  "1":"Green",',
5915     '  Green:1',
5916     '  };',
5917     'this.DoDefault = function (s) {',
5918     '};',
5919     'this.DoConst = function (s) {',
5920     '};',
5921     'this.aSet = {};'
5922     ]),
5923     LinesToStr([
5924     '$mod.DoDefault(rtl.refSet($mod.aSet));',
5925     '$mod.DoConst($mod.aSet);',
5926     '']));
5927 end;
5928 
5929 procedure TTestModule.TestSet_AsParams;
5930 begin
5931   StartProgram(false);
5932   Add([
5933   'type TEnum = (Red,Blue);',
5934   'type TEnums = set of TEnum;',
5935   'function DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums): TEnums;',
5936   'var vJ: TEnums;',
5937   'begin',
5938   '  Include(vg,red);',
5939   '  Include(result,blue);',
5940   '  vg:=vg;',
5941   '  vj:=vh;',
5942   '  vi:=vi;',
5943   '  doit(vg,vg,vg);',
5944   '  doit(vh,vh,vj);',
5945   '  doit(vi,vi,vi);',
5946   '  doit(vj,vj,vj);',
5947   'end;',
5948   'var i: TEnums;',
5949   'begin',
5950   '  doit(i,i,i);']);
5951   ConvertProgram;
5952   CheckSource('TestSet_AsParams',
5953     LinesToStr([ // statements
5954     'this.TEnum = {',
5955     '  "0": "Red",',
5956     '  Red: 0,',
5957     '  "1": "Blue",',
5958     '  Blue: 1',
5959     '};',
5960     'this.DoIt = function (vG,vH,vI) {',
5961     '  var Result = {};',
5962     '  var vJ = {};',
5963     '  vG = rtl.includeSet(vG, $mod.TEnum.Red);',
5964     '  Result = rtl.includeSet(Result, $mod.TEnum.Blue);',
5965     '  vG = rtl.refSet(vG);',
5966     '  vJ = rtl.refSet(vH);',
5967     '  vI.set(rtl.refSet(vI.get()));',
5968     '  $mod.DoIt(rtl.refSet(vG), vG, {',
5969     '    get: function () {',
5970     '      return vG;',
5971     '    },',
5972     '    set: function (v) {',
5973     '      vG = v;',
5974     '    }',
5975     '  });',
5976     '  $mod.DoIt(rtl.refSet(vH), vH, {',
5977     '    get: function () {',
5978     '      return vJ;',
5979     '    },',
5980     '    set: function (v) {',
5981     '      vJ = v;',
5982     '    }',
5983     '  });',
5984     '  $mod.DoIt(rtl.refSet(vI.get()), vI.get(), vI);',
5985     '  $mod.DoIt(rtl.refSet(vJ), vJ, {',
5986     '    get: function () {',
5987     '      return vJ;',
5988     '    },',
5989     '    set: function (v) {',
5990     '      vJ = v;',
5991     '    }',
5992     '  });',
5993     '  return Result;',
5994     '};',
5995     'this.i = {};'
5996     ]),
5997     LinesToStr([
5998     '$mod.DoIt(rtl.refSet($mod.i),$mod.i,{',
5999     '  p: $mod,',
6000     '  get: function () {',
6001     '      return this.p.i;',
6002     '    },',
6003     '  set: function (v) {',
6004     '      this.p.i = v;',
6005     '    }',
6006     '});'
6007     ]));
6008 end;
6009 
6010 procedure TTestModule.TestSet_Property;
6011 begin
6012   StartProgram(false);
6013   Add('type');
6014   Add('  TEnum = (Red,Blue);');
6015   Add('  TEnums = set of TEnum;');
6016   Add('  TObject = class');
6017   Add('    function GetColors: TEnums; external name ''GetColors'';');
6018   Add('    procedure SetColors(const Value: TEnums); external name ''SetColors'';');
6019   Add('    property Colors: TEnums read GetColors write SetColors;');
6020   Add('  end;');
6021   Add('procedure DoIt(i: TEnums; const j: TEnums; var k: TEnums; out l: TEnums);');
6022   Add('begin end;');
6023   Add('var Obj: TObject;');
6024   Add('begin');
6025   Add('  Include(Obj.Colors,Red);');
6026   Add('  Exclude(Obj.Colors,Red);');
6027   //Add('  DoIt(Obj.Colors,Obj.Colors,Obj.Colors,Obj.Colors);');
6028   ConvertProgram;
6029   CheckSource('TestSet_Property',
6030     LinesToStr([ // statements
6031     'this.TEnum = {',
6032     '  "0": "Red",',
6033     '  Red: 0,',
6034     '  "1": "Blue",',
6035     '  Blue: 1',
6036     '};',
6037     'rtl.createClass($mod, "TObject", null, function () {',
6038     '  this.$init = function () {',
6039     '  };',
6040     '  this.$final = function () {',
6041     '  };',
6042     '});',
6043     'this.DoIt = function (i, j, k, l) {',
6044     '};',
6045     'this.Obj = null;',
6046     '']),
6047     LinesToStr([
6048     '$mod.Obj.SetColors(rtl.includeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
6049     '$mod.Obj.SetColors(rtl.excludeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
6050     '']));
6051 end;
6052 
6053 procedure TTestModule.TestSet_EnumConst;
6054 begin
6055   StartProgram(false);
6056   Add([
6057   'type',
6058   '  TEnum = (Red,Blue);',
6059   '  TEnums = set of TEnum;',
6060   'const',
6061   '  Orange = red;',
6062   'var',
6063   '  Enum: tenum;',
6064   '  Enums: tenums;',
6065   'begin',
6066   '  Include(enums,orange);',
6067   '  Exclude(enums,orange);',
6068   '  if orange in enums then;',
6069   '  if orange in [orange,red] then;']);
6070   ConvertProgram;
6071   CheckSource('TestSet_EnumConst',
6072     LinesToStr([ // statements
6073     'this.TEnum = {',
6074     '  "0": "Red",',
6075     '  Red: 0,',
6076     '  "1": "Blue",',
6077     '  Blue: 1',
6078     '};',
6079     'this.Orange = $mod.TEnum.Red;',
6080     'this.Enum = 0;',
6081     'this.Enums = {};',
6082     '']),
6083     LinesToStr([
6084     '$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);',
6085     '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);',
6086     'if ($mod.TEnum.Red in $mod.Enums) ;',
6087     'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;',
6088     '']));
6089 end;
6090 
6091 procedure TTestModule.TestSet_IntConst;
6092 begin
6093   StartProgram(false);
6094   Add([
6095   'type',
6096   '  TEnums = set of Byte;',
6097   'const',
6098   '  Orange = 0;',
6099   'var',
6100   '  Enum: byte;',
6101   '  Enums: tenums;',
6102   'begin',
6103   '  Enums:=[];',
6104   '  Enums:=[0];',
6105   '  Enums:=[1..2];',
6106   //'  Include(enums,orange);',
6107   //'  Exclude(enums,orange);',
6108   '  if orange in enums then;',
6109   '  if orange in [orange,1] then;']);
6110   ConvertProgram;
6111   CheckSource('TestSet_IntConst',
6112     LinesToStr([ // statements
6113     'this.Orange = 0;',
6114     'this.Enum = 0;',
6115     'this.Enums = {};',
6116     '']),
6117     LinesToStr([
6118     '$mod.Enums = {};',
6119     '$mod.Enums = rtl.createSet(0);',
6120     '$mod.Enums = rtl.createSet(null, 1, 2);',
6121     'if (0 in $mod.Enums) ;',
6122     'if (0 in rtl.createSet(0, 1)) ;',
6123     '']));
6124 end;
6125 
6126 procedure TTestModule.TestSet_AnonymousEnumType;
6127 begin
6128   StartProgram(false);
6129   Add('type');
6130   Add('  TFlags = set of (red, green);');
6131   Add('const');
6132   Add('  favorite = red;');
6133   Add('var');
6134   Add('  f: TFlags;');
6135   Add('  i: longint;');
6136   Add('begin');
6137   Add('  Include(f,red);');
6138   Add('  Include(f,favorite);');
6139   Add('  i:=ord(red);');
6140   Add('  i:=ord(favorite);');
6141   Add('  i:=ord(low(TFlags));');
6142   Add('  i:=ord(low(f));');
6143   Add('  i:=ord(low(favorite));');
6144   Add('  i:=ord(high(TFlags));');
6145   Add('  i:=ord(high(f));');
6146   Add('  i:=ord(high(favorite));');
6147   Add('  f:=[green,favorite];');
6148   ConvertProgram;
6149   CheckSource('TestSet_AnonymousEnumType',
6150     LinesToStr([ // statements
6151     'this.TFlags$a = {',
6152     '  "0": "red",',
6153     '  red: 0,',
6154     '  "1": "green",',
6155     '  green: 1',
6156     '};',
6157     'this.favorite = $mod.TFlags$a.red;',
6158     'this.f = {};',
6159     'this.i = 0;',
6160     '']),
6161     LinesToStr([
6162     '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
6163     '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
6164     '$mod.i = $mod.TFlags$a.red;',
6165     '$mod.i = $mod.TFlags$a.red;',
6166     '$mod.i = $mod.TFlags$a.red;',
6167     '$mod.i = $mod.TFlags$a.red;',
6168     '$mod.i = $mod.TFlags$a.red;',
6169     '$mod.i = $mod.TFlags$a.green;',
6170     '$mod.i = $mod.TFlags$a.green;',
6171     '$mod.i = $mod.TFlags$a.green;',
6172     '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);',
6173     '']));
6174 end;
6175 
6176 procedure TTestModule.TestSet_AnonymousEnumTypeChar;
6177 begin
6178   exit;
6179   StartProgram(false);
6180   Add([
6181   'type',
6182   '  TAtoZ = ''A''..''Z'';',
6183   '  TSetOfAZ = set of TAtoZ;',
6184   'var',
6185   '  c: char;',
6186   '  a: TAtoZ;',
6187   '  s: TSetOfAZ = [''P'',''A''];',
6188   '  i: longint;',
6189   'begin',
6190   '  Include(s,''S'');',
6191   '  Include(s,c);',
6192   '  Include(s,a);',
6193   '  c:=low(TAtoZ);',
6194   '  i:=ord(low(TAtoZ));',
6195   '  a:=high(TAtoZ);',
6196   '  a:=high(TSetOfAtoZ);',
6197   '  s:=[a,c,''M''];',
6198   '']);
6199   ConvertProgram;
6200   CheckSource('TestSet_AnonymousEnumTypeChar',
6201     LinesToStr([ // statements
6202     '']),
6203     LinesToStr([
6204     '']));
6205 end;
6206 
6207 procedure TTestModule.TestSet_ConstEnum;
6208 begin
6209   StartProgram(false);
6210   Add([
6211   'type',
6212   '  TEnum = (red,blue,green);',
6213   '  TEnums = set of TEnum;',
6214   'const',
6215   '  teAny = [low(TEnum)..high(TEnum)];',
6216   '  teRedBlue = [low(TEnum)..pred(high(TEnum))];',
6217   'var',
6218   '  e: TEnum;',
6219   '  s: TEnums;',
6220   'begin',
6221   '  if blue in teAny then;',
6222   '  if blue in teAny+[e] then;',
6223   '  if blue in teAny+teRedBlue then;',
6224   '  if e in [red,blue] then;',
6225   '  s:=teAny;',
6226   '  s:=teAny+[e];',
6227   '  s:=[e]+teAny;',
6228   '  s:=teAny+teRedBlue;',
6229   '  s:=teAny+teRedBlue+[e];',
6230   '']);
6231   ConvertProgram;
6232   CheckSource('TestSet_ConstEnum',
6233     LinesToStr([ // statements
6234     'this.TEnum = {',
6235     '  "0": "red",',
6236     '  red: 0,',
6237     '  "1": "blue",',
6238     '  blue: 1,',
6239     '  "2": "green",',
6240     '  green: 2',
6241     '};',
6242     'this.teAny = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green);',
6243     'this.teRedBlue = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green - 1);',
6244     'this.e = 0;',
6245     'this.s = {};',
6246     '']),
6247     LinesToStr([
6248     'if ($mod.TEnum.blue in $mod.teAny) ;',
6249     'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, rtl.createSet($mod.e))) ;',
6250     'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, $mod.teRedBlue)) ;',
6251     'if ($mod.e in rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)) ;',
6252     '$mod.s = rtl.refSet($mod.teAny);',
6253     '$mod.s = rtl.unionSet($mod.teAny, rtl.createSet($mod.e));',
6254     '$mod.s = rtl.unionSet(rtl.createSet($mod.e), $mod.teAny);',
6255     '$mod.s = rtl.unionSet($mod.teAny, $mod.teRedBlue);',
6256     '$mod.s = rtl.unionSet(rtl.unionSet($mod.teAny, $mod.teRedBlue), rtl.createSet($mod.e));',
6257     '']));
6258 end;
6259 
6260 procedure TTestModule.TestSet_ConstChar;
6261 begin
6262   StartProgram(false);
6263   Add([
6264   'const',
6265   '  LowChars = [''a''..''z''];',
6266   '  Chars = LowChars+[''A''..''Z''];',
6267   '  sc = [''А'', ''Я''];',
6268   'var',
6269   '  c: char;',
6270   '  s: string;',
6271   'begin',
6272   '  if c in lowchars then ;',
6273   '  if ''a'' in lowchars then ;',
6274   '  if s[1] in lowchars then ;',
6275   '  if c in chars then ;',
6276   '  if c in [''a''..''z'',''_''] then ;',
6277   '  if ''b'' in [''a''..''z'',''_''] then ;',
6278   '  if ''Я'' in sc then ;',
6279   '  if 3=ord('' '') then ;',
6280   '']);
6281   ConvertProgram;
6282   CheckSource('TestSet_ConstChar',
6283     LinesToStr([ // statements
6284     'this.LowChars = rtl.createSet(null, 97, 122);',
6285     'this.Chars = rtl.unionSet($mod.LowChars, rtl.createSet(null, 65, 90));',
6286     'this.sc = rtl.createSet(1040, 1071);',
6287     'this.c = "";',
6288     'this.s = "";',
6289     '']),
6290     LinesToStr([
6291     'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
6292     'if (97 in $mod.LowChars) ;',
6293     'if ($mod.s.charCodeAt(0) in $mod.LowChars) ;',
6294     'if ($mod.c.charCodeAt() in $mod.Chars) ;',
6295     'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
6296     'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
6297     'if (1071 in $mod.sc) ;',
6298     'if (3 === 32) ;',
6299     '']));
6300 end;
6301 
6302 procedure TTestModule.TestSet_ConstInt;
6303 begin
6304   StartProgram(false);
6305   Add([
6306   'const',
6307   '  Months = [1..12];',
6308   '  Mirror = [-12..-1]+Months;',
6309   'var',
6310   '  i: smallint;',
6311   'begin',
6312   '  if 3 in Months then;',
6313   '  if i in Months+[i] then;',
6314   '  if i in Months+Mirror then;',
6315   '  if i in [4..6,8] then;',
6316   '']);
6317   ConvertProgram;
6318   CheckSource('TestSet_ConstInt',
6319     LinesToStr([ // statements
6320     'this.Months = rtl.createSet(null, 1, 12);',
6321     'this.Mirror = rtl.unionSet(rtl.createSet(null, -12, -1), $mod.Months);',
6322     'this.i = 0;',
6323     '']),
6324     LinesToStr([
6325     'if (3 in $mod.Months) ;',
6326     'if ($mod.i in rtl.unionSet($mod.Months, rtl.createSet($mod.i))) ;',
6327     'if ($mod.i in rtl.unionSet($mod.Months, $mod.Mirror)) ;',
6328     'if ($mod.i in rtl.createSet(null, 4, 6, 8)) ;',
6329     '']));
6330 end;
6331 
6332 procedure TTestModule.TestSet_InFunction;
6333 begin
6334   StartProgram(false);
6335   Add([
6336   'const',
6337   '  TEnum = 3;',
6338   '  TSetOfEnum = 4;',
6339   '  TSetOfAno = 5;',
6340   'procedure DoIt;',
6341   'type',
6342   '  TEnum = (red, blue);',
6343   '  TSetOfEnum = set of TEnum;',
6344   '  TSetOfAno = set of (up,down);',
6345   'var',
6346   '  e: TEnum;',
6347   '  se: TSetOfEnum;',
6348   '  sa: TSetOfAno;',
6349   'begin',
6350   '  se:=[e];',
6351   '  sa:=[up];',
6352   'end;',
6353   'begin',
6354   '']);
6355   ConvertProgram;
6356   CheckSource('TestSet_InFunction',
6357     LinesToStr([ // statements
6358     'this.TEnum = 3;',
6359     'this.TSetOfEnum = 4;',
6360     'this.TSetOfAno = 5;',
6361     'var TEnum$1 = {',
6362     '  "0": "red",',
6363     '  red: 0,',
6364     '  "1": "blue",',
6365     '  blue: 1',
6366     '};',
6367     'var TSetOfAno$a = {',
6368     '  "0": "up",',
6369     '  up: 0,',
6370     '  "1": "down",',
6371     '  down: 1',
6372     '};',
6373     'this.DoIt = function () {',
6374     '  var e = 0;',
6375     '  var se = {};',
6376     '  var sa = {};',
6377     '  se = rtl.createSet(e);',
6378     '  sa = rtl.createSet(TSetOfAno$a.up);',
6379     '};',
6380     '']),
6381     LinesToStr([
6382     '']));
6383 end;
6384 
6385 procedure TTestModule.TestSet_ForIn;
6386 begin
6387   StartProgram(false);
6388   Add([
6389   'type',
6390   '  TEnum = (Red, Green, Blue);',
6391   '  TEnumRg = green..blue;',
6392   '  TSetOfEnum = set of TEnum;',
6393   '  TSetOfEnumRg = set of TEnumRg;',
6394   'var',
6395   '  e, e2: TEnum;',
6396   '  er: TEnum;',
6397   '  s: TSetOfEnum;',
6398   'begin',
6399   '  for e in TSetOfEnum do ;',
6400   '  for e in TSetOfEnumRg do ;',
6401   '  for e in [] do e2:=e;',
6402   '  for e in [red..green] do e2:=e;',
6403   '  for e in [green,blue] do e2:=e;',
6404   '  for e in [red,blue] do e2:=e;',
6405   '  for e in s do e2:=e;',
6406   '  for er in TSetOfEnumRg do ;',
6407   '']);
6408   ConvertProgram;
6409   CheckSource('TestSet_ForIn',
6410     LinesToStr([ // statements
6411     'this.TEnum = {',
6412     '  "0":"Red",',
6413     '  Red:0,',
6414     '  "1":"Green",',
6415     '  Green:1,',
6416     '  "2":"Blue",',
6417     '  Blue:2',
6418     '  };',
6419     'this.e = 0;',
6420     'this.e2 = 0;',
6421     'this.er = 0;',
6422     'this.s = {};',
6423     '']),
6424     LinesToStr([
6425     'for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;',
6426     'for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;',
6427     'for ($mod.e = 0; $mod.e <= 1; $mod.e++) $mod.e2 = $mod.e;',
6428     'for ($mod.e = 1; $mod.e <= 2; $mod.e++) $mod.e2 = $mod.e;',
6429     'for ($mod.e in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Blue)) $mod.e2 = $mod.e;',
6430     'for (var $l in $mod.s){',
6431     '  $mod.e = +$l;',
6432     '  $mod.e2 = $mod.e;',
6433     '};',
6434     'for ($mod.er = 1; $mod.er <= 2; $mod.er++) ;',
6435     '']));
6436 end;
6437 
6438 procedure TTestModule.TestNestBegin;
6439 begin
6440   StartProgram(false);
6441   Add('begin');
6442   Add('  begin');
6443   Add('    begin');
6444   Add('    end;');
6445   Add('    begin');
6446   Add('      if true then ;');
6447   Add('    end;');
6448   Add('  end;');
6449   ConvertProgram;
6450   CheckSource('TestNestBegin',
6451     '',
6452     'if (true) ;');
6453 end;
6454 
6455 procedure TTestModule.TestUnitImplVars;
6456 begin
6457   StartUnit(false);
6458   Add('interface');
6459   Add('implementation');
6460   Add('var');
6461   Add('  V1:longint;');
6462   Add('  V2:longint = 3;');
6463   Add('  V3:string = ''abc'';');
6464   ConvertUnit;
6465   CheckSource('TestUnitImplVars',
6466     LinesToStr([ // statements
6467     'var $impl = $mod.$impl;',
6468     '']),
6469     '', // this.$init
6470     LinesToStr([ // implementation
6471     '$impl.V1 = 0;',
6472     '$impl.V2 = 3;',
6473     '$impl.V3 = "abc";',
6474     '']) );
6475 end;
6476 
6477 procedure TTestModule.TestUnitImplConsts;
6478 begin
6479   StartUnit(false);
6480   Add('interface');
6481   Add('implementation');
6482   Add('const');
6483   Add('  v1 = 3;');
6484   Add('  v2:longint = 4;');
6485   Add('  v3:string = ''abc'';');
6486   ConvertUnit;
6487   CheckSource('TestUnitImplConsts',
6488     LinesToStr([ // statements
6489     'var $impl = $mod.$impl;',
6490     '']),
6491     '', // this.$init
6492     LinesToStr([ // implementation
6493     '$impl.v1 = 3;',
6494     '$impl.v2 = 4;',
6495     '$impl.v3 = "abc";',
6496     '']) );
6497 end;
6498 
6499 procedure TTestModule.TestUnitImplRecord;
6500 begin
6501   StartUnit(false);
6502   Add('interface');
6503   Add('implementation');
6504   Add('type');
6505   Add('  TMyRecord = record');
6506   Add('    i: longint;');
6507   Add('  end;');
6508   Add('var aRec: TMyRecord;');
6509   Add('initialization');
6510   Add('  arec.i:=3;');
6511   ConvertUnit;
6512   CheckSource('TestUnitImplRecord',
6513     LinesToStr([ // statements
6514     'var $impl = $mod.$impl;',
6515     '']),
6516     // this.$init
6517     '$impl.aRec.i = 3;',
6518     LinesToStr([ // implementation
6519     'rtl.recNewT($impl, "TMyRecord", function () {',
6520     '  this.i = 0;',
6521     '  this.$eq = function (b) {',
6522     '    return this.i === b.i;',
6523     '  };',
6524     '  this.$assign = function (s) {',
6525     '    this.i = s.i;',
6526     '    return this;',
6527     '  };',
6528     '});',
6529     '$impl.aRec = $impl.TMyRecord.$new();',
6530     '']) );
6531 end;
6532 
6533 procedure TTestModule.TestRenameJSNameConflict;
6534 begin
6535   StartProgram(false);
6536   Add('var apply: longint;');
6537   Add('var bind: longint;');
6538   Add('var call: longint;');
6539   Add('begin');
6540   ConvertProgram;
6541   CheckSource('TestRenameJSNameConflict',
6542     LinesToStr([ // statements
6543     'this.Apply = 0;',
6544     'this.Bind = 0;',
6545     'this.Call = 0;'
6546     ]),
6547     LinesToStr([ // this.$main
6548     ''
6549     ]));
6550 end;
6551 
6552 procedure TTestModule.TestLocalConst;
6553 begin
6554   StartProgram(false);
6555   Add('procedure DoIt;');
6556   Add('const');
6557   Add('  cA: longint = 1;');
6558   Add('  cB = 2;');
6559   Add('  procedure Sub;');
6560   Add('  const');
6561   Add('    csA = 3;');
6562   Add('    cB: double = 4;');
6563   Add('  begin');
6564   Add('    cb:=cb+csa;');
6565   Add('    ca:=ca+csa+5;');
6566   Add('  end;');
6567   Add('begin');
6568   Add('  ca:=ca+cb+6;');
6569   Add('end;');
6570   Add('begin');
6571   ConvertProgram;
6572   CheckSource('TestLocalConst',
6573     LinesToStr([
6574     'var cA = 1;',
6575     'var cB = 2;',
6576     'var csA = 3;',
6577     'var cB$1 = 4;',
6578     'this.DoIt = function () {',
6579     '  function Sub() {',
6580     '    cB$1 = cB$1 + 3;',
6581     '    cA = cA + 3 + 5;',
6582     '  };',
6583     '  cA = cA + 2 + 6;',
6584     '};'
6585     ]),
6586     LinesToStr([
6587     ]));
6588 end;
6589 
6590 procedure TTestModule.TestVarExternal;
6591 begin
6592   StartProgram(false);
6593   Add('var');
6594   Add('  NaN: double; external name ''Global.NaN'';');
6595   Add('  d: double;');
6596   Add('begin');
6597   Add('  d:=NaN;');
6598   ConvertProgram;
6599   CheckSource('TestVarExternal',
6600     LinesToStr([
6601     'this.d = 0.0;'
6602     ]),
6603     LinesToStr([
6604     '$mod.d = Global.NaN;'
6605     ]));
6606 end;
6607 
6608 procedure TTestModule.TestVarExternalOtherUnit;
6609 begin
6610   AddModuleWithIntfImplSrc('unit2.pas',
6611     LinesToStr([
6612     'var NaN: double; external name ''Global.NaN'';',
6613     'var iV: longint;'
6614     ]),
6615     '');
6616 
6617   StartUnit(true);
6618   Add('interface');
6619   Add('uses unit2;');
6620   Add('implementation');
6621   Add('var');
6622   Add('  d: double;');
6623   Add('  i: longint; external name ''$i'';');
6624   Add('begin');
6625   Add('  d:=nan;');
6626   Add('  d:=uNit2.nan;');
6627   Add('  d:=test1.d;');
6628   Add('  i:=iv;');
6629   Add('  i:=uNit2.iv;');
6630   Add('  i:=test1.i;');
6631   ConvertUnit;
6632   CheckSource('TestVarExternalOtherUnit',
6633     LinesToStr([
6634     'var $impl = $mod.$impl;',
6635     '']),
6636     LinesToStr([ // this.$init
6637     '$impl.d = Global.NaN;',
6638     '$impl.d = Global.NaN;',
6639     '$impl.d = $impl.d;',
6640     '$i = pas.unit2.iV;',
6641     '$i = pas.unit2.iV;',
6642     '$i = $i;',
6643     '']),
6644     LinesToStr([ // implementation
6645     '$impl.d = 0.0;',
6646     '']) );
6647 end;
6648 
6649 procedure TTestModule.TestVarAbsoluteFail;
6650 begin
6651   StartProgram(false);
6652   Add([
6653   'var',
6654   '  a: longint;',
6655   '  b: longword absolute a;',
6656   'begin']);
6657   SetExpectedPasResolverError('Invalid variable modifier "absolute"',nInvalidVariableModifier);
6658   ConvertProgram;
6659 end;
6660 
6661 procedure TTestModule.TestConstExternal;
6662 begin
6663   StartProgram(false);
6664   Add([
6665   'const',
6666   '  PI: double; external name ''Global.PI'';',
6667   '  Tau = 2*pi;',
6668   'var d: double;',
6669   'begin',
6670   '  d:=pi;',
6671   '  d:=tau+pi;']);
6672   ConvertProgram;
6673   CheckSource('TestConstExternal',
6674     LinesToStr([
6675     'this.Tau = 2*Global.PI;',
6676     'this.d = 0.0;'
6677     ]),
6678     LinesToStr([
6679     '$mod.d = Global.PI;',
6680     '$mod.d = $mod.Tau + Global.PI;'
6681     ]));
6682 end;
6683 
6684 procedure TTestModule.TestDouble;
6685 begin
6686   StartProgram(false);
6687   Add([
6688   'type',
6689   '  TDateTime = double;',
6690   'const',
6691   '  a = TDateTime(2.7);',
6692   '  b = a + TDateTime(1.7);',
6693   '  c = 0.9 + 0.1;',
6694   '  f0_1 = 0.1;',
6695   '  f0_3 = 0.3;',
6696   '  fn0_1 = -0.1;',
6697   '  fn0_3 = -0.3;',
6698   '  fn0_003 = -0.003;',
6699   '  fn0_123456789 = -0.123456789;',
6700   '  fn300_0 = -300.0;',
6701   '  fn123456_0 = -123456.0;',
6702   '  fn1234567_8 = -1234567.8;',
6703   '  fn12345678_9 = -12345678.9;',
6704   '  f1_0En12 = 1E-12;',
6705   '  fn1_0En12 = -1E-12;',
6706   '  maxdouble = 1.7e+308;',
6707   '  mindouble = -1.7e+308;',
6708   '  MinSafeIntDouble  = -$1fffffffffffff;',
6709   '  MinSafeIntDouble2 = -$20000000000000-1;',
6710   '  MaxSafeIntDouble =   $1fffffffffffff;',
6711   '  DZeroResolution = 1E-12;',
6712   '  Minus1 = -1E-12;',
6713   '  EPS = 1E-9;',
6714   '  DELTA = 0.001;',
6715   '  Big = 129.789E+100;',
6716   '  Test0_15 = 0.15;',
6717   '  Test999 = 2.9999999999999;',
6718   '  Test111999 = 211199999999999000.0;',
6719   '  TestMinus111999 = -211199999999999000.0;',
6720   'var',
6721   '  d: double = b;',
6722   'begin',
6723   '  d:=1.0;',
6724   '  d:=1.0/3.0;',
6725   '  d:=1/3;',
6726   '  d:=5.0E-324;',
6727   '  d:=1.7E308;',
6728   '  d:=001.00E00;',
6729   '  d:=002.00E001;',
6730   '  d:=003.000E000;',
6731   '  d:=-004.00E-00;',
6732   '  d:=-005.00E-001;',
6733   '  d:=10**3;',
6734   '  d:=10 mod 3;',
6735   '  d:=10 div 3;',
6736   '  d:=c;',
6737   '  d:=f0_1;',
6738   '  d:=f0_3;',
6739   '  d:=fn0_1;',
6740   '  d:=fn0_3;',
6741   '  d:=fn0_003;',
6742   '  d:=fn0_123456789;',
6743   '  d:=fn300_0;',
6744   '  d:=fn123456_0;',
6745   '  d:=fn1234567_8;',
6746   '  d:=fn12345678_9;',
6747   '  d:=f1_0En12;',
6748   '  d:=fn1_0En12;',
6749   '  d:=maxdouble;',
6750   '  d:=mindouble;',
6751   '  d:=MinSafeIntDouble;',
6752   '  d:=double(MinSafeIntDouble);',
6753   '  d:=MinSafeIntDouble2;',
6754   '  d:=double(MinSafeIntDouble2);',
6755   '  d:=MaxSafeIntDouble;',
6756   '  d:=default(double);',
6757   '']);
6758   ConvertProgram;
6759   CheckSource('TestDouble',
6760     LinesToStr([
6761     'this.a = 2.7;',
6762     'this.b = 2.7 + 1.7;',
6763     'this.c = 0.9 + 0.1;',
6764     'this.f0_1 = 0.1;',
6765     'this.f0_3 = 0.3;',
6766     'this.fn0_1 = -0.1;',
6767     'this.fn0_3 = -0.3;',
6768     'this.fn0_003 = -0.003;',
6769     'this.fn0_123456789 = -0.123456789;',
6770     'this.fn300_0 = -300.0;',
6771     'this.fn123456_0 = -123456.0;',
6772     'this.fn1234567_8 = -1234567.8;',
6773     'this.fn12345678_9 = -12345678.9;',
6774     'this.f1_0En12 = 1E-12;',
6775     'this.fn1_0En12 = -1E-12;',
6776     'this.maxdouble = 1.7e+308;',
6777     'this.mindouble = -1.7e+308;',
6778     'this.MinSafeIntDouble = -0x1fffffffffffff;',
6779     'this.MinSafeIntDouble2 = -0x20000000000000 - 1;',
6780     'this.MaxSafeIntDouble = 0x1fffffffffffff;',
6781     'this.DZeroResolution = 1E-12;',
6782     'this.Minus1 = -1E-12;',
6783     'this.EPS = 1E-9;',
6784     'this.DELTA = 0.001;',
6785     'this.Big = 129.789E+100;',
6786     'this.Test0_15 = 0.15;',
6787     'this.Test999 = 2.9999999999999;',
6788     'this.Test111999 = 211199999999999000.0;',
6789     'this.TestMinus111999 = -211199999999999000.0;',
6790     'this.d = 4.4;'
6791     ]),
6792     LinesToStr([
6793     '$mod.d = 1.0;',
6794     '$mod.d = 1.0 / 3.0;',
6795     '$mod.d = 1 / 3;',
6796     '$mod.d = 5.0E-324;',
6797     '$mod.d = 1.7E308;',
6798     '$mod.d = 1.00E0;',
6799     '$mod.d = 2.00E1;',
6800     '$mod.d = 3.000E0;',
6801     '$mod.d = -4.00E-0;',
6802     '$mod.d = -5.00E-1;',
6803     '$mod.d = Math.pow(10, 3);',
6804     '$mod.d = 10 % 3;',
6805     '$mod.d = Math.floor(10 / 3);',
6806     '$mod.d = 1;',
6807     '$mod.d = 0.1;',
6808     '$mod.d = 0.3;',
6809     '$mod.d = -0.1;',
6810     '$mod.d = -0.3;',
6811     '$mod.d = -0.003;',
6812     '$mod.d = -0.123456789;',
6813     '$mod.d = -300;',
6814     '$mod.d = -123456;',
6815     '$mod.d = -1234567.8;',
6816     '$mod.d = -1.23456789E7;',
6817     '$mod.d = 1E-12;',
6818     '$mod.d = -1E-12;',
6819     '$mod.d = 1.7E308;',
6820     '$mod.d = -1.7E308;',
6821     '$mod.d = -9007199254740991;',
6822     '$mod.d = -9007199254740991;',
6823     '$mod.d = -9.007199254740992E15;',
6824     '$mod.d = -9.007199254740992E15;',
6825     '$mod.d = 9007199254740991;',
6826     '$mod.d = 0.0;',
6827     '']));
6828 end;
6829 
6830 procedure TTestModule.TestInteger;
6831 begin
6832   StartProgram(false);
6833   Add([
6834   'const',
6835   '  MinInt = low(NativeInt);',
6836   '  MaxInt = high(NativeInt);',
6837   'type',
6838   '  {#TMyInt}TMyInt = MinInt..MaxInt;',
6839   'const',
6840   '  a = low(TMyInt)+High(TMyInt);',
6841   'var',
6842   '  i: TMyInt;',
6843   'begin',
6844   '  i:=-MinInt;',
6845   '  i:=default(TMyInt);',
6846   '  i:=low(i)+high(i);',
6847   '']);
6848   ConvertProgram;
6849   CheckSource('TestIntegerRange',
6850     LinesToStr([
6851     'this.MinInt = -9007199254740991;',
6852     'this.MaxInt = 9007199254740991;',
6853     'this.a = -9007199254740991 + 9007199254740991;',
6854     'this.i = 0;',
6855     '']),
6856     LinesToStr([
6857     '$mod.i = - -9007199254740991;',
6858     '$mod.i = -9007199254740991;',
6859     '$mod.i = -9007199254740991 + 9007199254740991;',
6860     '']));
6861 end;
6862 
6863 procedure TTestModule.TestIntegerRange;
6864 begin
6865   StartProgram(false);
6866   Add([
6867   'const',
6868   '  MinInt = -1;',
6869   '  MaxInt = +1;',
6870   'type',
6871   '  {#TMyInt}TMyInt = MinInt..MaxInt;',
6872   '  TInt2 = 1..3;',
6873   'const',
6874   '  a = low(TMyInt)+High(TMyInt);',
6875   '  b = low(TInt2)+High(TInt2);',
6876   '  s1 = [1];',
6877   '  s2 = [1,2];',
6878   '  s3 = [1..3];',
6879   '  s4 = [low(shortint)..high(shortint)];',
6880   '  s5 = [succ(low(shortint))..pred(high(shortint))];',
6881   '  s6 = 1 in s2;',
6882   'var',
6883   '  i: TMyInt;',
6884   '  i2: TInt2;',
6885   'begin',
6886   '  i:=i2;',
6887   '  i:=default(TMyInt);',
6888   '  if i=i2 then ;']);
6889   ConvertProgram;
6890   CheckSource('TestIntegerRange',
6891     LinesToStr([
6892     'this.MinInt = -1;',
6893     'this.MaxInt = +1;',
6894     'this.a = -1 + 1;',
6895     'this.b = 1 + 3;',
6896     'this.s1 = rtl.createSet(1);',
6897     'this.s2 = rtl.createSet(1, 2);',
6898     'this.s3 = rtl.createSet(null, 1, 3);',
6899     'this.s4 = rtl.createSet(null, -128, 127);',
6900     'this.s5 = rtl.createSet(null, -128 + 1, 127 - 1);',
6901     'this.s6 = 1 in $mod.s2;',
6902     'this.i = 0;',
6903     'this.i2 = 0;',
6904     '']),
6905     LinesToStr([
6906     '$mod.i = $mod.i2;',
6907     '$mod.i = -1;',
6908     'if ($mod.i === $mod.i2) ;',
6909     '']));
6910 end;
6911 
6912 procedure TTestModule.TestIntegerTypecasts;
6913 begin
6914   StartProgram(false);
6915   Add([
6916   'var',
6917   '  i: nativeint;',
6918   '  b: byte;',
6919   '  sh: shortint;',
6920   '  w: word;',
6921   '  sm: smallint;',
6922   '  lw: longword;',
6923   '  li: longint;',
6924   'begin',
6925   '  b:=byte(i);',
6926   '  sh:=shortint(i);',
6927   '  w:=word(i);',
6928   '  sm:=smallint(i);',
6929   '  lw:=longword(i);',
6930   '  li:=longint(i);',
6931   '']);
6932   ConvertProgram;
6933   CheckSource('TestIntegerTypecasts',
6934     LinesToStr([
6935     'this.i = 0;',
6936     'this.b = 0;',
6937     'this.sh = 0;',
6938     'this.w = 0;',
6939     'this.sm = 0;',
6940     'this.lw = 0;',
6941     'this.li = 0;',
6942     '']),
6943     LinesToStr([
6944     '$mod.b = $mod.i & 255;',
6945     '$mod.sh = (($mod.i & 255) << 24) >> 24;',
6946     '$mod.w = $mod.i & 65535;',
6947     '$mod.sm = (($mod.i & 65535) << 16) >> 16;',
6948     '$mod.lw = $mod.i >>> 0;',
6949     '$mod.li = $mod.i & 0xFFFFFFFF;',
6950     '']));
6951 end;
6952 
6953 procedure TTestModule.TestInteger_BitwiseShrNativeInt;
6954 begin
6955   StartProgram(false);
6956   Add([
6957   'var',
6958   '  i,j: nativeint;',
6959   'begin',
6960   '  i:=i shr 0;',
6961   '  i:=i shr 1;',
6962   '  i:=i shr 3;',
6963   '  i:=i shr 54;',
6964   '  i:=j shr i;',
6965   '']);
6966   ConvertProgram;
6967   CheckResolverUnexpectedHints;
6968   CheckSource('TestInteger_BitwiseShrNativeInt',
6969     LinesToStr([
6970     'this.i = 0;',
6971     'this.j = 0;',
6972     '']),
6973     LinesToStr([
6974     '$mod.i = $mod.i;',
6975     '$mod.i = Math.floor($mod.i / 2);',
6976     '$mod.i = Math.floor($mod.i / 8);',
6977     '$mod.i = 0;',
6978     '$mod.i = rtl.shr($mod.j, $mod.i);',
6979     '']));
6980 end;
6981 
6982 procedure TTestModule.TestInteger_BitwiseShlNativeInt;
6983 begin
6984   StartProgram(false);
6985   Add([
6986   'var',
6987   '  i: nativeint;',
6988   'begin',
6989   '  i:=i shl 0;',
6990   '  i:=i shl 54;',
6991   '  i:=123456789012 shl 1;',
6992   '  i:=i shl 1;',
6993   '']);
6994   ConvertProgram;
6995   CheckResolverUnexpectedHints;
6996   CheckSource('TestInteger_BitwiseShrNativeInt',
6997     LinesToStr([
6998     'this.i = 0;',
6999     '']),
7000     LinesToStr([
7001     '$mod.i = $mod.i;',
7002     '$mod.i = 0;',
7003     '$mod.i = 246913578024;',
7004     '$mod.i = rtl.shl($mod.i, 1);',
7005     '']));
7006 end;
7007 
7008 procedure TTestModule.TestInteger_SystemFunc;
7009 begin
7010   StartProgram(true);
7011   Add([
7012   'var',
7013   '  i: byte;',
7014   '  s: string;',
7015   'begin',
7016   '  system.inc(i);',
7017   '  system.str(i,s);',
7018   '  s:=system.str(i);',
7019   '  i:=system.low(i);',
7020   '  i:=system.high(i);',
7021   '  i:=system.pred(i);',
7022   '  i:=system.succ(i);',
7023   '']);
7024   ConvertProgram;
7025   CheckResolverUnexpectedHints;
7026   CheckSource('TestInteger_SystemFunc',
7027     LinesToStr([
7028     'this.i = 0;',
7029     'this.s = "";',
7030     '']),
7031     LinesToStr([
7032     '$mod.i += 1;',
7033     '$mod.s = "" + $mod.i;',
7034     '$mod.s = "" + $mod.i;',
7035     '$mod.i = 0;',
7036     '$mod.i = 255;',
7037     '$mod.i = $mod.i - 1;',
7038     '$mod.i = $mod.i + 1;',
7039     '']));
7040 end;
7041 
7042 procedure TTestModule.TestCurrency;
7043 begin
7044   StartProgram(false);
7045   Add([
7046   'type',
7047   '  TCoin = currency;',
7048   'const',
7049   '  a = TCoin(2.7);',
7050   '  b = a + TCoin(1.7);',
7051   '  MinSafeIntCurrency: TCoin = -92233720368.5477;',
7052   '  MaxSafeIntCurrency: TCoin =  92233720368.5477;',
7053   'var',
7054   '  c: TCoin = b;',
7055   '  i: nativeint;',
7056   '  d: double;',
7057   '  j: jsvalue;',
7058   'function DoIt(c: currency): currency; begin end;',
7059   'function GetIt(d: double): double; begin end;',
7060   'procedure Write(v: jsvalue); begin end;',
7061   'begin',
7062   '  c:=1.0;',
7063   '  c:=0.1;',
7064   '  c:=1.0/3.0;',
7065   '  c:=1/3;',
7066   '  c:=a;',
7067   '  d:=c;',
7068   '  c:=d;',
7069   '  c:=currency(c);',
7070   '  c:=currency(d);',
7071   '  d:=double(c);',
7072   '  c:=i;',
7073   '  c:=currency(i);',
7074   //'  i:=c;', not allowed
7075   '  i:=nativeint(c);',
7076   '  c:=c+a;',
7077   '  c:=-c-a;',
7078   '  c:=d+c;',
7079   '  c:=c+d;',
7080   '  c:=d-c;',
7081   '  c:=c-d;',
7082   '  c:=c*a;',
7083   '  c:=a*c;',
7084   '  c:=d*c;',
7085   '  c:=c*d;',
7086   '  c:=c/a;',
7087   '  c:=a/c;',
7088   '  c:=d/c;',
7089   '  c:=c/d;',
7090   '  c:=c**a;',
7091   '  c:=a**c;',
7092   '  c:=d**c;',
7093   '  c:=c**d;',
7094   '  if c=c then ;',
7095   '  if c=a then ;',
7096   '  if a=c then ;',
7097   '  if d=c then ;',
7098   '  if c=d then ;',
7099   '  c:=DoIt(c);',
7100   '  c:=DoIt(i);',
7101   '  c:=DoIt(d);',
7102   '  c:=GetIt(c);',
7103   '  j:=c;',
7104   '  Write(c);',
7105   '  c:=default(currency);',
7106   '  j:=str(c);',
7107   '  j:=str(c:0:3);',
7108   '']);
7109   ConvertProgram;
7110   CheckSource('TestCurrency',
7111     LinesToStr([
7112     'this.a = 27000;',
7113     'this.b = $mod.a + 17000;',
7114     'this.MinSafeIntCurrency = -92233720368.5477;',
7115     'this.MaxSafeIntCurrency = 92233720368.5477;',
7116     'this.c = $mod.b;',
7117     'this.i = 0;',
7118     'this.d = 0.0;',
7119     'this.j = undefined;',
7120     'this.DoIt = function (c) {',
7121     '  var Result = 0;',
7122     '  return Result;',
7123     '};',
7124     'this.GetIt = function (d) {',
7125     '  var Result = 0.0;',
7126     '  return Result;',
7127     '};',
7128     'this.Write = function (v) {',
7129     '};',
7130     '']),
7131     LinesToStr([
7132     '$mod.c = 10000;',
7133     '$mod.c = 1000;',
7134     '$mod.c = Math.floor((1.0 / 3.0) * 10000);',
7135     '$mod.c = Math.floor((1 / 3) * 10000);',
7136     '$mod.c = $mod.a;',
7137     '$mod.d = $mod.c / 10000;',
7138     '$mod.c = Math.floor($mod.d * 10000);',
7139     '$mod.c = $mod.c;',
7140     '$mod.c = $mod.d * 10000;',
7141     '$mod.d = $mod.c / 10000;',
7142     '$mod.c = $mod.i * 10000;',
7143     '$mod.c = $mod.i * 10000;',
7144     '$mod.i = Math.floor($mod.c / 10000);',
7145     '$mod.c = $mod.c + $mod.a;',
7146     '$mod.c = -$mod.c - $mod.a;',
7147     '$mod.c = ($mod.d * 10000) + $mod.c;',
7148     '$mod.c = $mod.c + ($mod.d * 10000);',
7149     '$mod.c = ($mod.d * 10000) - $mod.c;',
7150     '$mod.c = $mod.c - ($mod.d * 10000);',
7151     '$mod.c = ($mod.c * $mod.a) / 10000;',
7152     '$mod.c = ($mod.a * $mod.c) / 10000;',
7153     '$mod.c = $mod.d * $mod.c;',
7154     '$mod.c = $mod.c * $mod.d;',
7155     '$mod.c = Math.floor(($mod.c / $mod.a) * 10000);',
7156     '$mod.c = Math.floor(($mod.a / $mod.c) * 10000);',
7157     '$mod.c = Math.floor($mod.d / $mod.c);',
7158     '$mod.c = Math.floor($mod.c / $mod.d);',
7159     '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.a / 10000) * 10000);',
7160     '$mod.c = Math.floor(Math.pow($mod.a / 10000, $mod.c / 10000) * 10000);',
7161     '$mod.c = Math.floor(Math.pow($mod.d, $mod.c / 10000) * 10000);',
7162     '$mod.c = Math.floor(Math.pow($mod.c / 10000, $mod.d) * 10000);',
7163     'if ($mod.c === $mod.c) ;',
7164     'if ($mod.c === $mod.a) ;',
7165     'if ($mod.a === $mod.c) ;',
7166     'if (($mod.d * 10000) === $mod.c) ;',
7167     'if ($mod.c === ($mod.d * 10000)) ;',
7168     '$mod.c = $mod.DoIt($mod.c);',
7169     '$mod.c = $mod.DoIt($mod.i * 10000);',
7170     '$mod.c = $mod.DoIt($mod.d * 10000);',
7171     '$mod.c = Math.floor($mod.GetIt($mod.c / 10000) * 10000);',
7172     '$mod.j = $mod.c / 10000;',
7173     '$mod.Write($mod.c / 10000);',
7174     '$mod.c = 0;',
7175     '$mod.j = rtl.floatToStr($mod.c / 10000);',
7176     '$mod.j = rtl.floatToStr($mod.c / 10000, 0, 3);',
7177     '']));
7178 end;
7179 
7180 procedure TTestModule.TestForBoolDo;
7181 begin
7182   StartProgram(false);
7183   Add([
7184   'var b: boolean;',
7185   'begin',
7186   '  for b:=false to true do ;',
7187   '  for b:=b downto false do ;',
7188   '  for b in boolean do ;',
7189   '']);
7190   ConvertProgram;
7191   CheckSource('TestForBoolDo',
7192     LinesToStr([ // statements
7193     'this.b = false;']),
7194     LinesToStr([ // this.$main
7195     'for (var $l = 0; $l <= 1; $l++) $mod.b = $l !== 0;',
7196     'for (var $l1 = +$mod.b; $l1 >= 0; $l1--) $mod.b = $l1 !== 0;',
7197     'for (var $l2 = 0; $l2 <= 1; $l2++) $mod.b = $l2 !== 0;',
7198     '']));
7199 end;
7200 
7201 procedure TTestModule.TestForIntDo;
7202 begin
7203   StartProgram(false);
7204   Add([
7205   'var i: longint;',
7206   'begin',
7207   '  for i:=3 to 5 do ;',
7208   '  for i:=i downto 2 do ;',
7209   '  for i in byte do ;',
7210   '']);
7211   ConvertProgram;
7212   CheckSource('TestForIntDo',
7213     LinesToStr([ // statements
7214     'this.i = 0;']),
7215     LinesToStr([ // this.$main
7216     'for ($mod.i = 3; $mod.i <= 5; $mod.i++) ;',
7217     'for (var $l = $mod.i; $l >= 2; $l--) $mod.i = $l;',
7218     'for (var $l1 = 0; $l1 <= 255; $l1++) $mod.i = $l1;',
7219     '']));
7220 end;
7221 
7222 procedure TTestModule.TestForIntInDo;
7223 begin
7224   StartProgram(false);
7225   Add([
7226   'type',
7227   '  TSetOfInt = set of byte;',
7228   '  TIntRg = 3..7;',
7229   '  TSetOfIntRg = set of TIntRg;',
7230   'var',
7231   '  i,i2: longint;',
7232   '  a1: array of byte;',
7233   '  a2: array[1..3] of byte;',
7234   '  soi: TSetOfInt;',
7235   '  soir: TSetOfIntRg;',
7236   '  ir: TIntRg;',
7237   'begin',
7238   '  for i in byte do ;',
7239   '  for i in a1 do ;',
7240   '  for i in a2 do ;',
7241   '  for i in [11..13] do ;',
7242   '  for i in TSetOfInt do ;',
7243   '  for i in TIntRg do ;',
7244   '  for i in soi do i2:=i;',
7245   '  for i in TSetOfIntRg do ;',
7246   '  for i in soir do ;',
7247   '  for ir in TIntRg do ;',
7248   '  for ir in TSetOfIntRg do ;',
7249   '  for ir in soir do ;',
7250   '']);
7251   ConvertProgram;
7252   CheckSource('TestForIntInDo',
7253     LinesToStr([ // statements
7254     'this.i = 0;',
7255     'this.i2 = 0;',
7256     'this.a1 = [];',
7257     'this.a2 = rtl.arraySetLength(null, 0, 3);',
7258     'this.soi = {};',
7259     'this.soir = {};',
7260     'this.ir = 0;',
7261     '']),
7262     LinesToStr([ // this.$main
7263     'for (var $l = 0; $l <= 255; $l++) $mod.i = $l;',
7264     'for (var $in = $mod.a1, $l1 = 0, $end = rtl.length($in) - 1; $l1 <= $end; $l1++) $mod.i = $in[$l1];',
7265     'for (var $in1 = $mod.a2, $l2 = 0, $end1 = rtl.length($in1) - 1; $l2 <= $end1; $l2++) $mod.i = $in1[$l2];',
7266     'for (var $l3 = 11; $l3 <= 13; $l3++) $mod.i = $l3;',
7267     'for (var $l4 = 0; $l4 <= 255; $l4++) $mod.i = $l4;',
7268     'for (var $l5 = 3; $l5 <= 7; $l5++) $mod.i = $l5;',
7269     'for (var $l6 in $mod.soi) {',
7270     '  $mod.i = +$l6;',
7271     '  $mod.i2 = $mod.i;',
7272     '};',
7273     'for (var $l7 = 3; $l7 <= 7; $l7++) $mod.i = $l7;',
7274     'for (var $l8 in $mod.soir) $mod.i = +$l8;',
7275     'for (var $l9 = 3; $l9 <= 7; $l9++) $mod.ir = $l9;',
7276     'for (var $l10 = 3; $l10 <= 7; $l10++) $mod.ir = $l10;',
7277     'for (var $l11 in $mod.soir) $mod.ir = +$l11;',
7278     '']));
7279 end;
7280 
7281 procedure TTestModule.TestCharConst;
7282 begin
7283   StartProgram(false);
7284   Add([
7285   'const',
7286   '  a = #$00F3;',
7287   '  c: char = ''1'';',
7288   'begin',
7289   '  c:=#0;',
7290   '  c:=#1;',
7291   '  c:=#9;',
7292   '  c:=#10;',
7293   '  c:=#13;',
7294   '  c:=#31;',
7295   '  c:=#32;',
7296   '  c:=#$A;',
7297   '  c:=#$0A;',
7298   '  c:=#$b;',
7299   '  c:=#$0b;',
7300   '  c:=^A;',
7301   '  c:=''"'';',
7302   '  c:=default(char);',
7303   '  c:=#$00E4;', // ä
7304   '  c:=''ä'';',
7305   '  c:=#$E4;', // ä
7306   '  c:=#$D800;', // invalid UTF-16
7307   '  c:=#$DFFF;', // invalid UTF-16
7308   '  c:=#$FFFF;', // last UCS-2
7309   '  c:=high(c);', // last UCS-2
7310   '']);
7311   ConvertProgram;
7312   CheckSource('TestCharConst',
7313     LinesToStr([
7314     'this.a="ó";',
7315     'this.c="1";'
7316     ]),
7317     LinesToStr([
7318     '$mod.c="\x00";',
7319     '$mod.c="\x01";',
7320     '$mod.c="\t";',
7321     '$mod.c="\n";',
7322     '$mod.c="\r";',
7323     '$mod.c="\x1F";',
7324     '$mod.c=" ";',
7325     '$mod.c="\n";',
7326     '$mod.c="\n";',
7327     '$mod.c="\x0B";',
7328     '$mod.c="\x0B";',
7329     '$mod.c="\x01";',
7330     '$mod.c=''"'';',
7331     '$mod.c="\x00";',
7332     '$mod.c = "ä";',
7333     '$mod.c = "ä";',
7334     '$mod.c = "ä";',
7335     '$mod.c="\uD800";',
7336     '$mod.c="\uDFFF";',
7337     '$mod.c="\uFFFF";',
7338     '$mod.c="\uFFFF";',
7339     '']));
7340 end;
7341 
7342 procedure TTestModule.TestChar_Compare;
7343 begin
7344   StartProgram(false);
7345   Add('var');
7346   Add('  c: char;');
7347   Add('  b: boolean;');
7348   Add('begin');
7349   Add('  b:=c=''1'';');
7350   Add('  b:=''2''=c;');
7351   Add('  b:=''3''=''4'';');
7352   Add('  b:=c<>''5'';');
7353   Add('  b:=''6''<>c;');
7354   Add('  b:=c>''7'';');
7355   Add('  b:=''8''>c;');
7356   Add('  b:=c>=''9'';');
7357   Add('  b:=''A''>=c;');
7358   Add('  b:=c<''B'';');
7359   Add('  b:=''C''<c;');
7360   Add('  b:=c<=''D'';');
7361   Add('  b:=''E''<=c;');
7362   ConvertProgram;
7363   CheckSource('TestChar_Compare',
7364     LinesToStr([
7365     'this.c="";',
7366     'this.b = false;'
7367     ]),
7368     LinesToStr([
7369     '$mod.b = $mod.c === "1";',
7370     '$mod.b = "2" === $mod.c;',
7371     '$mod.b = "3" === "4";',
7372     '$mod.b = $mod.c !== "5";',
7373     '$mod.b = "6" !== $mod.c;',
7374     '$mod.b = $mod.c > "7";',
7375     '$mod.b = "8" > $mod.c;',
7376     '$mod.b = $mod.c >= "9";',
7377     '$mod.b = "A" >= $mod.c;',
7378     '$mod.b = $mod.c < "B";',
7379     '$mod.b = "C" < $mod.c;',
7380     '$mod.b = $mod.c <= "D";',
7381     '$mod.b = "E" <= $mod.c;',
7382     '']));
7383 end;
7384 
7385 procedure TTestModule.TestChar_BuiltInProcs;
7386 begin
7387   StartProgram(false);
7388   Add([
7389   'var',
7390   '  c: char;',
7391   '  i: longint;',
7392   '  s: string;',
7393   'begin',
7394   '  i:=ord(c);',
7395   '  i:=ord(s[i]);',
7396   '  c:=chr(i);',
7397   '  c:=pred(c);',
7398   '  c:=succ(c);',
7399   '  c:=low(c);',
7400   '  c:=high(c);',
7401   '  i:=byte(c);',
7402   '  i:=word(c);',
7403   '  i:=longint(c);',
7404   '']);
7405   ConvertProgram;
7406   CheckSource('TestChar_BuiltInProcs',
7407     LinesToStr([
7408     'this.c = "";',
7409     'this.i = 0;',
7410     'this.s = "";'
7411     ]),
7412     LinesToStr([
7413     '$mod.i = $mod.c.charCodeAt();',
7414     '$mod.i = $mod.s.charCodeAt($mod.i-1);',
7415     '$mod.c = String.fromCharCode($mod.i);',
7416     '$mod.c = String.fromCharCode($mod.c.charCodeAt() - 1);',
7417     '$mod.c = String.fromCharCode($mod.c.charCodeAt() + 1);',
7418     '$mod.c = "\x00";',
7419     '$mod.c = "\uFFFF";',
7420     '$mod.i = $mod.c.charCodeAt() & 255;',
7421     '$mod.i = $mod.c.charCodeAt();',
7422     '$mod.i = $mod.c.charCodeAt() & 0xFFFFFFFF;',
7423     '']));
7424 end;
7425 
7426 procedure TTestModule.TestStringConst;
7427 begin
7428   StartProgram(false);
7429   Add([
7430   '{$H+}',
7431   'const',
7432   '  a = #$00F3#$017C;', // first <256, then >=256
7433   '  b = string(''a'');',
7434   '  c = string(''ä'');',
7435   '  d = UnicodeString(''b'');',
7436   '  e = UnicodeString(''ö'');',
7437   'var',
7438   '  s: string = ''abc'';',
7439   'begin',
7440   '  s:='''';',
7441   '  s:=#13#10;',
7442   '  s:=#9''foo'';',
7443   '  s:=#$A9;',
7444   '  s:=''foo''#13''bar'';',
7445   '  s:=''"'';',
7446   '  s:=''"''''"'';',
7447   '  s:=#$20AC;', // euro
7448   '  s:=#$10437;', // outside BMP
7449   '  s:=default(string);',
7450   '  s:=concat(s);',
7451   '  s:=concat(s,''a'',s)',
7452   '']);
7453   ConvertProgram;
7454   CheckSource('TestStringConst',
7455     LinesToStr([
7456     'this.a = "óż";',
7457     'this.b = "a";',
7458     'this.c = "ä";',
7459     'this.d = "b";',
7460     'this.e = "ö";',
7461     'this.s="abc";',
7462     '']),
7463     LinesToStr([
7464     '$mod.s="";',
7465     '$mod.s="\r\n";',
7466     '$mod.s="\tfoo";',
7467     '$mod.s="©";',
7468     '$mod.s="foo\rbar";',
7469     '$mod.s=''"'';',
7470     '$mod.s=''"\''"'';',
7471     '$mod.s="€";',
7472     '$mod.s="'#$F0#$90#$90#$B7'";',
7473     '$mod.s="";',
7474     '$mod.s = $mod.s;',
7475     '$mod.s = $mod.s.concat("a", $mod.s);',
7476     '']));
7477 end;
7478 
7479 procedure TTestModule.TestStringConstSurrogate;
7480 begin
7481   StartProgram(false);
7482   Add([
7483   'var',
7484   '  s: string;',
7485   'begin',
7486   '  s:=''��'';', // 1F60A
7487   '']);
7488   ConvertProgram;
7489   CheckSource('TestStringConstSurrogate',
7490     LinesToStr([
7491     'this.s="";'
7492     ]),
7493     LinesToStr([
7494     '$mod.s="��";'
7495     ]));
7496 end;
7497 
7498 procedure TTestModule.TestString_Length;
7499 begin
7500   StartProgram(false);
7501   Add('const c = ''foo'';');
7502   Add('var');
7503   Add('  s: string;');
7504   Add('  i: longint;');
7505   Add('begin');
7506   Add('  i:=length(s);');
7507   Add('  i:=length(s+s);');
7508   Add('  i:=length(''abc'');');
7509   Add('  i:=length(c);');
7510   ConvertProgram;
7511   CheckSource('TestString_Length',
7512     LinesToStr([
7513     'this.c = "foo";',
7514     'this.s = "";',
7515     'this.i = 0;',
7516     '']),
7517     LinesToStr([
7518     '$mod.i = $mod.s.length;',
7519     '$mod.i = ($mod.s+$mod.s).length;',
7520     '$mod.i = "abc".length;',
7521     '$mod.i = $mod.c.length;',
7522     '']));
7523 end;
7524 
7525 procedure TTestModule.TestString_Compare;
7526 begin
7527   StartProgram(false);
7528   Add('var');
7529   Add('  s, t: string;');
7530   Add('  b: boolean;');
7531   Add('begin');
7532   Add('  b:=s=t;');
7533   Add('  b:=s<>t;');
7534   Add('  b:=s>t;');
7535   Add('  b:=s>=t;');
7536   Add('  b:=s<t;');
7537   Add('  b:=s<=t;');
7538   ConvertProgram;
7539   CheckSource('TestString_Compare',
7540     LinesToStr([ // statements
7541     'this.s = "";',
7542     'this.t = "";',
7543     'this.b =false;'
7544     ]),
7545     LinesToStr([ // this.$main
7546     '$mod.b = $mod.s === $mod.t;',
7547     '$mod.b = $mod.s !== $mod.t;',
7548     '$mod.b = $mod.s > $mod.t;',
7549     '$mod.b = $mod.s >= $mod.t;',
7550     '$mod.b = $mod.s < $mod.t;',
7551     '$mod.b = $mod.s <= $mod.t;',
7552     '']));
7553 end;
7554 
7555 procedure TTestModule.TestString_SetLength;
7556 begin
7557   StartProgram(false);
7558   Add([
7559   'procedure DoIt(var s: string);',
7560   'begin',
7561   '  SetLength(s,2);',
7562   'end;',
7563   'var s: string;',
7564   'begin',
7565   '  SetLength(s,3);',
7566   '']);
7567   ConvertProgram;
7568   CheckSource('TestString_SetLength',
7569     LinesToStr([ // statements
7570     'this.DoIt = function (s) {',
7571     '  s.set(rtl.strSetLength(s.get(), 2));',
7572     '};',
7573     'this.s = "";',
7574     '']),
7575     LinesToStr([ // this.$main
7576     '$mod.s = rtl.strSetLength($mod.s, 3);'
7577     ]));
7578 end;
7579 
7580 procedure TTestModule.TestString_CharAt;
7581 begin
7582   StartProgram(false);
7583   Add([
7584   'var',
7585   '  s: string;',
7586   '  c: char;',
7587   '  b: boolean;',
7588   'begin',
7589   '  b:= s[1] = c;',
7590   '  b:= c = s[1];',
7591   '  b:= c <> s[1];',
7592   '  b:= c > s[1];',
7593   '  b:= c >= s[1];',
7594   '  b:= c < s[2];',
7595   '  b:= c <= s[1];',
7596   '  s[1] := c;',
7597   '  s[2+3] := c;']);
7598   ConvertProgram;
7599   CheckSource('TestString_CharAt',
7600     LinesToStr([ // statements
7601     'this.s = "";',
7602     'this.c = "";',
7603     'this.b = false;'
7604     ]),
7605     LinesToStr([ // this.$main
7606     '$mod.b = $mod.s.charAt(0) === $mod.c;',
7607     '$mod.b = $mod.c === $mod.s.charAt(0);',
7608     '$mod.b = $mod.c !== $mod.s.charAt(0);',
7609     '$mod.b = $mod.c > $mod.s.charAt(0);',
7610     '$mod.b = $mod.c >= $mod.s.charAt(0);',
7611     '$mod.b = $mod.c < $mod.s.charAt(1);',
7612     '$mod.b = $mod.c <= $mod.s.charAt(0);',
7613     '$mod.s = rtl.setCharAt($mod.s, 0, $mod.c);',
7614     '$mod.s = rtl.setCharAt($mod.s, (2 + 3) - 1, $mod.c);',
7615     '']));
7616 end;
7617 
7618 procedure TTestModule.TestStringHMinusFail;
7619 begin
7620   StartProgram(false);
7621   Add([
7622   '{$H-}',
7623   'var s: string;',
7624   'begin']);
7625   ConvertProgram;
7626   CheckHint(mtWarning,nWarnIllegalCompilerDirectiveX,'Warning: test1.pp(3,6) : Illegal compiler directive "H-"');
7627 end;
7628 
7629 procedure TTestModule.TestStr;
7630 begin
7631   StartProgram(false);
7632   Add('var');
7633   Add('  b: boolean;');
7634   Add('  i: longint;');
7635   Add('  d: double;');
7636   Add('  s: string;');
7637   Add('begin');
7638   Add('  str(b,s);');
7639   Add('  str(i,s);');
7640   Add('  str(d,s);');
7641   Add('  str(i:3,s);');
7642   Add('  str(d:3:2,s);');
7643   Add('  Str(12.456:12:1,s);');
7644   Add('  Str(12.456:12,s);');
7645   Add('  s:=str(b);');
7646   Add('  s:=str(i);');
7647   Add('  s:=str(d);');
7648   Add('  s:=str(i,i);');
7649   Add('  s:=str(i:3);');
7650   Add('  s:=str(d:3:2);');
7651   Add('  s:=str(i:4,i);');
7652   Add('  s:=str(i,i:5);');
7653   Add('  s:=str(i:4,i:5);');
7654   Add('  s:=str(s,s);');
7655   Add('  s:=str(s,''foo'');');
7656   ConvertProgram;
7657   CheckSource('TestStr',
7658     LinesToStr([ // statements
7659     'this.b = false;',
7660     'this.i = 0;',
7661     'this.d = 0.0;',
7662     'this.s = "";',
7663     '']),
7664     LinesToStr([ // this.$main
7665     '$mod.s = ""+$mod.b;',
7666     '$mod.s = ""+$mod.i;',
7667     '$mod.s = rtl.floatToStr($mod.d);',
7668     '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
7669     '$mod.s = rtl.floatToStr($mod.d,3,2);',
7670     '$mod.s = rtl.floatToStr(12.456,12,1);',
7671     '$mod.s = rtl.floatToStr(12.456,12);',
7672     '$mod.s = ""+$mod.b;',
7673     '$mod.s = ""+$mod.i;',
7674     '$mod.s = rtl.floatToStr($mod.d);',
7675     '$mod.s = ""+$mod.i+$mod.i;',
7676     '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
7677     '$mod.s = rtl.floatToStr($mod.d,3,2);',
7678     '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + $mod.i;',
7679     '$mod.s = "" + $mod.i + rtl.spaceLeft("" + $mod.i, 5);',
7680     '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + rtl.spaceLeft("" + $mod.i, 5);',
7681     '$mod.s = $mod.s + $mod.s;',
7682     '$mod.s = $mod.s + "foo";',
7683     '']));
7684 end;
7685 
7686 procedure TTestModule.TestBaseType_AnsiStringFail;
7687 begin
7688   StartProgram(false);
7689   Add('var s: AnsiString');
7690   SetExpectedPasResolverError('identifier not found "AnsiString"',PasResolveEval.nIdentifierNotFound);
7691   ConvertProgram;
7692 end;
7693 
7694 procedure TTestModule.TestBaseType_WideStringFail;
7695 begin
7696   StartProgram(false);
7697   Add('var s: WideString');
7698   SetExpectedPasResolverError('identifier not found "WideString"',PasResolveEval.nIdentifierNotFound);
7699   ConvertProgram;
7700 end;
7701 
7702 procedure TTestModule.TestBaseType_ShortStringFail;
7703 begin
7704   StartProgram(false);
7705   Add('var s: ShortString');
7706   SetExpectedPasResolverError('identifier not found "ShortString"',PasResolveEval.nIdentifierNotFound);
7707   ConvertProgram;
7708 end;
7709 
7710 procedure TTestModule.TestBaseType_RawByteStringFail;
7711 begin
7712   StartProgram(false);
7713   Add('var s: RawByteString');
7714   SetExpectedPasResolverError('identifier not found "RawByteString"',PasResolveEval.nIdentifierNotFound);
7715   ConvertProgram;
7716 end;
7717 
7718 procedure TTestModule.TestTypeShortstring_Fail;
7719 begin
7720   StartProgram(false);
7721   Add('type t = string[12];');
7722   Add('var s: t;');
7723   Add('begin');
7724   SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
7725   ConvertProgram;
7726 end;
7727 
7728 procedure TTestModule.TestCharSet_Custom;
7729 begin
7730   StartProgram(false);
7731   Add([
7732   'type',
7733   '  TCharRg = ''a''..''z'';',
7734   '  TSetOfCharRg = set of TCharRg;',
7735   '  TCharRg2 = ''m''..''p'';',
7736   'const',
7737   '  crg: TCharRg = ''b'';',
7738   'var',
7739   '  c: char;',
7740   '  crg2: TCharRg2;',
7741   '  s: TSetOfCharRg;',
7742   'begin',
7743   '  c:=crg;',
7744   '  crg:=c;',
7745   '  crg2:=crg;',
7746   '  if c=crg then ;',
7747   '  if crg=c then ;',
7748   '  if crg=crg2 then ;',
7749   '  if c in s then ;',
7750   '  if crg2 in s then ;',
7751   '  c:=default(TCharRg);',
7752   '']);
7753   ConvertProgram;
7754   CheckSource('TestCharSet_Custom',
7755     LinesToStr([ // statements
7756     'this.crg = "b";',
7757     'this.c = "";',
7758     'this.crg2 = "m";',
7759     'this.s = {};',
7760     '']),
7761     LinesToStr([ // this.$main
7762     '$mod.c = $mod.crg;',
7763     '$mod.crg = $mod.c;',
7764     '$mod.crg2 = $mod.crg;',
7765     'if ($mod.c === $mod.crg) ;',
7766     'if ($mod.crg === $mod.c) ;',
7767     'if ($mod.crg === $mod.crg2) ;',
7768     'if ($mod.c.charCodeAt() in $mod.s) ;',
7769     'if ($mod.crg2.charCodeAt() in $mod.s) ;',
7770     '$mod.c = "a";',
7771     '']));
7772 end;
7773 
7774 procedure TTestModule.TestForCharDo;
7775 begin
7776   StartProgram(false);
7777   Add([
7778   'var c: char;',
7779   'begin',
7780   '  for c:=''a'' to ''c'' do ;',
7781   '  for c:=c downto ''a'' do ;',
7782   '  for c:=''Б'' to ''Я'' do ;',
7783   '']);
7784   ConvertProgram;
7785   CheckSource('TestForCharDo',
7786     LinesToStr([ // statements
7787     'this.c = "";']),
7788     LinesToStr([ // this.$main
7789     'for (var $l = 97; $l <= 99; $l++) $mod.c = String.fromCharCode($l);',
7790     'for (var $l1 = $mod.c.charCodeAt(); $l1 >= 97; $l1--) $mod.c = String.fromCharCode($l1);',
7791     'for (var $l2 = 1041; $l2 <= 1071; $l2++) $mod.c = String.fromCharCode($l2);',
7792     '']));
7793 end;
7794 
7795 procedure TTestModule.TestForCharInDo;
7796 begin
7797   StartProgram(false);
7798   Add([
7799   'type',
7800   '  TSetOfChar = set of char;',
7801   '  TCharRg = ''a''..''z'';',
7802   '  TSetOfCharRg = set of TCharRg;',
7803   'const Foo = ''foo'';',
7804   'var',
7805   '  c,c2: char;',
7806   '  s: string;',
7807   '  a1: array of char;',
7808   '  a2: array[1..3] of char;',
7809   '  soc: TSetOfChar;',
7810   '  socr: TSetOfCharRg;',
7811   '  cr: TCharRg;',
7812   'begin',
7813   '  for c in foo do ;',
7814   '  for c in s do ;',
7815   '  for c in char do ;',
7816   '  for c in a1 do ;',
7817   '  for c in a2 do ;',
7818   '  for c in [''1''..''3''] do ;',
7819   '  for c in TSetOfChar do ;',
7820   '  for c in TCharRg do ;',
7821   '  for c in soc do c2:=c;',
7822   '  for c in TSetOfCharRg do ;',
7823   '  for c in socr do ;',
7824   '  for cr in TCharRg do ;',
7825   '  for cr in TSetOfCharRg do ;',
7826   '  for cr in socr do ;',
7827   '']);
7828   ConvertProgram;
7829   CheckSource('TestForCharInDo',
7830     LinesToStr([ // statements
7831     'this.Foo = "foo";',
7832     'this.c = "";',
7833     'this.c2 = "";',
7834     'this.s = "";',
7835     'this.a1 = [];',
7836     'this.a2 = rtl.arraySetLength(null, "", 3);',
7837     'this.soc = {};',
7838     'this.socr = {};',
7839     'this.cr = "a";',
7840     '']),
7841     LinesToStr([ // this.$main
7842     'for (var $in = $mod.Foo, $l = 0, $end = $in.length - 1; $l <= $end; $l++) $mod.c = $in.charAt($l);',
7843     'for (var $in1 = $mod.s, $l1 = 0, $end1 = $in1.length - 1; $l1 <= $end1; $l1++) $mod.c = $in1.charAt($l1);',
7844     'for (var $l2 = 0; $l2 <= 65535; $l2++) $mod.c = String.fromCharCode($l2);',
7845     'for (var $in2 = $mod.a1, $l3 = 0, $end2 = rtl.length($in2) - 1; $l3 <= $end2; $l3++) $mod.c = $in2[$l3];',
7846     'for (var $in3 = $mod.a2, $l4 = 0, $end3 = rtl.length($in3) - 1; $l4 <= $end3; $l4++) $mod.c = $in3[$l4];',
7847     'for (var $l5 = 49; $l5 <= 51; $l5++) $mod.c = String.fromCharCode($l5);',
7848     'for (var $l6 = 0; $l6 <= 65535; $l6++) $mod.c = String.fromCharCode($l6);',
7849     'for (var $l7 = 97; $l7 <= 122; $l7++) $mod.c = String.fromCharCode($l7);',
7850     'for (var $l8 in $mod.soc) {',
7851     '  $mod.c = String.fromCharCode($l8);',
7852     '  $mod.c2 = $mod.c;',
7853     '};',
7854     'for (var $l9 = 97; $l9 <= 122; $l9++) $mod.c = String.fromCharCode($l9);',
7855     'for (var $l10 in $mod.socr) $mod.c = String.fromCharCode($l10);',
7856     'for (var $l11 = 97; $l11 <= 122; $l11++) $mod.cr = String.fromCharCode($l11);',
7857     'for (var $l12 = 97; $l12 <= 122; $l12++) $mod.cr = String.fromCharCode($l12);',
7858     'for (var $l13 in $mod.socr) $mod.cr = String.fromCharCode($l13);',
7859     '']));
7860 end;
7861 
7862 procedure TTestModule.TestProcTwoArgs;
7863 begin
7864   StartProgram(false);
7865   Add('procedure Test(a,b: longint);');
7866   Add('begin');
7867   Add('end;');
7868   Add('begin');
7869   ConvertProgram;
7870   CheckSource('TestProcTwoArgs',
7871     LinesToStr([ // statements
7872     'this.Test = function (a,b) {',
7873     '};'
7874     ]),
7875     LinesToStr([ // this.$main
7876     ''
7877     ]));
7878 end;
7879 
7880 procedure TTestModule.TestProc_DefaultValue;
7881 begin
7882   StartProgram(false);
7883   Add('procedure p1(i: longint = 1);');
7884   Add('begin');
7885   Add('end;');
7886   Add('procedure p2(i: longint = 1; c: char = ''a'');');
7887   Add('begin');
7888   Add('end;');
7889   Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
7890   Add('begin');
7891   Add('end;');
7892   Add('begin');
7893   Add('  p1;');
7894   Add('  p1();');
7895   Add('  p1(11);');
7896   Add('  p2;');
7897   Add('  p2();');
7898   Add('  p2(12);');
7899   Add('  p2(13,''b'');');
7900   Add('  p3();');
7901   ConvertProgram;
7902   CheckSource('TestProc_DefaultValue',
7903     LinesToStr([ // statements
7904     'this.p1 = function (i) {',
7905     '};',
7906     'this.p2 = function (i,c) {',
7907     '};',
7908     'this.p3 = function (d,b,s) {',
7909     '};'
7910     ]),
7911     LinesToStr([ // this.$main
7912     '  $mod.p1(1);',
7913     '  $mod.p1(1);',
7914     '  $mod.p1(11);',
7915     '  $mod.p2(1,"a");',
7916     '  $mod.p2(1,"a");',
7917     '  $mod.p2(12,"a");',
7918     '  $mod.p2(13,"b");',
7919     '  $mod.p3(1.0,false,"abc");'
7920     ]));
7921 end;
7922 
7923 procedure TTestModule.TestFunctionInt;
7924 begin
7925   StartProgram(false);
7926   Add('function MyTest(Bar: longint): longint;');
7927   Add('begin');
7928   Add('  Result:=2*bar');
7929   Add('end;');
7930   Add('begin');
7931   ConvertProgram;
7932   CheckSource('TestFunctionInt',
7933     LinesToStr([ // statements
7934     'this.MyTest = function (Bar) {',
7935     '  var Result = 0;',
7936     '  Result = 2*Bar;',
7937     '  return Result;',
7938     '};'
7939     ]),
7940     LinesToStr([ // this.$main
7941     ''
7942     ]));
7943 end;
7944 
7945 procedure TTestModule.TestFunctionString;
7946 begin
7947   StartProgram(false);
7948   Add('function Test(Bar: string): string;');
7949   Add('begin');
7950   Add('  Result:=bar+BAR');
7951   Add('end;');
7952   Add('begin');
7953   ConvertProgram;
7954   CheckSource('TestFunctionString',
7955     LinesToStr([ // statements
7956     'this.Test = function (Bar) {',
7957     '  var Result = "";',
7958     '  Result = Bar+Bar;',
7959     '  return Result;',
7960     '};'
7961     ]),
7962     LinesToStr([ // this.$main
7963     ''
7964     ]));
7965 end;
7966 
7967 procedure TTestModule.TestIfThen;
7968 begin
7969   StartProgram(false);
7970   Add([
7971   'var b: boolean;',
7972   'begin',
7973   '  if b then ;',
7974   '  if b then else ;']);
7975   ConvertProgram;
7976   CheckSource('TestIfThen',
7977     LinesToStr([ // statements
7978     'this.b = false;',
7979     '']),
7980     LinesToStr([ // this.$main
7981     'if ($mod.b) ;',
7982     'if ($mod.b) ;',
7983     '']));
7984 end;
7985 
7986 procedure TTestModule.TestForLoop;
7987 begin
7988   StartProgram(false);
7989   Add('var');
7990   Add('  vI, vJ, vN: longint;');
7991   Add('begin');
7992   Add('  VJ:=0;');
7993   Add('  VN:=3;');
7994   Add('  for VI:=1 to VN do');
7995   Add('  begin');
7996   Add('    VJ:=VJ+VI;');
7997   Add('  end;');
7998   ConvertProgram;
7999   CheckSource('TestForLoop',
8000     LinesToStr([ // statements
8001     'this.vI = 0;',
8002     'this.vJ = 0;',
8003     'this.vN = 0;'
8004     ]),
8005     LinesToStr([ // this.$main
8006     '  $mod.vJ = 0;',
8007     '  $mod.vN = 3;',
8008     '  for (var $l = 1, $end = $mod.vN; $l <= $end; $l++) {',
8009     '    $mod.vI = $l;',
8010     '    $mod.vJ = $mod.vJ + $mod.vI;',
8011     '  };',
8012     '']));
8013 end;
8014 
8015 procedure TTestModule.TestForLoopInsideFunction;
8016 begin
8017   StartProgram(false);
8018   Add('function SumNumbers(Count: longint): longint;');
8019   Add('var');
8020   Add('  vI, vJ: longint;');
8021   Add('begin');
8022   Add('  vj:=0;');
8023   Add('  for vi:=1 to count do');
8024   Add('  begin');
8025   Add('    vj:=vj+vi;');
8026   Add('  end;');
8027   Add('end;');
8028   Add('begin');
8029   Add('  sumnumbers(3);');
8030   ConvertProgram;
8031   CheckSource('TestForLoopInsideFunction',
8032     LinesToStr([ // statements
8033     'this.SumNumbers = function (Count) {',
8034     '  var Result = 0;',
8035     '  var vI = 0;',
8036     '  var vJ = 0;',
8037     '  vJ = 0;',
8038     '  for (var $l = 1, $end = Count; $l <= $end; $l++) {',
8039     '    vI = $l;',
8040     '    vJ = vJ + vI;',
8041     '  };',
8042     '  return Result;',
8043     '};'
8044     ]),
8045     LinesToStr([ // $mod.$main
8046     '  $mod.SumNumbers(3);'
8047     ]));
8048 end;
8049 
8050 procedure TTestModule.TestForLoop_ReadVarAfter;
8051 begin
8052   StartProgram(false);
8053   Add('var');
8054   Add('  vI: longint;');
8055   Add('begin');
8056   Add('  for vi:=1 to 2 do ;');
8057   Add('  if vi=3 then ;');
8058   ConvertProgram;
8059   CheckSource('TestForLoop',
8060     LinesToStr([ // statements
8061     'this.vI = 0;'
8062     ]),
8063     LinesToStr([ // this.$main
8064     '  for ($mod.vI = 1; $mod.vI <= 2; $mod.vI++) ;',
8065     '  if ($mod.vI===3) ;'
8066     ]));
8067 end;
8068 
8069 procedure TTestModule.TestForLoop_Nested;
8070 begin
8071   StartProgram(false);
8072   Add('function SumNumbers(Count: longint): longint;');
8073   Add('var');
8074   Add('  vI, vJ, vK: longint;');
8075   Add('begin');
8076   Add('  VK:=0;');
8077   Add('  for VI:=1 to count do');
8078   Add('  begin');
8079   Add('    for vj:=1 to vi do');
8080   Add('    begin');
8081   Add('      vk:=VK+VI;');
8082   Add('    end;');
8083   Add('  end;');
8084   Add('end;');
8085   Add('begin');
8086   Add('  sumnumbers(3);');
8087   ConvertProgram;
8088   CheckSource('TestForLoopInFunction',
8089     LinesToStr([ // statements
8090     'this.SumNumbers = function (Count) {',
8091     '  var Result = 0;',
8092     '  var vI = 0;',
8093     '  var vJ = 0;',
8094     '  var vK = 0;',
8095     '  vK = 0;',
8096     '  for (var $l = 1, $end = Count; $l <= $end; $l++) {',
8097     '    vI = $l;',
8098     '    for (var $l1 = 1, $end1 = vI; $l1 <= $end1; $l1++) {',
8099     '      vJ = $l1;',
8100     '      vK = vK + vI;',
8101     '    };',
8102     '  };',
8103     '  return Result;',
8104     '};'
8105     ]),
8106     LinesToStr([ // $mod.$main
8107     '  $mod.SumNumbers(3);'
8108     ]));
8109 end;
8110 
8111 procedure TTestModule.TestRepeatUntil;
8112 begin
8113   StartProgram(false);
8114   Add('var');
8115   Add('  vI, vJ, vN: longint;');
8116   Add('begin');
8117   Add('  vn:=3;');
8118   Add('  vj:=0;');
8119   Add('  VI:=0;');
8120   Add('  repeat');
8121   Add('    VI:=vi+1;');
8122   Add('    vj:=VJ+vI;');
8123   Add('  until vi>=vn');
8124   ConvertProgram;
8125   CheckSource('TestRepeatUntil',
8126     LinesToStr([ // statements
8127     'this.vI = 0;',
8128     'this.vJ = 0;',
8129     'this.vN = 0;'
8130     ]),
8131     LinesToStr([ // $mod.$main
8132     '  $mod.vN = 3;',
8133     '  $mod.vJ = 0;',
8134     '  $mod.vI = 0;',
8135     '  do{',
8136     '    $mod.vI = $mod.vI + 1;',
8137     '    $mod.vJ = $mod.vJ + $mod.vI;',
8138     '  }while(!($mod.vI>=$mod.vN));'
8139     ]));
8140 end;
8141 
8142 procedure TTestModule.TestAsmBlock;
8143 begin
8144   StartProgram(false);
8145   Add([
8146   'var',
8147   '  vI: longint;',
8148   'begin',
8149   '  vi:=1;',
8150   '  asm',
8151   '    if (vI===1) {',
8152   '      vI=2;',
8153   //'      console.log(''end;'');',  ToDo
8154   '    }',
8155   '    if (vI===2){ vI=3; }',
8156   '  end;',
8157   '  VI:=4;']);
8158   ConvertProgram;
8159   CheckSource('TestAsmBlock',
8160     LinesToStr([ // statements
8161     'this.vI = 0;'
8162     ]),
8163     LinesToStr([ // $mod.$main
8164     '$mod.vI = 1;',
8165     'if (vI===1) {',
8166     '  vI=2;',
8167     '}',
8168     'if (vI===2){ vI=3; }',
8169     ';',
8170     '$mod.vI = 4;'
8171     ]));
8172 end;
8173 
8174 procedure TTestModule.TestAsmPas_Impl;
8175 begin
8176   StartUnit(false);
8177   Add('interface');
8178   Add('const cIntf: longint = 1;');
8179   Add('var vIntf: longint;');
8180   Add('implementation');
8181   Add('const cImpl: longint = 2;');
8182   Add('var vImpl: longint;');
8183   Add('procedure DoIt;');
8184   Add('const cLoc: longint = 3;');
8185   Add('var vLoc: longint;');
8186   Add('begin;');
8187   Add('  asm');
8188   //Add('    pas(vIntf)=pas(cIntf);');
8189   //Add('    pas(vImpl)=pas(cImpl);');
8190   //Add('    pas(vLoc)=pas(cLoc);');
8191   Add('  end;');
8192   Add('end;');
8193   ConvertUnit;
8194   CheckSource('TestAsmPas_Impl',
8195     LinesToStr([
8196     'var $impl = $mod.$impl;',
8197     'this.cIntf = 1;',
8198     'this.vIntf = 0;',
8199     '']),
8200     '', // this.$init
8201     LinesToStr([ // implementation
8202     '$impl.cImpl = 2;',
8203     '$impl.vImpl = 0;',
8204     'var cLoc = 3;',
8205     '$impl.DoIt = function () {',
8206     '  var vLoc = 0;',
8207     '};',
8208     '']) );
8209 end;
8210 
8211 procedure TTestModule.TestTryFinally;
8212 begin
8213   StartProgram(false);
8214   Add('var i: longint;');
8215   Add('begin');
8216   Add('  try');
8217   Add('    i:=0; i:=2 div i;');
8218   Add('  finally');
8219   Add('    i:=3');
8220   Add('  end;');
8221   ConvertProgram;
8222   CheckSource('TestTryFinally',
8223     LinesToStr([ // statements
8224     'this.i = 0;'
8225     ]),
8226     LinesToStr([ // $mod.$main
8227     'try {',
8228     '  $mod.i = 0;',
8229     '  $mod.i = Math.floor(2 / $mod.i);',
8230     '} finally {',
8231     '  $mod.i = 3;',
8232     '};'
8233     ]));
8234 end;
8235 
8236 procedure TTestModule.TestTryExcept;
8237 begin
8238   StartProgram(false);
8239   Add([
8240   'type',
8241   '  TObject = class end;',
8242   '  Exception = class Msg: string; end;',
8243   '  EInvalidCast = class(Exception) end;',
8244   'var vI: longint;',
8245   'begin',
8246   '  try',
8247   '    vi:=1;',
8248   '  except',
8249   '    vi:=2',
8250   '  end;',
8251   '  try',
8252   '    vi:=3;',
8253   '  except',
8254   '    raise;',
8255   '  end;',
8256   '  try',
8257   '    VI:=4;',
8258   '  except',
8259   '    on einvalidcast do',
8260   '      raise;',
8261   '    on E: exception do',
8262   '      if e.msg='''' then',
8263   '        raise e;',
8264   '    else',
8265   '      vi:=5',
8266   '  end;',
8267   '  try',
8268   '    VI:=6;',
8269   '  except',
8270   '    on einvalidcast do ;',
8271   '  end;',
8272   '']);
8273   ConvertProgram;
8274   CheckSource('TestTryExcept',
8275     LinesToStr([ // statements
8276     'rtl.createClass($mod, "TObject", null, function () {',
8277     '  this.$init = function () {',
8278     '  };',
8279     '  this.$final = function () {',
8280     '  };',
8281     '});',
8282     'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
8283     '  this.$init = function () {',
8284     '    $mod.TObject.$init.call(this);',
8285     '    this.Msg = "";',
8286     '  };',
8287     '});',
8288     'rtl.createClass($mod, "EInvalidCast", $mod.Exception, function () {',
8289     '});',
8290     'this.vI = 0;'
8291     ]),
8292     LinesToStr([ // $mod.$main
8293     'try {',
8294     '  $mod.vI = 1;',
8295     '} catch ($e) {',
8296     '  $mod.vI = 2;',
8297     '};',
8298     'try {',
8299     '  $mod.vI = 3;',
8300     '} catch ($e) {',
8301     '  throw $e;',
8302     '};',
8303     'try {',
8304     '  $mod.vI = 4;',
8305     '} catch ($e) {',
8306     '  if ($mod.EInvalidCast.isPrototypeOf($e)){',
8307     '    throw $e',
8308     '  } else if ($mod.Exception.isPrototypeOf($e)) {',
8309     '    var E = $e;',
8310     '    if (E.Msg === "") throw E;',
8311     '  } else {',
8312     '    $mod.vI = 5;',
8313     '  }',
8314     '};',
8315     'try {',
8316     '  $mod.vI = 6;',
8317     '} catch ($e) {',
8318     '  if ($mod.EInvalidCast.isPrototypeOf($e)){' ,
8319     '  } else throw $e',
8320     '};',
8321     '']));
8322 end;
8323 
8324 procedure TTestModule.TestTryExcept_ReservedWords;
8325 begin
8326   StartProgram(false);
8327   Add([
8328   'type',
8329   '  TObject = class end;',
8330   '  Exception = class',
8331   '    Symbol: string;',
8332   '  end;',
8333   'var &try: longint;',
8334   'begin',
8335   '  try',
8336   '    &try:=4;',
8337   '  except',
8338   '    on Error: exception do',
8339   '      if errOR.symBol='''' then',
8340   '        raise ERRor;',
8341   '  end;',
8342   '']);
8343   ConvertProgram;
8344   CheckSource('TestTryExcept_ReservedWords',
8345     LinesToStr([ // statements
8346     'rtl.createClass($mod, "TObject", null, function () {',
8347     '  this.$init = function () {',
8348     '  };',
8349     '  this.$final = function () {',
8350     '  };',
8351     '});',
8352     'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
8353     '  this.$init = function () {',
8354     '    $mod.TObject.$init.call(this);',
8355     '    this.Symbol = "";',
8356     '  };',
8357     '});',
8358     'this.Try = 0;',
8359     '']),
8360     LinesToStr([ // $mod.$main
8361     'try {',
8362     '  $mod.Try = 4;',
8363     '} catch ($e) {',
8364     '  if ($mod.Exception.isPrototypeOf($e)) {',
8365     '    var error = $e;',
8366     '    if (error.Symbol === "") throw error;',
8367     '  } else throw $e',
8368     '};',
8369     '']));
8370 end;
8371 
8372 procedure TTestModule.TestIfThenRaiseElse;
8373 begin
8374   StartProgram(false);
8375   Add([
8376   'type',
8377   '  TObject = class',
8378   '    constructor Create;',
8379   '  end;',
8380   'constructor TObject.Create;',
8381   'begin',
8382   'end;',
8383   'var b: boolean;',
8384   'begin',
8385   '  if b then',
8386   '    raise TObject.Create',
8387   '  else',
8388   '    b:=false;',
8389   '']);
8390   ConvertProgram;
8391   CheckSource('TestIfThenRaiseElse',
8392     LinesToStr([ // statements
8393     'rtl.createClass($mod, "TObject", null, function () {',
8394     '  this.$init = function () {',
8395     '  };',
8396     '  this.$final = function () {',
8397     '  };',
8398     '  this.Create = function () {',
8399     '    return this;',
8400     '  };',
8401     '});',
8402     'this.b = false;',
8403     '']),
8404     LinesToStr([ // $mod.$main
8405     'if ($mod.b) {',
8406     '  throw $mod.TObject.$create("Create")}',
8407     ' else $mod.b = false;',
8408     '']));
8409 end;
8410 
8411 procedure TTestModule.TestCaseOf;
8412 begin
8413   StartProgram(false);
8414   Add([
8415   'const e: longint; external name ''$e'';',
8416   'var vI: longint;',
8417   'begin',
8418   '  case vi of',
8419   '  1: ;',
8420   '  2: vi:=3;',
8421   '  e: ;',
8422   '  else',
8423   '    VI:=4',
8424   '  end;']);
8425   ConvertProgram;
8426   CheckSource('TestCaseOf',
8427     LinesToStr([ // statements
8428     'this.vI = 0;'
8429     ]),
8430     LinesToStr([ // $mod.$main
8431     'var $tmp = $mod.vI;',
8432     'if ($tmp === 1) {}',
8433     'else if ($tmp === 2) {',
8434     '  $mod.vI = 3}',
8435     ' else if ($tmp === $e) {}',
8436     'else {',
8437     '  $mod.vI = 4;',
8438     '};'
8439     ]));
8440 end;
8441 
8442 procedure TTestModule.TestCaseOf_UseSwitch;
8443 begin
8444   StartProgram(false);
8445   Converter.UseSwitchStatement:=true;
8446   Add('var Vi: longint;');
8447   Add('begin');
8448   Add('  case vi of');
8449   Add('  1: ;');
8450   Add('  2: VI:=3;');
8451   Add('  else');
8452   Add('    vi:=4');
8453   Add('  end;');
8454   ConvertProgram;
8455   CheckSource('TestCaseOf_UseSwitch',
8456     LinesToStr([ // statements
8457     'this.Vi = 0;'
8458     ]),
8459     LinesToStr([ // $mod.$main
8460     'switch ($mod.Vi) {',
8461     'case 1:',
8462     '  break;',
8463     'case 2:',
8464     '  $mod.Vi = 3;',
8465     '  break;',
8466     'default:',
8467     '  $mod.Vi = 4;',
8468     '};'
8469     ]));
8470 end;
8471 
8472 procedure TTestModule.TestCaseOfNoElse;
8473 begin
8474   StartProgram(false);
8475   Add('var Vi: longint;');
8476   Add('begin');
8477   Add('  case vi of');
8478   Add('  1: begin vi:=2; VI:=3; end;');
8479   Add('  end;');
8480   ConvertProgram;
8481   CheckSource('TestCaseOfNoElse',
8482     LinesToStr([ // statements
8483     'this.Vi = 0;'
8484     ]),
8485     LinesToStr([ // $mod.$main
8486     'var $tmp = $mod.Vi;',
8487     'if ($tmp === 1) {',
8488     '  $mod.Vi = 2;',
8489     '  $mod.Vi = 3;',
8490     '};'
8491     ]));
8492 end;
8493 
8494 procedure TTestModule.TestCaseOfNoElse_UseSwitch;
8495 begin
8496   StartProgram(false);
8497   Converter.UseSwitchStatement:=true;
8498   Add('var vI: longint;');
8499   Add('begin');
8500   Add('  case vi of');
8501   Add('  1: begin VI:=2; vi:=3; end;');
8502   Add('  end;');
8503   ConvertProgram;
8504   CheckSource('TestCaseOfNoElse_UseSwitch',
8505     LinesToStr([ // statements
8506     'this.vI = 0;'
8507     ]),
8508     LinesToStr([ // $mod.$main
8509     'switch ($mod.vI) {',
8510     'case 1:',
8511     '  $mod.vI = 2;',
8512     '  $mod.vI = 3;',
8513     '  break;',
8514     '};'
8515     ]));
8516 end;
8517 
8518 procedure TTestModule.TestCaseOfRange;
8519 begin
8520   StartProgram(false);
8521   Add('var vI: longint;');
8522   Add('begin');
8523   Add('  case vi of');
8524   Add('  1..3: vi:=14;');
8525   Add('  4,5: vi:=16;');
8526   Add('  6..7,9..10: ;');
8527   Add('  else ;');
8528   Add('  end;');
8529   ConvertProgram;
8530   CheckSource('TestCaseOfRange',
8531     LinesToStr([ // statements
8532     'this.vI = 0;'
8533     ]),
8534     LinesToStr([ // $mod.$main
8535     'var $tmp = $mod.vI;',
8536     'if (($tmp >= 1) && ($tmp <= 3)){',
8537     '  $mod.vI = 14',
8538     '} else if (($tmp === 4) || ($tmp === 5)){',
8539     '  $mod.vI = 16',
8540     '} else if ((($tmp >= 6) && ($tmp <= 7)) || (($tmp >= 9) && ($tmp <= 10))) ;'
8541     ]));
8542 end;
8543 
8544 procedure TTestModule.TestCaseOfString;
8545 begin
8546   StartProgram(false);
8547   Add([
8548   'var s,h: string;',
8549   'begin',
8550   '  case s of',
8551   '  ''foo'': s:=h;',
8552   '  ''a''..''z'': h:=s;',
8553   '  ''ў'', ''ё'': ;',
8554   '  ''Б''..''Я'': ;',
8555   '  end;',
8556   '']);
8557   ConvertProgram;
8558   CheckSource('TestCaseOfString',
8559     LinesToStr([ // statements
8560     'this.s = "";',
8561     'this.h = "";',
8562     '']),
8563     LinesToStr([ // $mod.$main
8564     'var $tmp = $mod.s;',
8565     'if ($tmp === "foo") {',
8566     '  $mod.s = $mod.h}',
8567     ' else if (($tmp.length === 1) && ($tmp >= "a") && ($tmp <= "z")) {',
8568     '  $mod.h = $mod.s}',
8569     ' else if (($tmp === "ў") || ($tmp === "ё")) {}',
8570     ' else if (($tmp.length === 1) && ($tmp >= "Б") && ($tmp <= "Я")) ;',
8571     '']));
8572 end;
8573 
8574 procedure TTestModule.TestCaseOfChar;
8575 begin
8576   StartProgram(false);
8577   Add([
8578   'var s,h: char;',
8579   'begin',
8580   '  case s of',
8581   '  ''a''..''z'': h:=s;',
8582   '  ''ä'': ;',
8583   '  ''ў'', ''ё'': ;',
8584   '  ''Б''..''Я'': ;',
8585   '  end;',
8586   '']);
8587   ConvertProgram;
8588   CheckSource('TestCaseOfString',
8589     LinesToStr([ // statements
8590     'this.s = "";',
8591     'this.h = "";',
8592     '']),
8593     LinesToStr([ // $mod.$main
8594     'var $tmp = $mod.s;',
8595     'if (($tmp >= "a") && ($tmp <= "z")) {',
8596     '  $mod.h = $mod.s}',
8597     ' else if ($tmp === "ä") {}',
8598     ' else if (($tmp === "ў") || ($tmp === "ё")) {}',
8599     ' else if (($tmp >= "Б") && ($tmp <= "Я")) ;',
8600     '']));
8601 end;
8602 
8603 procedure TTestModule.TestCaseOfExternalClassConst;
8604 begin
8605   StartProgram(false);
8606   Add([
8607   '{$modeswitch externalclass}',
8608   'type',
8609   '  TBird = class external name ''Bird''',
8610   '    const e: longint;',
8611   '  end;',
8612   'var vI: longint;',
8613   'begin',
8614   '  case vi of',
8615   '  1: vi:=3;',
8616   '  TBird.e: ;',
8617   '  end;']);
8618   ConvertProgram;
8619   CheckSource('TestCaseOfExternalClassConst',
8620     LinesToStr([ // statements
8621     'this.vI = 0;'
8622     ]),
8623     LinesToStr([ // $mod.$main
8624     'var $tmp = $mod.vI;',
8625     'if ($tmp === 1) {',
8626     '  $mod.vI = 3}',
8627     ' else if ($tmp === Bird.e) ;'
8628     ]));
8629 end;
8630 
8631 procedure TTestModule.TestDebugger;
8632 begin
8633   StartProgram(false);
8634   Add([
8635   'procedure DoIt;',
8636   'begin',
8637   '  deBugger;',
8638   '  DeBugger();',
8639   'end;',
8640   'begin',
8641   '  Debugger;']);
8642   ConvertProgram;
8643   CheckSource('TestDebugger',
8644     LinesToStr([ // statements
8645     'this.DoIt = function () {',
8646     '  debugger;',
8647     '  debugger;',
8648     '};',
8649     '']),
8650     LinesToStr([ // $mod.$main
8651     'debugger;',
8652     '']));
8653 end;
8654 
8655 procedure TTestModule.TestArray_Dynamic;
8656 begin
8657   StartProgram(false);
8658   Add([
8659   'type',
8660   '  TArrayInt = array of longint;',
8661   'var',
8662   '  Arr: TArrayInt;',
8663   '  i: longint;',
8664   '  b: boolean;',
8665   'begin',
8666   '  SetLength(arr,3);',
8667   '  arr[0]:=4;',
8668   '  arr[1]:=length(arr)+arr[0];',
8669   '  arr[i]:=5;',
8670   '  arr[arr[i]]:=arr[6];',
8671   '  i:=low(arr);',
8672   '  i:=high(arr);',
8673   '  b:=Assigned(arr);',
8674   '  Arr:=default(TArrayInt);']);
8675   ConvertProgram;
8676   CheckSource('TestArray_Dynamic',
8677     LinesToStr([ // statements
8678     'this.Arr = [];',
8679     'this.i = 0;',
8680     'this.b = false;'
8681     ]),
8682     LinesToStr([ // $mod.$main
8683     '$mod.Arr = rtl.arraySetLength($mod.Arr,0,3);',
8684     '$mod.Arr[0] = 4;',
8685     '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
8686     '$mod.Arr[$mod.i] = 5;',
8687     '$mod.Arr[$mod.Arr[$mod.i]] = $mod.Arr[6];',
8688     '$mod.i = 0;',
8689     '$mod.i = rtl.length($mod.Arr) - 1;',
8690     '$mod.b = rtl.length($mod.Arr) > 0;',
8691     '$mod.Arr = [];',
8692     '']));
8693 end;
8694 
8695 procedure TTestModule.TestArray_Dynamic_Nil;
8696 begin
8697   StartProgram(false);
8698   Add('type');
8699   Add('  TArrayInt = array of longint;');
8700   Add('var');
8701   Add('  Arr: TArrayInt;');
8702   Add('procedure DoIt(const i: TArrayInt; j: TArrayInt); begin end;');
8703   Add('begin');
8704   Add('  arr:=nil;');
8705   Add('  if arr=nil then;');
8706   Add('  if nil=arr then;');
8707   Add('  if arr<>nil then;');
8708   Add('  if nil<>arr then;');
8709   Add('  DoIt(nil,nil);');
8710   ConvertProgram;
8711   CheckSource('TestArray_Dynamic',
8712     LinesToStr([ // statements
8713     'this.Arr = [];',
8714     'this.DoIt = function(i,j){',
8715     '};'
8716     ]),
8717     LinesToStr([ // $mod.$main
8718     '$mod.Arr = [];',
8719     'if (rtl.length($mod.Arr) === 0) ;',
8720     'if (rtl.length($mod.Arr) === 0) ;',
8721     'if (rtl.length($mod.Arr) > 0) ;',
8722     'if (rtl.length($mod.Arr) > 0) ;',
8723     '$mod.DoIt([],[]);',
8724     '']));
8725 end;
8726 
8727 procedure TTestModule.TestArray_DynMultiDimensional;
8728 begin
8729   StartProgram(false);
8730   Add([
8731   'type',
8732   '  TArrayInt = array of longint;',
8733   '  TArrayArrayInt = array of TArrayInt;',
8734   'var',
8735   '  Arr: TArrayInt;',
8736   '  Arr2: TArrayArrayInt;',
8737   '  i: longint;',
8738   'begin',
8739   '  arr2:=nil;',
8740   '  if arr2=nil then;',
8741   '  if nil=arr2 then;',
8742   '  i:=low(arr2);',
8743   '  i:=low(arr2[1]);',
8744   '  i:=high(arr2);',
8745   '  i:=high(arr2[2]);',
8746   '  arr2[3]:=arr;',
8747   '  arr2[4][5]:=i;',
8748   '  i:=arr2[6][7];',
8749   '  arr2[8,9]:=i;',
8750   '  i:=arr2[10,11];',
8751   '  SetLength(arr2,14);',
8752   '  SetLength(arr2[15],16);']);
8753   ConvertProgram;
8754   CheckSource('TestArray_Dynamic',
8755     LinesToStr([ // statements
8756     'this.Arr = [];',
8757     'this.Arr2 = [];',
8758     'this.i = 0;'
8759     ]),
8760     LinesToStr([ // $mod.$main
8761     '$mod.Arr2 = [];',
8762     'if (rtl.length($mod.Arr2) === 0) ;',
8763     'if (rtl.length($mod.Arr2) === 0) ;',
8764     '$mod.i = 0;',
8765     '$mod.i = 0;',
8766     '$mod.i = rtl.length($mod.Arr2) - 1;',
8767     '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
8768     '$mod.Arr2[3] = rtl.arrayRef($mod.Arr);',
8769     '$mod.Arr2[4][5] = $mod.i;',
8770     '$mod.i = $mod.Arr2[6][7];',
8771     '$mod.Arr2[8][9] = $mod.i;',
8772     '$mod.i = $mod.Arr2[10][11];',
8773     '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
8774     '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
8775     '']));
8776 end;
8777 
8778 procedure TTestModule.TestArray_DynamicAssign;
8779 begin
8780   StartProgram(false);
8781   Add([
8782   'type',
8783   '  TArrayInt = array of longint;',
8784   '  TArrayArrayInt = array of TArrayInt;',
8785   'procedure Run(a: TArrayInt; const b: TArrayInt; constref c: TArrayInt);',
8786   'begin',
8787   'end;',
8788   'procedure Fly(var a: TArrayInt);',
8789   'begin',
8790   'end;',
8791   'var',
8792   '  Arr: TArrayInt;',
8793   '  Arr2: TArrayArrayInt;',
8794   'begin',
8795   '  arr:=nil;',
8796   '  arr2:=nil;',
8797   '  arr2[1]:=nil;',
8798   '  arr2[2]:=arr;',
8799   '  Run(arr,arr,arr);',
8800   '  Fly(arr);',
8801   '  Run(arr2[4],arr2[5],arr2[6]);',
8802   '  Fly(arr2[7]);',
8803   '']);
8804   ConvertProgram;
8805   CheckSource('TestArray_DynamicAssign',
8806     LinesToStr([ // statements
8807     'this.Run = function (a, b, c) {',
8808     '};',
8809     'this.Fly = function (a) {',
8810     '};',
8811     'this.Arr = [];',
8812     'this.Arr2 = [];',
8813     '']),
8814     LinesToStr([ // $mod.$main
8815     '$mod.Arr = [];',
8816     '$mod.Arr2 = [];',
8817     '$mod.Arr2[1] = [];',
8818     '$mod.Arr2[2] = rtl.arrayRef($mod.Arr);',
8819     '$mod.Run(rtl.arrayRef($mod.Arr), $mod.Arr, $mod.Arr);',
8820     '$mod.Fly({',
8821     '  p: $mod,',
8822     '  get: function () {',
8823     '      return this.p.Arr;',
8824     '    },',
8825     '  set: function (v) {',
8826     '      this.p.Arr = v;',
8827     '    }',
8828     '});',
8829     '$mod.Run(rtl.arrayRef($mod.Arr2[4]), $mod.Arr2[5], $mod.Arr2[6]);',
8830     '$mod.Fly({',
8831     '  a: 7,',
8832     '  p: $mod.Arr2,',
8833     '  get: function () {',
8834     '      return this.p[this.a];',
8835     '    },',
8836     '  set: function (v) {',
8837     '      this.p[this.a] = v;',
8838     '    }',
8839     '});',
8840     '']));
8841 end;
8842 
8843 procedure TTestModule.TestArray_StaticInt;
8844 begin
8845   StartProgram(false);
8846   Add('type');
8847   Add('  TArrayInt = array[2..4] of longint;');
8848   Add('var');
8849   Add('  Arr: TArrayInt;');
8850   Add('  Arr2: TArrayInt = (5,6,7);');
8851   Add('  i: longint;');
8852   Add('  b: boolean;');
8853   Add('begin');
8854   Add('  arr[2]:=4;');
8855   Add('  arr[3]:=arr[2]+arr[3];');
8856   Add('  arr[i]:=5;');
8857   Add('  arr[arr[i]]:=arr[high(arr)];');
8858   Add('  i:=low(arr);');
8859   Add('  i:=high(arr);');
8860   Add('  b:=arr[2]=arr[3];');
8861   Add('  arr:=default(TArrayInt);');
8862   ConvertProgram;
8863   CheckSource('TestArray_StaticInt',
8864     LinesToStr([ // statements
8865     'this.Arr = rtl.arraySetLength(null,0,3);',
8866     'this.Arr2 = [5, 6, 7];',
8867     'this.i = 0;',
8868     'this.b = false;'
8869     ]),
8870     LinesToStr([ // $mod.$main
8871     '$mod.Arr[0] = 4;',
8872     '$mod.Arr[1] = $mod.Arr[0] + $mod.Arr[1];',
8873     '$mod.Arr[$mod.i-2] = 5;',
8874     '$mod.Arr[$mod.Arr[$mod.i-2]-2] = $mod.Arr[2];',
8875     '$mod.i = 2;',
8876     '$mod.i = 4;',
8877     '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
8878     '$mod.Arr = rtl.arraySetLength(null,0,3);',
8879     '']));
8880 end;
8881 
8882 procedure TTestModule.TestArray_StaticBool;
8883 begin
8884   StartProgram(false);
8885   Add('type');
8886   Add('  TBools = array[boolean] of boolean;');
8887   Add('  TBool2 = array[true..true] of boolean;');
8888   Add('var');
8889   Add('  Arr: TBools;');
8890   Add('  Arr2: TBool2;');
8891   Add('  Arr3: TBools = (true,false);');
8892   Add('  b: boolean;');
8893   Add('begin');
8894   Add('  b:=low(arr);');
8895   Add('  b:=high(arr);');
8896   Add('  arr[true]:=false;');
8897   Add('  arr[false]:=arr[b] or arr[true];');
8898   Add('  arr[b]:=true;');
8899   Add('  arr[arr[b]]:=arr[high(arr)];');
8900   Add('  b:=arr[false]=arr[true];');
8901   Add('  b:=low(arr2);');
8902   Add('  b:=high(arr2);');
8903   Add('  arr2[true]:=true;');
8904   Add('  arr2[true]:=arr2[true] and arr2[b];');
8905   Add('  arr2[b]:=false;');
8906   ConvertProgram;
8907   CheckSource('TestArray_StaticBool',
8908     LinesToStr([ // statements
8909     'this.Arr = rtl.arraySetLength(null,false,2);',
8910     'this.Arr2 = rtl.arraySetLength(null,false,1);',
8911     'this.Arr3 = [true, false];',
8912     'this.b = false;'
8913     ]),
8914     LinesToStr([ // $mod.$main
8915     '$mod.b = false;',
8916     '$mod.b = true;',
8917     '$mod.Arr[1] = false;',
8918     '$mod.Arr[0] = $mod.Arr[+$mod.b] || $mod.Arr[1];',
8919     '$mod.Arr[+$mod.b] = true;',
8920     '$mod.Arr[+$mod.Arr[+$mod.b]] = $mod.Arr[1];',
8921     '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
8922     '$mod.b = true;',
8923     '$mod.b = true;',
8924     '$mod.Arr2[0] = true;',
8925     '$mod.Arr2[0] = $mod.Arr2[0] && $mod.Arr2[1-$mod.b];',
8926     '$mod.Arr2[1-$mod.b] = false;',
8927     '']));
8928 end;
8929 
8930 procedure TTestModule.TestArray_StaticChar;
8931 begin
8932   StartProgram(false);
8933   Add([
8934   'type',
8935   '  TChars = array[char] of char;',
8936   '  TChars2 = array[''a''..''z''] of char;',
8937   'var',
8938   '  Arr: TChars;',
8939   '  Arr2: TChars2;',
8940   '  Arr3: array[2..4] of char = (''p'',''a'',''s'');',
8941   '  Arr4: array[11..13] of char = ''pas'';',
8942   '  Arr5: array[21..22] of char = ''äö'';',
8943   '  Arr6: array[31..32] of char = ''ä''+''ö'';',
8944   '  c: char;',
8945   '  b: boolean;',
8946   'begin',
8947   '  c:=low(arr);',
8948   '  c:=high(arr);',
8949   '  arr[''B'']:=''a'';',
8950   '  arr[''D'']:=arr[c];',
8951   '  arr[c]:=arr[''d''];',
8952   '  arr[arr[c]]:=arr[high(arr)];',
8953   '  b:=arr[low(arr)]=arr[''e''];',
8954   '  c:=low(arr2);',
8955   '  c:=high(arr2);',
8956   '  arr2[''b'']:=''f'';',
8957   '  arr2[''a'']:=arr2[c];',
8958   '  arr2[c]:=arr2[''g''];']);
8959   ConvertProgram;
8960   CheckSource('TestArray_StaticChar',
8961     LinesToStr([ // statements
8962     'this.Arr = rtl.arraySetLength(null, "", 65536);',
8963     'this.Arr2 = rtl.arraySetLength(null, "", 26);',
8964     'this.Arr3 = ["p", "a", "s"];',
8965     'this.Arr4 = ["p", "a", "s"];',
8966     'this.Arr5 = ["ä", "ö"];',
8967     'this.Arr6 = ["ä", "ö"];',
8968     'this.c = "";',
8969     'this.b = false;',
8970     '']),
8971     LinesToStr([ // $mod.$main
8972     '$mod.c = "\x00";',
8973     '$mod.c = "\uFFFF";',
8974     '$mod.Arr[66] = "a";',
8975     '$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
8976     '$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',
8977     '$mod.Arr[$mod.Arr[$mod.c.charCodeAt()].charCodeAt()] = $mod.Arr[65535];',
8978     '$mod.b = $mod.Arr[0] === $mod.Arr[101];',
8979     '$mod.c = "a";',
8980     '$mod.c = "z";',
8981     '$mod.Arr2[1] = "f";',
8982     '$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt() - 97];',
8983     '$mod.Arr2[$mod.c.charCodeAt() - 97] = $mod.Arr2[6];',
8984     '']));
8985 end;
8986 
8987 procedure TTestModule.TestArray_StaticMultiDim;
8988 begin
8989   StartProgram(false);
8990   Add([
8991   'type',
8992   '  TArrayInt = array[1..3] of longint;',
8993   '  TArrayArrayInt = array[5..6] of TArrayInt;',
8994   'var',
8995   '  Arr: TArrayInt;',
8996   '  Arr2: TArrayArrayInt;',
8997   '  Arr3: array[boolean] of TArrayInt = ((11,12,13),(21,22,23));',
8998   '  i: longint;',
8999   'begin',
9000   '  i:=low(arr);',
9001   '  i:=low(arr2);',
9002   '  i:=low(arr2[5]);',
9003   '  i:=high(arr);',
9004   '  i:=high(arr2);',
9005   '  i:=high(arr2[6]);',
9006   '  arr2[5]:=arr;',
9007   '  arr2[6][2]:=i;',
9008   '  i:=arr2[6][3];',
9009   '  arr2[6,3]:=i;',
9010   '  i:=arr2[5,2];',
9011   '  arr2:=arr2;',// clone multi dim static array
9012   //'  arr3:=arr3;',// clone anonymous multi dim static array
9013   '']);
9014   ConvertProgram;
9015   CheckSource('TestArray_StaticMultiDim',
9016     LinesToStr([ // statements
9017     'this.TArrayArrayInt$clone = function (a) {',
9018     '  var r = [];',
9019     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
9020     '  return r;',
9021     '};',
9022     'this.Arr = rtl.arraySetLength(null, 0, 3);',
9023     'this.Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
9024     'this.Arr3 = [[11, 12, 13], [21, 22, 23]];',
9025     'this.i = 0;'
9026     ]),
9027     LinesToStr([ // $mod.$main
9028     '$mod.i = 1;',
9029     '$mod.i = 5;',
9030     '$mod.i = 1;',
9031     '$mod.i = 3;',
9032     '$mod.i = 6;',
9033     '$mod.i = 3;',
9034     '$mod.Arr2[0] = $mod.Arr.slice(0);',
9035     '$mod.Arr2[1][1] = $mod.i;',
9036     '$mod.i = $mod.Arr2[1][2];',
9037     '$mod.Arr2[1][2] = $mod.i;',
9038     '$mod.i = $mod.Arr2[0][1];',
9039     '$mod.Arr2 = $mod.TArrayArrayInt$clone($mod.Arr2);',
9040     '']));
9041 end;
9042 
9043 procedure TTestModule.TestArray_StaticInFunction;
9044 begin
9045   StartProgram(false);
9046   Add([
9047   'const TArrayInt = 3;',
9048   'const TArrayArrayInt = 4;',
9049   'procedure DoIt;',
9050   'type',
9051   '  TArrayInt = array[1..3] of longint;',
9052   '  TArrayArrayInt = array[5..6] of TArrayInt;',
9053   'var',
9054   '  Arr: TArrayInt;',
9055   '  Arr2: TArrayArrayInt;',
9056   '  Arr3: array[boolean] of TArrayInt = ((11,12,13),(21,22,23));',
9057   '  i: longint;',
9058   'begin',
9059   '  arr2[5]:=arr;',
9060   '  arr2:=arr2;',// clone multi dim static array
9061   'end;',
9062   'begin',
9063   '']);
9064   ConvertProgram;
9065   CheckSource('TestArray_StaticInFunction',
9066     LinesToStr([ // statements
9067     'this.TArrayInt = 3;',
9068     'this.TArrayArrayInt = 4;',
9069     'var TArrayArrayInt$1$clone = function (a) {',
9070     '  var r = [];',
9071     '  for (var i = 0; i < 2; i++) r.push(a[i].slice(0));',
9072     '  return r;',
9073     '};',
9074     'this.DoIt = function () {',
9075     '  var Arr = rtl.arraySetLength(null, 0, 3);',
9076     '  var Arr2 = rtl.arraySetLength(null, 0, 2, 3);',
9077     '  var Arr3 = [[11, 12, 13], [21, 22, 23]];',
9078     '  var i = 0;',
9079     '  Arr2[0] = Arr.slice(0);',
9080     '  Arr2 = TArrayArrayInt$1$clone(Arr2);',
9081     '};',
9082     '']),
9083     LinesToStr([ // $mod.$main
9084     '']));
9085 end;
9086 
9087 procedure TTestModule.TestArray_StaticMultiDimEqualNotImplemented;
9088 begin
9089   StartProgram(false);
9090   Add([
9091   'type',
9092   '  TArrayInt = array[1..3,1..2] of longint;',
9093   'var',
9094   '  a,b: TArrayInt;',
9095   'begin',
9096   '  if a=b then ;',
9097   '']);
9098   SetExpectedPasResolverError('compare static array is not supported',
9099     nXIsNotSupported);
9100   ConvertProgram;
9101 end;
9102 
9103 procedure TTestModule.TestArrayOfRecord;
9104 begin
9105   StartProgram(false);
9106   Add([
9107   'type',
9108   '  TRec = record',
9109   '    Int: longint;',
9110   '  end;',
9111   '  TArrayRec = array of TRec;',
9112   'procedure DoIt(vd: TRec; const vc: TRec; var vv: TRec);',
9113   'begin',
9114   'end;',
9115   'var',
9116   '  Arr: TArrayRec;',
9117   '  r: TRec;',
9118   '  i: longint;',
9119   'begin',
9120   '  SetLength(arr,3);',
9121   '  arr[0].int:=4;',
9122   '  arr[1].int:=length(arr)+arr[2].int;',
9123   '  arr[arr[i].int].int:=arr[5].int;',
9124   '  arr[7]:=r;',
9125   '  r:=arr[8];',
9126   '  i:=low(arr);',
9127   '  i:=high(arr);',
9128   '  DoIt(Arr[9],Arr[10],Arr[11]);']);
9129   ConvertProgram;
9130   CheckSource('TestArrayOfRecord',
9131     LinesToStr([ // statements
9132     'rtl.recNewT($mod, "TRec", function () {',
9133     '  this.Int = 0;',
9134     '  this.$eq = function (b) {',
9135     '    return this.Int === b.Int;',
9136     '  };',
9137     '  this.$assign = function (s) {',
9138     '    this.Int = s.Int;',
9139     '    return this;',
9140     '  };',
9141     '});',
9142     'this.DoIt = function (vd, vc, vv) {',
9143     '};',
9144     'this.Arr = [];',
9145     'this.r = $mod.TRec.$new();',
9146     'this.i = 0;'
9147     ]),
9148     LinesToStr([ // $mod.$main
9149     '$mod.Arr = rtl.arraySetLength($mod.Arr,$mod.TRec,3);',
9150     '$mod.Arr[0].Int = 4;',
9151     '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
9152     '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
9153     '$mod.Arr[7].$assign($mod.r);',
9154     '$mod.r.$assign($mod.Arr[8]);',
9155     '$mod.i = 0;',
9156     '$mod.i = rtl.length($mod.Arr)-1;',
9157     '$mod.DoIt($mod.TRec.$clone($mod.Arr[9]), $mod.Arr[10], $mod.Arr[11]);',
9158     '']));
9159 end;
9160 
9161 procedure TTestModule.TestArray_StaticRecord;
9162 begin
9163   StartProgram(false);
9164   Add([
9165   'type',
9166   '  TRec = record',
9167   '    Int: longint;',
9168   '  end;',
9169   '  TArrayRec = array[1..2] of TRec;',
9170   'var',
9171   '  Arr: TArrayRec;',
9172   'begin',
9173   '  arr[1].int:=length(arr)+low(arr)+high(arr);',
9174   '']);
9175   ConvertProgram;
9176   CheckSource('TestArray_StaticRecord',
9177     LinesToStr([ // statements
9178     'rtl.recNewT($mod, "TRec", function () {',
9179     '  this.Int = 0;',
9180     '  this.$eq = function (b) {',
9181     '    return this.Int === b.Int;',
9182     '  };',
9183     '  this.$assign = function (s) {',
9184     '    this.Int = s.Int;',
9185     '    return this;',
9186     '  };',
9187     '});',
9188     'this.TArrayRec$clone = function (a) {',
9189     '  var r = [];',
9190     '  for (var i = 0; i < 2; i++) r.push($mod.TRec.$clone(a[i]));',
9191     '  return r;',
9192     '};',
9193     'this.Arr = rtl.arraySetLength(null, $mod.TRec, 2);',
9194     '']),
9195     LinesToStr([ // $mod.$main
9196     '$mod.Arr[0].Int = 2 + 1 + 2;']));
9197 end;
9198 
9199 procedure TTestModule.TestArrayOfSet;
9200 begin
9201   StartProgram(false);
9202   Add([
9203   'type',
9204   '  TFlag = (big,small);',
9205   '  TSetOfFlag = set of tflag;',
9206   '  TArrayFlag = array of TSetOfFlag;',
9207   'procedure DoIt(const a: Tarrayflag);',
9208   'begin',
9209   'end;',
9210   'var',
9211   '  f: TFlag;',
9212   '  s: TSetOfFlag;',
9213   '  Arr: TArrayFlag;',
9214   '  i: longint;',
9215   'begin',
9216   '  SetLength(arr,3);',
9217   '  arr[0]:=s;',
9218   '  arr[1]:=[big];',
9219   '  arr[2]:=[big]+s;',
9220   '  arr[3]:=s+[big];',
9221   '  arr[4]:=arr[5];',
9222   '  s:=arr[6];',
9223   '  i:=low(arr);',
9224   '  i:=high(arr);',
9225   '  DoIt(arr);',
9226   '  DoIt([s]);',
9227   '  DoIt([[],s]);',
9228   '  DoIt([s,[]]);',
9229   '']);
9230   ConvertProgram;
9231   CheckSource('TestArrayOfSet',
9232     LinesToStr([ // statements
9233     'this.TFlag = {',
9234     '  "0": "big",',
9235     '  big: 0,',
9236     '  "1": "small",',
9237     '  small: 1',
9238     '};',
9239     'this.DoIt = function (a) {',
9240     '};',
9241     'this.f = 0;',
9242     'this.s = {};',
9243     'this.Arr = [];',
9244     'this.i = 0;',
9245     '']),
9246     LinesToStr([ // $mod.$main
9247     '$mod.Arr = rtl.arraySetLength($mod.Arr, {}, 3);',
9248     '$mod.Arr[0] = rtl.refSet($mod.s);',
9249     '$mod.Arr[1] = rtl.createSet($mod.TFlag.big);',
9250     '$mod.Arr[2] = rtl.unionSet(rtl.createSet($mod.TFlag.big), $mod.s);',
9251     '$mod.Arr[3] = rtl.unionSet($mod.s, rtl.createSet($mod.TFlag.big));',
9252     '$mod.Arr[4] = rtl.refSet($mod.Arr[5]);',
9253     '$mod.s = rtl.refSet($mod.Arr[6]);',
9254     '$mod.i = 0;',
9255     '$mod.i = rtl.length($mod.Arr) - 1;',
9256     '$mod.DoIt($mod.Arr);',
9257     '$mod.DoIt([rtl.refSet($mod.s)]);',
9258     '$mod.DoIt([{}, rtl.refSet($mod.s)]);',
9259     '$mod.DoIt([rtl.refSet($mod.s), {}]);',
9260     '']));
9261 end;
9262 
9263 procedure TTestModule.TestArray_DynAsParam;
9264 begin
9265   StartProgram(false);
9266   Add([
9267   'type integer = longint;',
9268   'type TArrInt = array of integer;',
9269   'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
9270   'var vJ: TArrInt;',
9271   'begin',
9272   '  vg:=vg;',
9273   '  vj:=vh;',
9274   '  vi:=vi;',
9275   '  doit(vg,vg,vg);',
9276   '  doit(vh,vh,vj);',
9277   '  doit(vi,vi,vi);',
9278   '  doit(vj,vj,vj);',
9279   'end;',
9280   'var i: TArrInt;',
9281   'begin',
9282   '  doit(i,i,i);']);
9283   ConvertProgram;
9284   CheckSource('TestArray_DynAsParams',
9285     LinesToStr([ // statements
9286     'this.DoIt = function (vG,vH,vI) {',
9287     '  var vJ = [];',
9288     '  vG = rtl.arrayRef(vG);',
9289     '  vJ = rtl.arrayRef(vH);',
9290     '  vI.set(rtl.arrayRef(vI.get()));',
9291     '  $mod.DoIt(rtl.arrayRef(vG), vG, {',
9292     '    get: function () {',
9293     '      return vG;',
9294     '    },',
9295     '    set: function (v) {',
9296     '      vG = v;',
9297     '    }',
9298     '  });',
9299     '  $mod.DoIt(rtl.arrayRef(vH), vH, {',
9300     '    get: function () {',
9301     '      return vJ;',
9302     '    },',
9303     '    set: function (v) {',
9304     '      vJ = v;',
9305     '    }',
9306     '  });',
9307     '  $mod.DoIt(rtl.arrayRef(vI.get()), vI.get(), vI);',
9308     '  $mod.DoIt(rtl.arrayRef(vJ), vJ, {',
9309     '    get: function () {',
9310     '      return vJ;',
9311     '    },',
9312     '    set: function (v) {',
9313     '      vJ = v;',
9314     '    }',
9315     '  });',
9316     '};',
9317     'this.i = [];'
9318     ]),
9319     LinesToStr([
9320     '$mod.DoIt(rtl.arrayRef($mod.i),$mod.i,{',
9321     '  p: $mod,',
9322     '  get: function () {',
9323     '      return this.p.i;',
9324     '    },',
9325     '  set: function (v) {',
9326     '      this.p.i = v;',
9327     '    }',
9328     '});'
9329     ]));
9330 end;
9331 
9332 procedure TTestModule.TestArray_StaticAsParam;
9333 begin
9334   StartProgram(false);
9335   Add([
9336   'type integer = longint;',
9337   'type TArrInt = array[1..2] of integer;',
9338   'procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);',
9339   'var vJ: TArrInt;',
9340   'begin',
9341   '  vg:=vg;',
9342   '  vj:=vh;',
9343   '  vi:=vi;',
9344   '  doit(vg,vg,vg);',
9345   '  doit(vh,vh,vj);',
9346   '  doit(vi,vi,vi);',
9347   '  doit(vj,vj,vj);',
9348   'end;',
9349   'var i: TArrInt;',
9350   'begin',
9351   '  doit(i,i,i);']);
9352   ConvertProgram;
9353   CheckSource('TestArray_StaticAsParams',
9354     LinesToStr([ // statements
9355     'this.DoIt = function (vG,vH,vI) {',
9356     '  var vJ = rtl.arraySetLength(null, 0, 2);',
9357     '  vG = vG.slice(0);',
9358     '  vJ = vH.slice(0);',
9359     '  vI.set(vI.get().slice(0));',
9360     '  $mod.DoIt(vG.slice(0), vG, {',
9361     '    get: function () {',
9362     '      return vG;',
9363     '    },',
9364     '    set: function (v) {',
9365     '      vG = v;',
9366     '    }',
9367     '  });',
9368     '  $mod.DoIt(vH.slice(0), vH, {',
9369     '    get: function () {',
9370     '      return vJ;',
9371     '    },',
9372     '    set: function (v) {',
9373     '      vJ = v;',
9374     '    }',
9375     '  });',
9376     '  $mod.DoIt(vI.get().slice(0), vI.get(), vI);',
9377     '  $mod.DoIt(vJ.slice(0), vJ, {',
9378     '    get: function () {',
9379     '      return vJ;',
9380     '    },',
9381     '    set: function (v) {',
9382     '      vJ = v;',
9383     '    }',
9384     '  });',
9385     '};',
9386     'this.i = rtl.arraySetLength(null, 0, 2);'
9387     ]),
9388     LinesToStr([
9389     '$mod.DoIt($mod.i.slice(0),$mod.i,{',
9390     '  p: $mod,',
9391     '  get: function () {',
9392     '      return this.p.i;',
9393     '    },',
9394     '  set: function (v) {',
9395     '      this.p.i = v;',
9396     '    }',
9397     '});'
9398     ]));
9399 end;
9400 
9401 procedure TTestModule.TestArrayElement_AsParams;
9402 begin
9403   StartProgram(false);
9404   Add('type integer = longint;');
9405   Add('type TArrayInt = array of integer;');
9406   Add('procedure DoIt(vG: Integer; const vH: Integer; var vI: Integer);');
9407   Add('var vJ: tarrayint;');
9408   Add('begin');
9409   Add('  vi:=vi;');
9410   Add('  doit(vi,vi,vi);');
9411   Add('  doit(vj[1+1],vj[1+2],vj[1+3]);');
9412   Add('end;');
9413   Add('var a: TArrayInt;');
9414   Add('begin');
9415   Add('  doit(a[1+4],a[1+5],a[1+6]);');
9416   ConvertProgram;
9417   CheckSource('TestArrayElement_AsParams',
9418     LinesToStr([ // statements
9419     'this.DoIt = function (vG,vH,vI) {',
9420     '  var vJ = [];',
9421     '  vI.set(vI.get());',
9422     '  $mod.DoIt(vI.get(), vI.get(), vI);',
9423     '  $mod.DoIt(vJ[1+1], vJ[1+2], {',
9424     '    a:1+3,',
9425     '    p:vJ,',
9426     '    get: function () {',
9427     '      return this.p[this.a];',
9428     '    },',
9429     '    set: function (v) {',
9430     '      this.p[this.a] = v;',
9431     '    }',
9432     '  });',
9433     '};',
9434     'this.a = [];'
9435     ]),
9436     LinesToStr([
9437     '$mod.DoIt($mod.a[1+4],$mod.a[1+5],{',
9438     '  a: 1+6,',
9439     '  p: $mod.a,',
9440     '  get: function () {',
9441     '      return this.p[this.a];',
9442     '    },',
9443     '  set: function (v) {',
9444     '      this.p[this.a] = v;',
9445     '    }',
9446     '});'
9447     ]));
9448 end;
9449 
9450 procedure TTestModule.TestArrayElementFromFuncResult_AsParams;
9451 begin
9452   StartProgram(false);
9453   Add('type Integer = longint;');
9454   Add('type TArrayInt = array of integer;');
9455   Add('function GetArr(vB: integer = 0): tarrayint;');
9456   Add('begin');
9457   Add('end;');
9458   Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
9459   Add('begin');
9460   Add('end;');
9461   Add('begin');
9462   Add('  doit(getarr[1+1],getarr[1+2],getarr[1+3]);');
9463   Add('  doit(getarr()[2+1],getarr()[2+2],getarr()[2+3]);');
9464   Add('  doit(getarr(7)[3+1],getarr(8)[3+2],getarr(9)[3+3]);');
9465   ConvertProgram;
9466   CheckSource('TestArrayElementFromFuncResult_AsParams',
9467     LinesToStr([ // statements
9468     'this.GetArr = function (vB) {',
9469     '  var Result = [];',
9470     '  return Result;',
9471     '};',
9472     'this.DoIt = function (vG,vH,vI) {',
9473     '};'
9474     ]),
9475     LinesToStr([
9476     '$mod.DoIt($mod.GetArr(0)[1+1],$mod.GetArr(0)[1+2],{',
9477     '  a: 1+3,',
9478     '  p: $mod.GetArr(0),',
9479     '  get: function () {',
9480     '      return this.p[this.a];',
9481     '    },',
9482     '  set: function (v) {',
9483     '      this.p[this.a] = v;',
9484     '    }',
9485     '});',
9486     '$mod.DoIt($mod.GetArr(0)[2+1],$mod.GetArr(0)[2+2],{',
9487     '  a: 2+3,',
9488     '  p: $mod.GetArr(0),',
9489     '  get: function () {',
9490     '      return this.p[this.a];',
9491     '    },',
9492     '  set: function (v) {',
9493     '      this.p[this.a] = v;',
9494     '    }',
9495     '});',
9496     '$mod.DoIt($mod.GetArr(7)[3+1],$mod.GetArr(8)[3+2],{',
9497     '  a: 3+3,',
9498     '  p: $mod.GetArr(9),',
9499     '  get: function () {',
9500     '      return this.p[this.a];',
9501     '    },',
9502     '  set: function (v) {',
9503     '      this.p[this.a] = v;',
9504     '    }',
9505     '});',
9506     '']));
9507 end;
9508 
9509 procedure TTestModule.TestArrayEnumTypeRange;
9510 begin
9511   StartProgram(false);
9512   Add([
9513   'type',
9514   '  TEnum = (red,blue);',
9515   '  TEnumArray = array[TEnum] of longint;',
9516   'var',
9517   '  e: TEnum;',
9518   '  i: longint;',
9519   '  a: TEnumArray;',
9520   '  numbers: TEnumArray = (1,2);',
9521   '  names: array[TEnum] of string = (''red'',''blue'');',
9522   'begin',
9523   '  e:=low(a);',
9524   '  e:=high(a);',
9525   '  i:=a[red];',
9526   '  a[e]:=a[e];']);
9527   ConvertProgram;
9528   CheckSource('TestArrayEnumTypeRange',
9529     LinesToStr([ // statements
9530     '  this.TEnum = {',
9531     '  "0": "red",',
9532     '  red: 0,',
9533     '  "1": "blue",',
9534     '  blue: 1',
9535     '};',
9536     'this.e = 0;',
9537     'this.i = 0;',
9538     'this.a = rtl.arraySetLength(null,0,2);',
9539     'this.numbers = [1, 2];',
9540     'this.names = ["red", "blue"];',
9541     '']),
9542     LinesToStr([ // $mod.$main
9543     '$mod.e = $mod.TEnum.red;',
9544     '$mod.e = $mod.TEnum.blue;',
9545     '$mod.i = $mod.a[$mod.TEnum.red];',
9546     '$mod.a[$mod.e] = $mod.a[$mod.e];',
9547     '']));
9548 end;
9549 
9550 procedure TTestModule.TestArray_SetLengthOutArg;
9551 begin
9552   StartProgram(false);
9553   Add([
9554   'type TArrInt = array of longint;',
9555   'procedure DoIt(out a: TArrInt);',
9556   'begin',
9557   '  SetLength(a,2);',
9558   'end;',
9559   'begin',
9560   '']);
9561   ConvertProgram;
9562   CheckSource('TestArray_SetLengthOutArg',
9563     LinesToStr([ // statements
9564     'this.DoIt = function (a) {',
9565     '  a.set(rtl.arraySetLength(a.get(), 0, 2));',
9566     '};',
9567     '']),
9568     LinesToStr([
9569     '']));
9570 end;
9571 
9572 procedure TTestModule.TestArray_SetLengthProperty;
9573 begin
9574   StartProgram(false);
9575   Add('type');
9576   Add('  TArrInt = array of longint;');
9577   Add('  TObject = class');
9578   Add('    function GetColors: TArrInt; external name ''GetColors'';');
9579   Add('    procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
9580   Add('    property Colors: TArrInt read GetColors write SetColors;');
9581   Add('  end;');
9582   Add('var Obj: TObject;');
9583   Add('begin');
9584   Add('  SetLength(Obj.Colors,2);');
9585   ConvertProgram;
9586   CheckSource('TestArray_SetLengthProperty',
9587     LinesToStr([ // statements
9588     'rtl.createClass($mod, "TObject", null, function () {',
9589     '  this.$init = function () {',
9590     '  };',
9591     '  this.$final = function () {',
9592     '  };',
9593     '});',
9594     'this.Obj = null;',
9595     '']),
9596     LinesToStr([
9597     '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 0, 2));',
9598     '']));
9599 end;
9600 
9601 procedure TTestModule.TestArray_SetLengthMultiDim;
9602 begin
9603   StartProgram(false);
9604   Add([
9605   'type',
9606   '  TArrArrInt = array of array of longint;',
9607   '  TArrStaInt = array of array[1..2] of longint;',
9608   'var',
9609   '  a: TArrArrInt;',
9610   '  b: TArrStaInt;',
9611   'begin',
9612   '  SetLength(a,2);',
9613   '  SetLength(a,3,4);',
9614   '  SetLength(b,5);',
9615   '']);
9616   ConvertProgram;
9617   CheckSource('TestArray_SetLengthMultiDim',
9618     LinesToStr([ // statements
9619     'this.a = [];',
9620     'this.b = [];',
9621     '']),
9622     LinesToStr([
9623     '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
9624     '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
9625     '$mod.b = rtl.arraySetLength($mod.b, 0, 5, "s", 2);',
9626     '']));
9627 end;
9628 
9629 procedure TTestModule.TestArray_SetLengthDynOfStatic;
9630 begin
9631   StartProgram(false);
9632   Add([
9633   'type',
9634   '  TStaArr1 = array[1..3] of boolean;',
9635   //'  TStaArr2 = array[5..6] of TStaArr1;',
9636   '  TDynArr1StaArr1 = array of TStaArr1;',
9637   //'  TDynArr1StaArr2 = array of TStaArr2;',
9638   '  TDynArr2StaArr1 = array of TDynArr1StaArr1;',
9639   //'  TDynArr2StaArr2 = array of TDynArr1StaArr2;',
9640   'var',
9641   '  DynArr1StaArr1: TDynArr1StaArr1;',
9642   //'  DynArr1StaArr2: TDynArr1StaArr1;',
9643   '  DynArr2StaArr1: TDynArr2StaArr1;',
9644   //'  DynArr2StaArr2: TDynArr2StaArr2;',
9645   'begin',
9646   '  SetLength(DynArr1StaArr1,11);',
9647   '  SetLength(DynArr2StaArr1,12);',
9648   '  SetLength(DynArr2StaArr1[13],14);',
9649   '  SetLength(DynArr2StaArr1,15,16);',
9650   //'  SetLength(DynArr1StaArr2,21);',
9651   //'  SetLength(DynArr2StaArr2,22);',
9652   //'  SetLength(DynArr2StaArr2[23],24);',
9653   //'  SetLength(DynArr2StaArr2,25,26);',
9654   '']);
9655   ConvertProgram;
9656   CheckSource('TestArray_DynOfStatic',
9657     LinesToStr([ // statements
9658     'this.DynArr1StaArr1 = [];',
9659     'this.DynArr2StaArr1 = [];',
9660     '']),
9661     LinesToStr([ // $mod.$main
9662     '$mod.DynArr1StaArr1 = rtl.arraySetLength($mod.DynArr1StaArr1, false, 11, "s", 3);',
9663     '$mod.DynArr2StaArr1 = rtl.arraySetLength($mod.DynArr2StaArr1, [], 12);',
9664     '$mod.DynArr2StaArr1[13] = rtl.arraySetLength($mod.DynArr2StaArr1[13], false, 14, "s", 3);',
9665     '$mod.DynArr2StaArr1 = rtl.arraySetLength(',
9666     '  $mod.DynArr2StaArr1,',
9667     '  false,',
9668     '  15,',
9669     '  16,',
9670     '  "s",',
9671     '  3',
9672     ');',
9673     '']));
9674 end;
9675 
9676 procedure TTestModule.TestArray_OpenArrayOfString;
9677 begin
9678   StartProgram(false);
9679   Add('procedure DoIt(const a: array of String);');
9680   Add('var');
9681   Add('  i: longint;');
9682   Add('  s: string;');
9683   Add('begin');
9684   Add('  for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
9685   Add('end;');
9686   Add('var s: string;');
9687   Add('begin');
9688   Add('  DoIt([]);');
9689   Add('  DoIt([s,''foo'','''',s+s]);');
9690   ConvertProgram;
9691   CheckSource('TestArray_OpenArrayOfString',
9692     LinesToStr([ // statements
9693     'this.DoIt = function (a) {',
9694     '  var i = 0;',
9695     '  var s = "";',
9696     '  for (var $l = 0, $end = rtl.length(a) - 1; $l <= $end; $l++) {',
9697     '    i = $l;',
9698     '    s = a[rtl.length(a) - i - 1];',
9699     '  };',
9700     '};',
9701     'this.s = "";',
9702     '']),
9703     LinesToStr([
9704     '$mod.DoIt([]);',
9705     '$mod.DoIt([$mod.s, "foo", "", $mod.s + $mod.s]);',
9706     '']));
9707 end;
9708 
9709 procedure TTestModule.TestArray_ArrayOfCharAssignString;
9710 begin
9711   StartProgram(false);
9712   Add([
9713   'type TArr = array of char;',
9714   'var',
9715   '  c: char;',
9716   '  s: string;',
9717   '  a: TArr;',
9718   'procedure Run(const a: array of char);',
9719   'begin',
9720   '  Run(c);',
9721   '  Run(s);',
9722   'end;',
9723   'begin',
9724   '  a:=c;',
9725   '  a:=s;',
9726   '  a:=#13;',
9727   '  a:=''Foo'';',
9728   '  Run(c);',
9729   '  Run(s);',
9730   '']);
9731   ConvertProgram;
9732   CheckSource('TestArray_ArrayOfCharAssignString',
9733     LinesToStr([ // statements
9734     'this.c = "";',
9735     'this.s = "";',
9736     'this.a = [];',
9737     'this.Run = function (a) {',
9738     '  $mod.Run($mod.c.split(""));',
9739     '  $mod.Run($mod.s.split(""));',
9740     '};',
9741     '']),
9742     LinesToStr([
9743     '$mod.a = $mod.c.split("");',
9744     '$mod.a = $mod.s.split("");',
9745     '$mod.a = "\r".split("");',
9746     '$mod.a = "Foo".split("");',
9747     '$mod.Run($mod.c.split(""));',
9748     '$mod.Run($mod.s.split(""));',
9749     '']));
9750 end;
9751 
9752 procedure TTestModule.TestArray_ConstRef;
9753 begin
9754   StartProgram(false);
9755   Add([
9756   'type TArr = array of word;',
9757   'procedure Run(constref a: TArr);',
9758   'begin',
9759   'end;',
9760   'procedure Fly(a: TArr; var b: TArr; out c: TArr; const d: TArr; constref e: TArr);',
9761   'var l: TArr;',
9762   'begin',
9763   '  Run(l);',
9764   '  Run(a);',
9765   '  Run(b);',
9766   '  Run(c);',
9767   '  Run(d);',
9768   '  Run(e);',
9769   'end;',
9770   'begin',
9771   '']);
9772   ConvertProgram;
9773   CheckResolverUnexpectedHints();
9774   CheckSource('TestArray_ConstRef',
9775     LinesToStr([ // statements
9776     'this.Run = function (a) {',
9777     '};',
9778     'this.Fly = function (a, b, c, d, e) {',
9779     '  var l = [];',
9780     '  $mod.Run(l);',
9781     '  $mod.Run(a);',
9782     '  $mod.Run(b.get());',
9783     '  $mod.Run(c.get());',
9784     '  $mod.Run(d);',
9785     '  $mod.Run(e);',
9786     '};',
9787     '']),
9788     LinesToStr([
9789     '']));
9790 end;
9791 
9792 procedure TTestModule.TestArray_Concat;
9793 begin
9794   StartProgram(false);
9795   Add([
9796   'type',
9797   '  integer = longint;',
9798   '  TFlag = (big,small);',
9799   '  TFlags = set of TFlag;',
9800   '  TRec = record',
9801   '    i: integer;',
9802   '  end;',
9803   '  TArrInt = array of integer;',
9804   '  TArrRec = array of TRec;',
9805   '  TArrFlag = array of TFlag;',
9806   '  TArrSet = array of TFlags;',
9807   '  TArrJSValue = array of jsvalue;',
9808   'var',
9809   '  ArrInt: tarrint;',
9810   '  ArrRec: tarrrec;',
9811   '  ArrFlag: tarrflag;',
9812   '  ArrSet: tarrset;',
9813   '  ArrJSValue: tarrjsvalue;',
9814   'begin',
9815   '  arrint:=concat(arrint);',
9816   '  arrint:=concat(arrint,arrint);',
9817   '  arrint:=concat(arrint,arrint,arrint);',
9818   '  arrrec:=concat(arrrec);',
9819   '  arrrec:=concat(arrrec,arrrec);',
9820   '  arrrec:=concat(arrrec,arrrec,arrrec);',
9821   '  arrset:=concat(arrset);',
9822   '  arrset:=concat(arrset,arrset);',
9823   '  arrset:=concat(arrset,arrset,arrset);',
9824   '  arrjsvalue:=concat(arrjsvalue);',
9825   '  arrjsvalue:=concat(arrjsvalue,arrjsvalue);',
9826   '  arrjsvalue:=concat(arrjsvalue,arrjsvalue,arrjsvalue);',
9827   '  arrint:=concat([1],arrint);',
9828   '  arrflag:=concat([big]);',
9829   '  arrflag:=concat([big],arrflag);',
9830   '  arrflag:=concat(arrflag,[small]);',
9831   '']);
9832   ConvertProgram;
9833   CheckSource('TestArray_Concat',
9834     LinesToStr([ // statements
9835     'this.TFlag = {',
9836     '  "0": "big",',
9837     '  big: 0,',
9838     '  "1": "small",',
9839     '  small: 1',
9840     '};',
9841     'rtl.recNewT($mod, "TRec", function () {',
9842     '  this.i = 0;',
9843     '  this.$eq = function (b) {',
9844     '    return this.i === b.i;',
9845     '  };',
9846     '  this.$assign = function (s) {',
9847     '    this.i = s.i;',
9848     '    return this;',
9849     '  };',
9850     '});',
9851     'this.ArrInt = [];',
9852     'this.ArrRec = [];',
9853     'this.ArrFlag = [];',
9854     'this.ArrSet = [];',
9855     'this.ArrJSValue = [];',
9856     '']),
9857     LinesToStr([ // $mod.$main
9858     '$mod.ArrInt = $mod.ArrInt;',
9859     '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt);',
9860     '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt, $mod.ArrInt);',
9861     '$mod.ArrRec = $mod.ArrRec;',
9862     '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
9863     '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec, $mod.ArrRec);',
9864     '$mod.ArrSet = $mod.ArrSet;',
9865     '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
9866     '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet, $mod.ArrSet);',
9867     '$mod.ArrJSValue = $mod.ArrJSValue;',
9868     '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue);',
9869     '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue, $mod.ArrJSValue);',
9870     '$mod.ArrInt = rtl.arrayConcatN([1], $mod.ArrInt);',
9871     '$mod.ArrFlag = [$mod.TFlag.big];',
9872     '$mod.ArrFlag = rtl.arrayConcatN([$mod.TFlag.big], $mod.ArrFlag);',
9873     '$mod.ArrFlag = rtl.arrayConcatN($mod.ArrFlag, [$mod.TFlag.small]);',
9874     '']));
9875 end;
9876 
9877 procedure TTestModule.TestArray_Copy;
9878 begin
9879   StartProgram(false);
9880   Add([
9881   'type',
9882   '  integer = longint;',
9883   '  TFlag = (big,small);',
9884   '  TFlags = set of TFlag;',
9885   '  TRec = record',
9886   '    i: integer;',
9887   '  end;',
9888   '  TArrInt = array of integer;',
9889   '  TArrRec = array of TRec;',
9890   '  TArrSet = array of TFlags;',
9891   '  TArrJSValue = array of jsvalue;',
9892   'var',
9893   '  ArrInt: tarrint;',
9894   '  ArrRec: tarrrec;',
9895   '  ArrSet: tarrset;',
9896   '  ArrJSValue: tarrjsvalue;',
9897   'begin',
9898   '  arrint:=copy(arrint);',
9899   '  arrint:=copy(arrint,2);',
9900   '  arrint:=copy(arrint,3,4);',
9901   '  arrint:=copy([1,1],1,2);',
9902   '  arrrec:=copy(arrrec);',
9903   '  arrrec:=copy(arrrec,5);',
9904   '  arrrec:=copy(arrrec,6,7);',
9905   '  arrset:=copy(arrset);',
9906   '  arrset:=copy(arrset,8);',
9907   '  arrset:=copy(arrset,9,10);',
9908   '  arrjsvalue:=copy(arrjsvalue);',
9909   '  arrjsvalue:=copy(arrjsvalue,11);',
9910   '  arrjsvalue:=copy(arrjsvalue,12,13);',
9911   '  ']);
9912   ConvertProgram;
9913   CheckSource('TestArray_Copy',
9914     LinesToStr([ // statements
9915     'this.TFlag = {',
9916     '  "0": "big",',
9917     '  big: 0,',
9918     '  "1": "small",',
9919     '  small: 1',
9920     '};',
9921     'rtl.recNewT($mod, "TRec", function () {',
9922     '  this.i = 0;',
9923     '  this.$eq = function (b) {',
9924     '    return this.i === b.i;',
9925     '  };',
9926     '  this.$assign = function (s) {',
9927     '    this.i = s.i;',
9928     '    return this;',
9929     '  };',
9930     '});',
9931     'this.ArrInt = [];',
9932     'this.ArrRec = [];',
9933     'this.ArrSet = [];',
9934     'this.ArrJSValue = [];',
9935     '']),
9936     LinesToStr([ // $mod.$main
9937     '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 0);',
9938     '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 2);',
9939     '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 3, 4);',
9940     '$mod.ArrInt = rtl.arrayCopy(0, [1, 1], 1, 2);',
9941     '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 0);',
9942     '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 5);',
9943     '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 6, 7);',
9944     '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 0);',
9945     '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 8);',
9946     '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 9, 10);',
9947     '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 0);',
9948     '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 11);',
9949     '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 12, 13);',
9950     '']));
9951 end;
9952 
9953 procedure TTestModule.TestArray_InsertDelete;
9954 begin
9955   StartProgram(false);
9956   Add([
9957   'type',
9958   '  integer = longint;',
9959   '  TFlag = (big,small);',
9960   '  TFlags = set of TFlag;',
9961   '  TRec = record',
9962   '    i: integer;',
9963   '  end;',
9964   '  TArrInt = array of integer;',
9965   '  TArrRec = array of TRec;',
9966   '  TArrSet = array of TFlags;',
9967   '  TArrJSValue = array of jsvalue;',
9968   '  TArrArrInt = array of TArrInt;',
9969   'var',
9970   '  ArrInt: tarrint;',
9971   '  ArrRec: tarrrec;',
9972   '  ArrSet: tarrset;',
9973   '  ArrJSValue: tarrjsvalue;',
9974   '  ArrArrInt: TArrArrInt;',
9975   'begin',
9976   '  Insert(1,arrint,2);',
9977   '  Insert(arrint[3],arrint,4);',
9978   '  Insert(arrrec[5],arrrec,6);',
9979   '  Insert(arrset[7],arrset,7);',
9980   '  Insert(arrjsvalue[8],arrjsvalue,9);',
9981   '  Insert(10,arrjsvalue,11);',
9982   '  Insert([23],arrarrint,22);',
9983   '  Delete(arrint,12,13);',
9984   '  Delete(arrrec,14,15);',
9985   '  Delete(arrset,17,18);',
9986   '  Delete(arrjsvalue,19,10);']);
9987   ConvertProgram;
9988   CheckSource('TestArray_InsertDelete',
9989     LinesToStr([ // statements
9990     'this.TFlag = {',
9991     '  "0": "big",',
9992     '  big: 0,',
9993     '  "1": "small",',
9994     '  small: 1',
9995     '};',
9996     'rtl.recNewT($mod, "TRec", function () {',
9997     '  this.i = 0;',
9998     '  this.$eq = function (b) {',
9999     '    return this.i === b.i;',
10000     '  };',
10001     '  this.$assign = function (s) {',
10002     '    this.i = s.i;',
10003     '    return this;',
10004     '  };',
10005     '});',
10006     'this.ArrInt = [];',
10007     'this.ArrRec = [];',
10008     'this.ArrSet = [];',
10009     'this.ArrJSValue = [];',
10010     'this.ArrArrInt = [];',
10011     '']),
10012     LinesToStr([ // $mod.$main
10013     '$mod.ArrInt.splice(2, 0, 1);',
10014     '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);',
10015     '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);',
10016     '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);',
10017     '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);',
10018     '$mod.ArrJSValue.splice(11, 0, 10);',
10019     '$mod.ArrArrInt.splice(22, 0, [23]);',
10020     '$mod.ArrInt.splice(12, 13);',
10021     '$mod.ArrRec.splice(14, 15);',
10022     '$mod.ArrSet.splice(17, 18);',
10023     '$mod.ArrJSValue.splice(19, 10);',
10024     '']));
10025 end;
10026 
10027 procedure TTestModule.TestArray_DynArrayConstObjFPC;
10028 begin
10029   StartProgram(false);
10030   Add([
10031   '{$modeswitch arrayoperators}',
10032   'type',
10033   '  integer = longint;',
10034   '  TArrInt = array of integer;',
10035   '  TArrStr = array of string;',
10036   'const',
10037   '  Ints: TArrInt = (1,2,3);',
10038   '  Aliases: TarrStr = (''foo'',''b'');',
10039   '  OneInt: TArrInt = (7);',
10040   '  OneStr: array of integer = (7);',
10041   '  Chars: array of char = ''aoc'';',
10042   '  Names: array of string = (''a'',''foo'');',
10043   '  NameCount = low(Names)+high(Names)+length(Names);',
10044   'var i: integer;',
10045   'begin',
10046   '  Ints:=[];',
10047   '  Ints:=[1,1];',
10048   '  Ints:=[1]+[2];',
10049   '  Ints:=[2];',
10050   '  Ints:=[]+ints;',
10051   '  Ints:=Ints+[];',
10052   '  Ints:=Ints+OneInt;',
10053   '  Ints:=Ints+[1,1];',
10054   '  Ints:=[i,i]+Ints;',
10055   '  Ints:=[1]+[i]+[3];',
10056   '']);
10057   ConvertProgram;
10058   CheckSource('TestArray_DynArrayConstObjFPC',
10059     LinesToStr([ // statements
10060     'this.Ints = [1, 2, 3];',
10061     'this.Aliases = ["foo", "b"];',
10062     'this.OneInt = [7];',
10063     'this.OneStr = [7];',
10064     'this.Chars = ["a", "o", "c"];',
10065     'this.Names = ["a", "foo"];',
10066     'this.NameCount = 0 + (rtl.length($mod.Names) - 1) + rtl.length($mod.Names);',
10067     'this.i = 0;',
10068     '']),
10069     LinesToStr([ // $mod.$main
10070     '$mod.Ints = [];',
10071     '$mod.Ints = [1, 1];',
10072     '$mod.Ints = rtl.arrayConcatN([1], [2]);',
10073     '$mod.Ints = [2];',
10074     '$mod.Ints = rtl.arrayConcatN([], $mod.Ints);',
10075     '$mod.Ints = rtl.arrayConcatN($mod.Ints, []);',
10076     '$mod.Ints = rtl.arrayConcatN($mod.Ints, $mod.OneInt);',
10077     '$mod.Ints = rtl.arrayConcatN($mod.Ints, [1, 1]);',
10078     '$mod.Ints = rtl.arrayConcatN([$mod.i, $mod.i], $mod.Ints);',
10079     '$mod.Ints = rtl.arrayConcatN(rtl.arrayConcatN([1], [$mod.i]), [3]);',
10080     '']));
10081 end;
10082 
10083 procedure TTestModule.TestArray_DynArrayConstDelphi;
10084 begin
10085   StartProgram(false);
10086   // Note: const c = [1,1]; defines a set!
10087   Add([
10088   '{$mode delphi}',
10089   'type',
10090   '  integer = longint;',
10091   '  TArrInt = array of integer;',
10092   '  TArrStr = array of string;',
10093   'const',
10094   '  Ints: TArrInt = [1,1,2];',
10095   '  Aliases: TarrStr = [''foo'',''b''];',
10096   '  OneInt: TArrInt = [7];',
10097   '  OneStr: array of integer = [7]+[8];',
10098   '  Chars: array of char = ''aoc'';',
10099   '  Names: array of string = [''a'',''a''];',
10100   '  NameCount = low(Names)+high(Names)+length(Names);',
10101   'begin',
10102   '']);
10103   ConvertProgram;
10104   CheckSource('TestArray_DynArrayConstDelphi',
10105     LinesToStr([ // statements
10106     'this.Ints = [1, 1, 2];',
10107     'this.Aliases = ["foo", "b"];',
10108     'this.OneInt = [7];',
10109     'this.OneStr = rtl.arrayConcatN([7],[8]);',
10110     'this.Chars = ["a", "o", "c"];',
10111     'this.Names = ["a", "a"];',
10112     'this.NameCount = 0 + (rtl.length($mod.Names) - 1) + rtl.length($mod.Names);',
10113     '']),
10114     LinesToStr([ // $mod.$main
10115     '']));
10116 end;
10117 
10118 procedure TTestModule.TestArray_ArrayLitAsParam;
10119 begin
10120   StartProgram(false);
10121   Add([
10122   '{$modeswitch arrayoperators}',
10123   'type',
10124   '  integer = longint;',
10125   '  TArrInt = array of integer;',
10126   '  TArrSet = array of (red,green,blue);',
10127   'procedure DoOpenInt(const a: array of integer); forward;',
10128   'procedure DoInt(const a: TArrInt);',
10129   'begin',
10130   '  DoInt(a+[1]);',
10131   '  DoInt([1]+a);',
10132   '  DoOpenInt(a);',
10133   '  DoOpenInt(a+[1]);',
10134   '  DoOpenInt([1]+a);',
10135   'end;',
10136   'procedure DoOpenInt(const a: array of integer);',
10137   'begin',
10138   '  DoOpenInt(a+[1]);',
10139   '  DoOpenInt([1]+a);',
10140   '  DoInt(a);',
10141   '  DoInt(a+[1]);',
10142   '  DoInt([1]+a);',
10143   'end;',
10144   'procedure DoSet(const a: TArrSet);',
10145   'begin',
10146   '  DoSet(a+[red]);',
10147   '  DoSet([blue]+a);',
10148   'end;',
10149   'var',
10150   '  i: TArrInt;',
10151   '  s: TArrSet;',
10152   'begin',
10153   '  DoInt([1]);',
10154   '  DoInt([1]+[2]);',
10155   '  DoInt(i+[1]);',
10156   '  DoInt([1]+i);',
10157   '  DoOpenInt([1]);',
10158   '  DoOpenInt([1]+[2]);',
10159   '  DoOpenInt(i+[1]);',
10160   '  DoOpenInt([1]+i);',
10161   '  DoSet([red]);',
10162   '  DoSet([blue]+[green]);',
10163   '  DoSet(s+[blue]);',
10164   '  DoSet([red]+s);',
10165   '']);
10166   ConvertProgram;
10167   CheckSource('TestArray_ArrayLitAsParam',
10168     LinesToStr([ // statements
10169     'this.TArrSet$a = {',
10170     '  "0": "red",',
10171     '  red: 0,',
10172     '  "1": "green",',
10173     '  green: 1,',
10174     '  "2": "blue",',
10175     '  blue: 2',
10176     '};',
10177     'this.DoInt = function (a) {',
10178     '  $mod.DoInt(rtl.arrayConcatN(a, [1]));',
10179     '  $mod.DoInt(rtl.arrayConcatN([1], a));',
10180     '  $mod.DoOpenInt(a);',
10181     '  $mod.DoOpenInt(rtl.arrayConcatN(a, [1]));',
10182     '  $mod.DoOpenInt(rtl.arrayConcatN([1], a));',
10183     '};',
10184     'this.DoOpenInt = function (a) {',
10185     '  $mod.DoOpenInt(rtl.arrayConcatN(a, [1]));',
10186     '  $mod.DoOpenInt(rtl.arrayConcatN([1], a));',
10187     '  $mod.DoInt(a);',
10188     '  $mod.DoInt(rtl.arrayConcatN(a, [1]));',
10189     '  $mod.DoInt(rtl.arrayConcatN([1], a));',
10190     '};',
10191     'this.DoSet = function (a) {',
10192     '  $mod.DoSet(rtl.arrayConcatN(a, [$mod.TArrSet$a.red]));',
10193     '  $mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.blue], a));',
10194     '};',
10195     'this.i = [];',
10196     'this.s = [];',
10197     '']),
10198     LinesToStr([ // $mod.$main
10199     '$mod.DoInt([1]);',
10200     '$mod.DoInt(rtl.arrayConcatN([1], [2]));',
10201     '$mod.DoInt(rtl.arrayConcatN($mod.i, [1]));',
10202     '$mod.DoInt(rtl.arrayConcatN([1], $mod.i));',
10203     '$mod.DoOpenInt([1]);',
10204     '$mod.DoOpenInt(rtl.arrayConcatN([1], [2]));',
10205     '$mod.DoOpenInt(rtl.arrayConcatN($mod.i, [1]));',
10206     '$mod.DoOpenInt(rtl.arrayConcatN([1], $mod.i));',
10207     '$mod.DoSet([$mod.TArrSet$a.red]);',
10208     '$mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.blue], [$mod.TArrSet$a.green]));',
10209     '$mod.DoSet(rtl.arrayConcatN($mod.s, [$mod.TArrSet$a.blue]));',
10210     '$mod.DoSet(rtl.arrayConcatN([$mod.TArrSet$a.red], $mod.s));',
10211     '']));
10212 end;
10213 
10214 procedure TTestModule.TestArray_ArrayLitMultiDimAsParam;
10215 begin
10216   StartProgram(false);
10217   Add([
10218   '{$modeswitch arrayoperators}',
10219   'type',
10220   '  integer = longint;',
10221   '  TArrInt = array of integer;',
10222   '  TArrArrInt = array of TArrInt;',
10223   'procedure DoInt(const a: TArrArrInt);',
10224   'begin',
10225   '  DoInt(a+[[1]]);',
10226   '  DoInt([[1]]+a);',
10227   '  DoInt(a);',
10228   'end;',
10229   'var',
10230   '  i: TArrInt;',
10231   '  a: TArrArrInt;',
10232   'begin',
10233   '  a:=[[1]];',
10234   '  a:=[i];',
10235   '  a:=a+[i];',
10236   '  a:=[i]+a;',
10237   '  a:=[[1]+i];',
10238   '  a:=[[1]+[2]];',
10239   '  a:=[i+[2]];',
10240   '  DoInt([[1]]);',
10241   '  DoInt([[1]+[2],[3,4],[5]]);',
10242   '  DoInt([i+[1]]+a);',
10243   '  DoInt([i]+a);',
10244   '']);
10245   ConvertProgram;
10246   CheckSource('TestArray_ArrayLitMultiDimAsParam',
10247     LinesToStr([ // statements
10248     'this.DoInt = function (a) {',
10249     '  $mod.DoInt(rtl.arrayConcatN(a, [[1]]));',
10250     '  $mod.DoInt(rtl.arrayConcatN([[1]], a));',
10251     '  $mod.DoInt(a);',
10252     '};',
10253     'this.i = [];',
10254     'this.a = [];',
10255     '']),
10256     LinesToStr([ // $mod.$main
10257     '$mod.a = [[1]];',
10258     '$mod.a = [$mod.i];',
10259     '$mod.a = rtl.arrayConcatN($mod.a, [$mod.i]);',
10260     '$mod.a = rtl.arrayConcatN([$mod.i], $mod.a);',
10261     '$mod.a = [rtl.arrayConcatN([1], $mod.i)];',
10262     '$mod.a = [rtl.arrayConcatN([1], [2])];',
10263     '$mod.a = [rtl.arrayConcatN($mod.i, [2])];',
10264     '$mod.DoInt([[1]]);',
10265     '$mod.DoInt([rtl.arrayConcatN([1], [2]), [3, 4], [5]]);',
10266     '$mod.DoInt(rtl.arrayConcatN([rtl.arrayConcatN($mod.i, [1])], $mod.a));',
10267     '$mod.DoInt(rtl.arrayConcatN([$mod.i], $mod.a));',
10268     '']));
10269 end;
10270 
10271 procedure TTestModule.TestArray_ArrayLitStaticAsParam;
10272 begin
10273   StartProgram(false);
10274   Add([
10275   '{$modeswitch arrayoperators}',
10276   'type',
10277   '  integer = longint;',
10278   '  TArrInt = array[1..2] of integer;',
10279   '  TArrArrInt = array of TArrInt;',
10280   'procedure DoInt(const a: TArrArrInt);',
10281   'begin',
10282   '  DoInt(a+[[1,2]]);',
10283   '  DoInt([[1,2]]+a);',
10284   '  DoInt(a);',
10285   'end;',
10286   'var',
10287   '  i: TArrInt;',
10288   '  a: TArrArrInt;',
10289   'begin',
10290   '  a:=[[1,1]];',
10291   '  a:=[i];',
10292   '  a:=a+[i];',
10293   '  a:=[i]+a;',
10294   '  DoInt([[1,1]]);',
10295   '  DoInt([[1,2],[3,4]]);',
10296   '']);
10297   ConvertProgram;
10298   CheckSource('TestArray_ArrayLitStaticAsParam',
10299     LinesToStr([ // statements
10300     'this.DoInt = function (a) {',
10301     '  $mod.DoInt(rtl.arrayConcatN(a, [[1, 2]]));',
10302     '  $mod.DoInt(rtl.arrayConcatN([[1, 2]], a));',
10303     '  $mod.DoInt(a);',
10304     '};',
10305     'this.i = rtl.arraySetLength(null, 0, 2);',
10306     'this.a = [];',
10307     '']),
10308     LinesToStr([ // $mod.$main
10309     '$mod.a = [[1, 1]];',
10310     '$mod.a = [$mod.i.slice(0)];',
10311     '$mod.a = rtl.arrayConcatN($mod.a, [$mod.i.slice(0)]);',
10312     '$mod.a = rtl.arrayConcatN([$mod.i.slice(0)], $mod.a);',
10313     '$mod.DoInt([[1, 1]]);',
10314     '$mod.DoInt([[1, 2], [3, 4]]);',
10315     '']));
10316 end;
10317 
10318 procedure TTestModule.TestArray_ForInArrOfString;
10319 begin
10320   StartProgram(false);
10321   Add([
10322   'type',
10323   'type',
10324   '  TMonthNameArray = array [1..12] of string;',
10325   '  TMonthNames = TMonthNameArray;',
10326   '  TObject = class',
10327   '  private',
10328   '    function GetLongMonthNames: TMonthNames; virtual; abstract;',
10329   '  public',
10330   '    Property LongMonthNames : TMonthNames Read GetLongMonthNames;',
10331   '  end;',
10332   'var',
10333   '  f: TObject;',
10334   '  Month: string;',
10335   '  Names: array of string = (''a'',''foo'',''bar'');',
10336   '  i: longint;',
10337   'begin',
10338   '  for Month in f.LongMonthNames do ;',
10339   '  for Month in Names do ;',
10340   '  for i:=low(Names) to high(Names) do ;',
10341   '']);
10342   ConvertProgram;
10343   CheckSource('TestArray_ForInArrOfString',
10344     LinesToStr([ // statements
10345     'rtl.createClass($mod, "TObject", null, function () {',
10346     '  this.$init = function () {',
10347     '  };',
10348     '  this.$final = function () {',
10349     '  };',
10350     '});',
10351     'this.f = null;',
10352     'this.Month = "";',
10353     'this.Names = ["a", "foo", "bar"];',
10354     'this.i = 0;',
10355     '']),
10356     LinesToStr([ // $mod.$main
10357     'for (var $in = $mod.f.GetLongMonthNames(), $l = 0, $end = rtl.length($in) - 1; $l <= $end; $l++) $mod.Month = $in[$l];',
10358     'for (var $in1 = $mod.Names, $l1 = 0, $end1 = rtl.length($in1) - 1; $l1 <= $end1; $l1++) $mod.Month = $in1[$l1];',
10359     'for (var $l2 = 0, $end2 = rtl.length($mod.Names) - 1; $l2 <= $end2; $l2++) $mod.i = $l2;',
10360     '']));
10361 end;
10362 
10363 procedure TTestModule.TestExternalClass_TypeCastArrayToExternalClass;
10364 begin
10365   StartProgram(false);
10366   Add([
10367   '{$modeswitch externalclass}',
10368   'type',
10369   '  TJSObject = class external name ''Object''',
10370   '  end;',
10371   '  TJSArray = class external name ''Array''',
10372   '    class function isArray(Value: JSValue) : boolean;',
10373   '    function concat() : TJSArray; varargs;',
10374   '  end;',
10375   'var',
10376   '  aObj: TJSArray;',
10377   '  a: array of longint;',
10378   '  o: TJSObject;',
10379   'begin',
10380   '  if TJSArray.isArray(65) then ;',
10381   '  aObj:=TJSArray(a).concat(a);',
10382   '  o:=TJSObject(a);']);
10383   ConvertProgram;
10384   CheckSource('TestExternalClass_TypeCastArrayToExternalClass',
10385     LinesToStr([ // statements
10386     'this.aObj = null;',
10387     'this.a = [];',
10388     'this.o = null;',
10389     '']),
10390     LinesToStr([ // $mod.$main
10391     'if (Array.isArray(65)) ;',
10392     '$mod.aObj = $mod.a.concat($mod.a);',
10393     '$mod.o = $mod.a;',
10394     '']));
10395 end;
10396 
10397 procedure TTestModule.TestExternalClass_TypeCastArrayFromExternalClass;
10398 begin
10399   StartProgram(false);
10400   Add([
10401   '{$modeswitch externalclass}',
10402   'type',
10403   '  TArrStr = array of string;',
10404   '  TJSArray = class external name ''Array''',
10405   '  end;',
10406   '  TJSObject = class external name ''Object''',
10407   '  end;',
10408   'var',
10409   '  aObj: TJSArray;',
10410   '  a: TArrStr;',
10411   '  jo: TJSObject;',
10412   'begin',
10413   '  a:=TArrStr(aObj);',
10414   '  TArrStr(aObj)[1]:=TArrStr(aObj)[2];',
10415   '  a:=TarrStr(jo);',
10416   '']);
10417   ConvertProgram;
10418   CheckSource('TestExternalClass_TypeCastArrayFromExternalClass',
10419     LinesToStr([ // statements
10420     'this.aObj = null;',
10421     'this.a = [];',
10422     'this.jo = null;',
10423     '']),
10424     LinesToStr([ // $mod.$main
10425     '$mod.a = $mod.aObj;',
10426     '$mod.aObj[1] = $mod.aObj[2];',
10427     '$mod.a = $mod.jo;',
10428     '']));
10429 end;
10430 
10431 procedure TTestModule.TestArrayOfConst_TVarRec;
10432 begin
10433   StartProgram(true,[supTVarRec]);
10434   Add([
10435   'procedure Say(args: array of const);',
10436   'var',
10437   '  i: longint;',
10438   '  v: TVarRec;',
10439   'begin',
10440   '  for i:=low(args) to high(args) do begin',
10441   '    v:=args[i];',
10442   '    case v.vtype of',
10443   '    vtInteger: if length(args)=args[i].vInteger then ;',
10444   '    end;',
10445   '  end;',
10446   '  for v in args do ;',
10447   '  args:=nil;',
10448   '  SetLength(args,2);',
10449   'end;',
10450   'begin']);
10451   ConvertProgram;
10452   CheckSource('TestArrayOfConst_TVarRec',
10453     LinesToStr([ // statements
10454     'this.Say = function (args) {',
10455     '  var i = 0;',
10456     '  var v = pas.system.TVarRec.$new();',
10457     '  for (var $l = 0, $end = rtl.length(args) - 1; $l <= $end; $l++) {',
10458     '    i = $l;',
10459     '    v.$assign(args[i]);',
10460     '    var $tmp = v.VType;',
10461     '    if ($tmp === 0) if (rtl.length(args) === args[i].VJSValue) ;',
10462     '  };',
10463     '  for (var $in = args, $l1 = 0, $end1 = rtl.length($in) - 1; $l1 <= $end1; $l1++) v = $in[$l1];',
10464     '  args = [];',
10465     '  args = rtl.arraySetLength(args, pas.system.TVarRec, 2);',
10466     '};',
10467     '']),
10468     LinesToStr([ // $mod.$main
10469     ]));
10470 end;
10471 
10472 procedure TTestModule.TestArrayOfConst_PassBaseTypes;
10473 begin
10474   StartProgram(true,[supTVarRec]);
10475   Add([
10476   'procedure Say(args: array of const);',
10477   'begin',
10478   '  Say(args);',
10479   'end;',
10480   'var',
10481   '  p: Pointer;',
10482   '  j: jsvalue;',
10483   '  c: currency;',
10484   'begin',
10485   '  Say([]);',
10486   '  Say([1]);',
10487   '  Say([''c'',''foo'',nil,true,1.3,p,j,c]);',
10488   '']);
10489   ConvertProgram;
10490   CheckSource('TestArrayOfConst_PassBaseTypes',
10491     LinesToStr([ // statements
10492     'this.Say = function (args) {',
10493     '  $mod.Say(args);',
10494     '};',
10495     'this.p = null;',
10496     'this.j = undefined;',
10497     'this.c = 0;',
10498     '']),
10499     LinesToStr([ // $mod.$main
10500     '$mod.Say([]);',
10501     '$mod.Say(pas.system.VarRecs(0, 1));',
10502     '$mod.Say(pas.system.VarRecs(',
10503     '  9,',
10504     '  "c",',
10505     '  18,',
10506     '  "foo",',
10507     '  5,',
10508     '  null,',
10509     '  1,',
10510     '  true,',
10511     '  3,',
10512     '  1.3,',
10513     '  5,',
10514     '  $mod.p,',
10515     '  20,',
10516     '  $mod.j,',
10517     '  12,',
10518     '  $mod.c',
10519     '  ));',
10520     '']));
10521 end;
10522 
10523 procedure TTestModule.TestArrayOfConst_PassObj;
10524 begin
10525   StartProgram(true,[supTVarRec]);
10526   Add([
10527   '{$interfaces corba}',
10528   'type',
10529   '  TObject = class',
10530   '  end;',
10531   '  TClass = class of TObject;',
10532   '  IUnknown = interface',
10533   '  end;',
10534   'procedure Say(args: array of const);',
10535   'begin',
10536   'end;',
10537   'var',
10538   '  o: TObject;',
10539   '  c: TClass;',
10540   '  i: IUnknown;',
10541   'begin',
10542   '  Say([o,c,TObject]);',
10543   '  Say([nil,i]);',
10544   '']);
10545   ConvertProgram;
10546   CheckSource('TestArrayOfConst_PassObj',
10547     LinesToStr([ // statements
10548     'rtl.createClass($mod, "TObject", null, function () {',
10549     '  this.$init = function () {',
10550     '  };',
10551     '  this.$final = function () {',
10552     '  };',
10553     '});',
10554     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
10555     'this.Say = function (args) {',
10556     '};',
10557     'this.o = null;',
10558     'this.c = null;',
10559     'this.i = null;',
10560     '']),
10561     LinesToStr([ // $mod.$main
10562     '$mod.Say(pas.system.VarRecs(',
10563     '  7,',
10564     '  $mod.o,',
10565     '  8,',
10566     '  $mod.c,',
10567     '  8,',
10568     '  $mod.TObject',
10569     '));',
10570     '$mod.Say(pas.system.VarRecs(5, null, 14, $mod.i));',
10571     '']));
10572 end;
10573 
10574 procedure TTestModule.TestRecord_Empty;
10575 begin
10576   StartProgram(false);
10577   Add([
10578   'type',
10579   '  TRecA = record',
10580   '  end;',
10581   'var a,b: TRecA;',
10582   'begin',
10583   '  if a=b then ;']);
10584   ConvertProgram;
10585   CheckSource('TestRecord_Empty',
10586     LinesToStr([ // statements
10587     'rtl.recNewT($mod, "TRecA", function () {',
10588     '  this.$eq = function (b) {',
10589     '    return true;',
10590     '  };',
10591     '  this.$assign = function (s) {',
10592     '    return this;',
10593     '  };',
10594     '});',
10595     'this.a = $mod.TRecA.$new();',
10596     'this.b = $mod.TRecA.$new();',
10597     '']),
10598     LinesToStr([ // $mod.$main
10599     'if ($mod.a.$eq($mod.b)) ;'
10600     ]));
10601 end;
10602 
10603 procedure TTestModule.TestRecord_Var;
10604 begin
10605   StartProgram(false);
10606   Add('type');
10607   Add('  TRecA = record');
10608   Add('    Bold: longint;');
10609   Add('  end;');
10610   Add('var Rec: TRecA;');
10611   Add('begin');
10612   Add('  rec.bold:=123');
10613   ConvertProgram;
10614   CheckSource('TestRecord_Var',
10615     LinesToStr([ // statements
10616     'rtl.recNewT($mod, "TRecA", function () {',
10617     '  this.Bold = 0;',
10618     '  this.$eq = function (b) {',
10619     '    return this.Bold === b.Bold;',
10620     '  };',
10621     '  this.$assign = function (s) {',
10622     '    this.Bold = s.Bold;',
10623     '    return this;',
10624     '  };',
10625     '});',
10626     'this.Rec = $mod.TRecA.$new();',
10627     '']),
10628     LinesToStr([ // $mod.$main
10629     '$mod.Rec.Bold = 123;'
10630     ]));
10631 end;
10632 
10633 procedure TTestModule.TestRecord_VarExternal;
10634 begin
10635   StartProgram(false);
10636   Add([
10637   '{$modeswitch externalclass}',
10638   'type',
10639   '  TRecA = record',
10640   '    i: byte;',
10641   '    length_: longint external name ''length'';',
10642   '  end;',
10643   'var Rec: TRecA;',
10644   'begin',
10645   '  rec.length_ := rec.length_',
10646   '']);
10647   ConvertProgram;
10648   CheckSource('TestRecord_VarExternal',
10649     LinesToStr([ // statements
10650     'rtl.recNewT($mod, "TRecA", function () {',
10651     '  this.i = 0;',
10652     '  this.$eq = function (b) {',
10653     '    return (this.i === b.i) && (this.length === b.length);',
10654     '  };',
10655     '  this.$assign = function (s) {',
10656     '    this.i = s.i;',
10657     '    this.length = s.length;',
10658     '    return this;',
10659     '  };',
10660     '});',
10661     'this.Rec = $mod.TRecA.$new();',
10662     '']),
10663     LinesToStr([ // $mod.$main
10664     '$mod.Rec.length = $mod.Rec.length;'
10665     ]));
10666 end;
10667 
10668 procedure TTestModule.TestRecord_WithDo;
10669 begin
10670   StartProgram(false);
10671   Add('type');
10672   Add('  TRec = record');
10673   Add('    vI: longint;');
10674   Add('  end;');
10675   Add('var');
10676   Add('  Int: longint;');
10677   Add('  r: TRec;');
10678   Add('begin');
10679   Add('  with r do');
10680   Add('    int:=vi;');
10681   Add('  with r do begin');
10682   Add('    int:=vi;');
10683   Add('    vi:=int;');
10684   Add('  end;');
10685   ConvertProgram;
10686   CheckSource('TestWithRecordDo',
10687     LinesToStr([ // statements
10688     'rtl.recNewT($mod, "TRec", function () {',
10689     '  this.vI = 0;',
10690     '  this.$eq = function (b) {',
10691     '    return this.vI === b.vI;',
10692     '  };',
10693     '  this.$assign = function (s) {',
10694     '    this.vI = s.vI;',
10695     '    return this;',
10696     '  };',
10697     '});',
10698     'this.Int = 0;',
10699     'this.r = $mod.TRec.$new();',
10700     '']),
10701     LinesToStr([ // $mod.$main
10702     'var $with = $mod.r;',
10703     '$mod.Int = $with.vI;',
10704     'var $with1 = $mod.r;',
10705     '$mod.Int = $with1.vI;',
10706     '$with1.vI = $mod.Int;'
10707     ]));
10708 end;
10709 
10710 procedure TTestModule.TestRecord_Assign;
10711 begin
10712   StartProgram(false);
10713   Add('type');
10714   Add('  TEnum = (red,green);');
10715   Add('  TEnums = set of TEnum;');
10716   Add('  TSmallRec = record');
10717   Add('    N: longint;');
10718   Add('  end;');
10719   Add('  TBigRec = record');
10720   Add('    Int: longint;');
10721   Add('    D: double;');
10722   Add('    Arr: array of longint;');
10723   Add('    Arr2: array[1..2] of longint;');
10724   Add('    Small: TSmallRec;');
10725   Add('    Enums: TEnums;');
10726   Add('  end;');
10727   Add('var');
10728   Add('  r, s: TBigRec;');
10729   Add('begin');
10730   Add('  r:=s;');
10731   Add('  r:=default(TBigRec);');
10732   Add('  r:=default(s);');
10733   ConvertProgram;
10734   CheckSource('TestRecord_Assign',
10735     LinesToStr([ // statements
10736     'this.TEnum = {',
10737     '  "0": "red",',
10738     '  red: 0,',
10739     '  "1": "green",',
10740     '  green: 1',
10741     '};',
10742     'rtl.recNewT($mod, "TSmallRec", function () {',
10743     '  this.N = 0;',
10744     '  this.$eq = function (b) {',
10745     '    return this.N === b.N;',
10746     '  };',
10747     '  this.$assign = function (s) {',
10748     '    this.N = s.N;',
10749     '    return this;',
10750     '  };',
10751     '});',
10752     'rtl.recNewT($mod, "TBigRec", function () {',
10753     '  this.Int = 0;',
10754     '  this.D = 0.0;',
10755     '  this.$new = function () {',
10756     '    var r = Object.create(this);',
10757     '    r.Arr = [];',
10758     '    r.Arr2 = rtl.arraySetLength(null, 0, 2);',
10759     '    r.Small = $mod.TSmallRec.$new();',
10760     '    r.Enums = {};',
10761     '    return r;',
10762     '  };',
10763     '  this.$eq = function (b) {',
10764     '    return (this.Int === b.Int) && (this.D === b.D) && (this.Arr === b.Arr) && rtl.arrayEq(this.Arr2, b.Arr2) && this.Small.$eq(b.Small) && rtl.eqSet(this.Enums, b.Enums);',
10765     '  };',
10766     '  this.$assign = function (s) {',
10767     '    this.Int = s.Int;',
10768     '    this.D = s.D;',
10769     '    this.Arr = rtl.arrayRef(s.Arr);',
10770     '    this.Arr2 = s.Arr2.slice(0);',
10771     '    this.Small.$assign(s.Small);',
10772     '    this.Enums = rtl.refSet(s.Enums);',
10773     '    return this;',
10774     '  };',
10775     '});',
10776     'this.r = $mod.TBigRec.$new();',
10777     'this.s = $mod.TBigRec.$new();',
10778     '']),
10779     LinesToStr([ // $mod.$main
10780     '$mod.r.$assign($mod.s);',
10781     '$mod.r.$assign($mod.TBigRec.$new());',
10782     '$mod.r.$assign($mod.TBigRec.$new());',
10783     '']));
10784 end;
10785 
10786 procedure TTestModule.TestRecord_AsParams;
10787 begin
10788   StartProgram(false);
10789   Add([
10790   'type',
10791   '  integer = longint;',
10792   '  TRecord = record',
10793   '    i: integer;',
10794   '  end;',
10795   'procedure DoIt(vD: TRecord; const vC: TRecord; var vV: TRecord; var U);',
10796   'var vL: TRecord;',
10797   'begin',
10798   '  vd:=vd;',
10799   '  vd.i:=vd.i;',
10800   '  vl:=vc;',
10801   '  vv:=vv;',
10802   '  vv.i:=vv.i;',
10803   '  U:=vl;',
10804   '  U:=vd;',
10805   '  U:=vc;',
10806   '  U:=vv;',
10807   '  vl:=TRecord(U);',
10808   '  vd:=TRecord(U);',
10809   '  vv:=TRecord(U);',
10810   '  doit(vd,vd,vd,vd);',
10811   '  doit(vc,vc,vl,vl);',
10812   '  doit(vv,vv,vv,vv);',
10813   '  doit(vl,vl,vl,vl);',
10814   '  TRecord(U).i:=3;',
10815   'end;',
10816   'var i: TRecord;',
10817   'begin',
10818   '  doit(i,i,i,i);',
10819   '']);
10820   ConvertProgram;
10821   CheckSource('TestRecord_AsParams',
10822     LinesToStr([ // statements
10823     'rtl.recNewT($mod, "TRecord", function () {',
10824     '  this.i = 0;',
10825     '  this.$eq = function (b) {',
10826     '    return this.i === b.i;',
10827     '  };',
10828     '  this.$assign = function (s) {',
10829     '    this.i = s.i;',
10830     '    return this;',
10831     '  };',
10832     '});',
10833     'this.DoIt = function (vD, vC, vV, U) {',
10834     '  var vL = $mod.TRecord.$new();',
10835     '  vD.$assign(vD);',
10836     '  vD.i = vD.i;',
10837     '  vL.$assign(vC);',
10838     '  vV.$assign(vV);',
10839     '  vV.i = vV.i;',
10840     '  U.$assign(vL);',
10841     '  U.$assign(vD);',
10842     '  U.$assign(vC);',
10843     '  U.$assign(vV);',
10844     '  vL.$assign(U);',
10845     '  vD.$assign(U);',
10846     '  vV.$assign(U);',
10847     '  $mod.DoIt($mod.TRecord.$clone(vD), vD, vD, vD);',
10848     '  $mod.DoIt($mod.TRecord.$clone(vC), vC, vL, vL);',
10849     '  $mod.DoIt($mod.TRecord.$clone(vV), vV, vV, vV);',
10850     '  $mod.DoIt($mod.TRecord.$clone(vL), vL, vL, vL);',
10851     '  U.i = 3;',
10852     '};',
10853     'this.i = $mod.TRecord.$new();'
10854     ]),
10855     LinesToStr([
10856     '$mod.DoIt($mod.TRecord.$clone($mod.i), $mod.i, $mod.i, $mod.i);',
10857     '']));
10858 end;
10859 
10860 procedure TTestModule.TestRecord_ConstRef;
10861 begin
10862   StartProgram(false);
10863   Add([
10864   'type TRec = record i: word; end;',
10865   'procedure Run(constref a: TRec);',
10866   'begin',
10867   'end;',
10868   'procedure Fly(a: TRec; var b: TRec; out c: TRec; const d: TRec; constref e: TRec);',
10869   'var l: TRec;',
10870   'begin',
10871   '  Run(l);',
10872   '  Run(a);',
10873   '  Run(b);',
10874   '  Run(c);',
10875   '  Run(d);',
10876   '  Run(e);',
10877   'end;',
10878   'begin',
10879   '']);
10880   ConvertProgram;
10881   CheckResolverUnexpectedHints();
10882   CheckSource('TestRecord_ConstRef',
10883     LinesToStr([ // statements
10884     'rtl.recNewT($mod, "TRec", function () {',
10885     '  this.i = 0;',
10886     '  this.$eq = function (b) {',
10887     '    return this.i === b.i;',
10888     '  };',
10889     '  this.$assign = function (s) {',
10890     '    this.i = s.i;',
10891     '    return this;',
10892     '  };',
10893     '});',
10894     'this.Run = function (a) {',
10895     '};',
10896     'this.Fly = function (a, b, c, d, e) {',
10897     '  var l = $mod.TRec.$new();',
10898     '  $mod.Run(l);',
10899     '  $mod.Run(a);',
10900     '  $mod.Run(b);',
10901     '  $mod.Run(c);',
10902     '  $mod.Run(d);',
10903     '  $mod.Run(e);',
10904     '};',
10905     '']),
10906     LinesToStr([
10907     '']));
10908 end;
10909 
10910 procedure TTestModule.TestRecordElement_AsParams;
10911 begin
10912   StartProgram(false);
10913   Add('type');
10914   Add('  integer = longint;');
10915   Add('  TRecord = record');
10916   Add('    i: integer;');
10917   Add('  end;');
10918   Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
10919   Add('var vJ: TRecord;');
10920   Add('begin');
10921   Add('  doit(vj.i,vj.i,vj.i);');
10922   Add('end;');
10923   Add('var r: TRecord;');
10924   Add('begin');
10925   Add('  doit(r.i,r.i,r.i);');
10926   ConvertProgram;
10927   CheckSource('TestRecordElement_AsParams',
10928     LinesToStr([ // statements
10929     'rtl.recNewT($mod, "TRecord", function () {',
10930     '  this.i = 0;',
10931     '  this.$eq = function (b) {',
10932     '    return this.i === b.i;',
10933     '  };',
10934     '  this.$assign = function (s) {',
10935     '    this.i = s.i;',
10936     '    return this;',
10937     '  };',
10938     '});',
10939     'this.DoIt = function (vG,vH,vI) {',
10940     '  var vJ = $mod.TRecord.$new();',
10941     '  $mod.DoIt(vJ.i, vJ.i, {',
10942     '    p: vJ,',
10943     '    get: function () {',
10944     '      return this.p.i;',
10945     '    },',
10946     '    set: function (v) {',
10947     '      this.p.i = v;',
10948     '    }',
10949     '  });',
10950     '};',
10951     'this.r = $mod.TRecord.$new();'
10952     ]),
10953     LinesToStr([
10954     '$mod.DoIt($mod.r.i,$mod.r.i,{',
10955     '  p: $mod.r,',
10956     '  get: function () {',
10957     '      return this.p.i;',
10958     '    },',
10959     '  set: function (v) {',
10960     '      this.p.i = v;',
10961     '    }',
10962     '});'
10963     ]));
10964 end;
10965 
10966 procedure TTestModule.TestRecordElementFromFuncResult_AsParams;
10967 begin
10968   StartProgram(false);
10969   Add('type');
10970   Add('  integer = longint;');
10971   Add('  TRecord = record');
10972   Add('    i: integer;');
10973   Add('  end;');
10974   Add('function GetRec(vB: integer = 0): TRecord;');
10975   Add('begin');
10976   Add('end;');
10977   Add('procedure DoIt(vG: integer; const vH: integer);');
10978   Add('begin');
10979   Add('end;');
10980   Add('begin');
10981   Add('  doit(getrec.i,getrec.i);');
10982   Add('  doit(getrec().i,getrec().i);');
10983   Add('  doit(getrec(1).i,getrec(2).i);');
10984   ConvertProgram;
10985   CheckSource('TestRecordElementFromFuncResult_AsParams',
10986     LinesToStr([ // statements
10987     'rtl.recNewT($mod, "TRecord", function () {',
10988     '  this.i = 0;',
10989     '  this.$eq = function (b) {',
10990     '    return this.i === b.i;',
10991     '  };',
10992     '  this.$assign = function (s) {',
10993     '    this.i = s.i;',
10994     '    return this;',
10995     '  };',
10996     '});',
10997     'this.GetRec = function (vB) {',
10998     '  var Result = $mod.TRecord.$new();',
10999     '  return Result;',
11000     '};',
11001     'this.DoIt = function (vG, vH) {',
11002     '};',
11003     '']),
11004     LinesToStr([
11005     '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
11006     '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
11007     '$mod.DoIt($mod.GetRec(1).i,$mod.GetRec(2).i);',
11008     '']));
11009 end;
11010 
11011 procedure TTestModule.TestRecordElementFromWith_AsParams;
11012 begin
11013   StartProgram(false);
11014   Add('type');
11015   Add('  integer = longint;');
11016   Add('  TRecord = record');
11017   Add('    i: integer;');
11018   Add('  end;');
11019   Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
11020   Add('begin');
11021   Add('end;');
11022   Add('var r: trecord;');
11023   Add('begin');
11024   Add('  with r do ');
11025   Add('    doit(i,i,i);');
11026   ConvertProgram;
11027   CheckSource('TestRecordElementFromWith_AsParams',
11028     LinesToStr([ // statements
11029     'rtl.recNewT($mod, "TRecord", function () {',
11030     '  this.i = 0;',
11031     '  this.$eq = function (b) {',
11032     '    return this.i === b.i;',
11033     '  };',
11034     '  this.$assign = function (s) {',
11035     '    this.i = s.i;',
11036     '    return this;',
11037     '  };',
11038     '});',
11039     'this.DoIt = function (vG,vH,vI) {',
11040     '};',
11041     'this.r = $mod.TRecord.$new();'
11042     ]),
11043     LinesToStr([
11044     'var $with = $mod.r;',
11045     '$mod.DoIt($with.i,$with.i,{',
11046     '  p: $with,',
11047     '  get: function () {',
11048     '      return this.p.i;',
11049     '    },',
11050     '  set: function (v) {',
11051     '      this.p.i = v;',
11052     '    }',
11053     '});',
11054     '']));
11055 end;
11056 
11057 procedure TTestModule.TestRecord_Equal;
11058 begin
11059   StartProgram(false);
11060   Add('type');
11061   Add('  integer = longint;');
11062   Add('  TFlag = (red,blue);');
11063   Add('  TFlags = set of TFlag;');
11064   Add('  TProc = procedure;');
11065   Add('  TRecord = record');
11066   Add('    i: integer;');
11067   Add('    Event: TProc;');
11068   Add('    f: TFlags;');
11069   Add('  end;');
11070   Add('  TNested = record');
11071   Add('    r: TRecord;');
11072   Add('  end;');
11073   Add('var');
11074   Add('  b: boolean;');
11075   Add('  r,s: trecord;');
11076   Add('begin');
11077   Add('  b:=r=s;');
11078   Add('  b:=r<>s;');
11079   ConvertProgram;
11080   CheckSource('TestRecord_Equal',
11081     LinesToStr([ // statements
11082     'this.TFlag = {',
11083     '  "0": "red",',
11084     '  red: 0,',
11085     '  "1": "blue",',
11086     '  blue: 1',
11087     '};',
11088     'rtl.recNewT($mod, "TRecord", function () {',
11089     '  this.i = 0;',
11090     '  this.Event = null;',
11091     '  this.$new = function () {',
11092     '    var r = Object.create(this);',
11093     '    r.f = {};',
11094     '    return r;',
11095     '  };',
11096     '  this.$eq = function (b) {',
11097     '    return (this.i === b.i) && rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f);',
11098     '  };',
11099     '  this.$assign = function (s) {',
11100     '    this.i = s.i;',
11101     '    this.Event = s.Event;',
11102     '    this.f = rtl.refSet(s.f);',
11103     '    return this;',
11104     '  };',
11105     '});',
11106     'rtl.recNewT($mod, "TNested", function () {',
11107     '  this.$new = function () {',
11108     '    var r = Object.create(this);',
11109     '    r.r = $mod.TRecord.$new();',
11110     '    return r;',
11111     '  };',
11112     '  this.$eq = function (b) {',
11113     '    return this.r.$eq(b.r);',
11114     '  };',
11115     '  this.$assign = function (s) {',
11116     '    this.r.$assign(s.r);',
11117     '    return this;',
11118     '  };',
11119     '});',
11120     'this.b = false;',
11121     'this.r = $mod.TRecord.$new();',
11122     'this.s = $mod.TRecord.$new();',
11123     '']),
11124     LinesToStr([
11125     '$mod.b = $mod.r.$eq($mod.s);',
11126     '$mod.b = !$mod.r.$eq($mod.s);',
11127     '']));
11128 end;
11129 
11130 procedure TTestModule.TestRecord_JSValue;
11131 begin
11132   StartProgram(false);
11133   Add([
11134   'type',
11135   '  TRecord = record',
11136   '    i: longint;',
11137   '  end;',
11138   'procedure Fly(d: jsvalue; const c: jsvalue);',
11139   'begin',
11140   'end;',
11141   'procedure Run(d: TRecord; const c: TRecord; var v: TRecord);',
11142   'begin',
11143   '  if jsvalue(d) then ;',
11144   '  if jsvalue(c) then ;',
11145   '  if jsvalue(v) then ;',
11146   'end;',
11147   'var',
11148   '  Jv: jsvalue;',
11149   '  Rec: trecord;',
11150   'begin',
11151   '  rec:=trecord(jv);',
11152   '  jv:=rec;',
11153   '  Fly(rec,rec);',
11154   '  Fly(@rec,@rec);',
11155   '  if jsvalue(Rec) then ;',
11156   '  Run(trecord(jv),trecord(jv),rec);',
11157   '']);
11158   ConvertProgram;
11159   CheckSource('TestRecord_JSValue',
11160     LinesToStr([ // statements
11161     'rtl.recNewT($mod, "TRecord", function () {',
11162     '  this.i = 0;',
11163     '  this.$eq = function (b) {',
11164     '    return this.i === b.i;',
11165     '  };',
11166     '  this.$assign = function (s) {',
11167     '    this.i = s.i;',
11168     '    return this;',
11169     '  };',
11170     '});',
11171     'this.Fly = function (d, c) {',
11172     '};',
11173     'this.Run = function (d, c, v) {',
11174     '  if (d) ;',
11175     '  if (c) ;',
11176     '  if (v) ;',
11177     '};',
11178     'this.Jv = undefined;',
11179     'this.Rec = $mod.TRecord.$new();',
11180     '']),
11181     LinesToStr([
11182     '$mod.Rec.$assign(rtl.getObject($mod.Jv));',
11183     '$mod.Jv = $mod.Rec;',
11184     '$mod.Fly($mod.TRecord.$clone($mod.Rec), $mod.Rec);',
11185     '$mod.Fly($mod.Rec, $mod.Rec);',
11186     'if ($mod.Rec) ;',
11187     '$mod.Run($mod.TRecord.$clone(rtl.getObject($mod.Jv)), rtl.getObject($mod.Jv), $mod.Rec);',
11188     '']));
11189 end;
11190 
11191 procedure TTestModule.TestRecord_VariantFail;
11192 begin
11193   StartProgram(false);
11194   Add([
11195   'type',
11196   '  TRec = record',
11197   '    case word of',
11198   '    0: (b0, b1: Byte);',
11199   '    1: (i: word);',
11200   '  end;',
11201   'begin']);
11202   SetExpectedPasResolverError('variant record is not supported',
11203     nXIsNotSupported);
11204   ConvertProgram;
11205 end;
11206 
11207 procedure TTestModule.TestRecord_FieldArray;
11208 begin
11209   StartProgram(false);
11210   Add([
11211   'type',
11212   '  TArrInt = array[3..4] of longint;',
11213   '  TArrArrInt = array[3..4] of longint;',
11214   '  TRec = record',
11215   '    a: array of longint;',
11216   '    s: array[1..2] of longint;',
11217   '    m: array[1..2,3..4] of longint;',
11218   '    o: TArrArrInt;',
11219   '  end;',
11220   'begin']);
11221   ConvertProgram;
11222   CheckSource('TestRecord_FieldArray',
11223     LinesToStr([ // statements
11224     'rtl.recNewT($mod, "TRec", function () {',
11225     '  this.$new = function () {',
11226     '    var r = Object.create(this);',
11227     '    r.a = [];',
11228     '    r.s = rtl.arraySetLength(null, 0, 2);',
11229     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
11230     '    r.o = rtl.arraySetLength(null, 0, 2);',
11231     '    return r;',
11232     '  };',
11233     '  this.$eq = function (b) {',
11234     '    return (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && rtl.arrayEq(this.o, b.o);',
11235     '  };',
11236     '  this.$assign = function (s) {',
11237     '    this.a = rtl.arrayRef(s.a);',
11238     '    this.s = s.s.slice(0);',
11239     '    this.m = s.m.slice(0);',
11240     '    this.o = s.o.slice(0);',
11241     '    return this;',
11242     '  };',
11243     '});',
11244     '']),
11245     LinesToStr([ // $mod.$main
11246     '']));
11247 end;
11248 
11249 procedure TTestModule.TestRecord_Const;
11250 begin
11251   StartProgram(false);
11252   Add([
11253   'type',
11254   '  TArrInt = array[3..4] of longint;',
11255   '  TPoint = record x,y: longint; end;',
11256   '  TRec = record',
11257   '    i: longint;',
11258   '    a: array of longint;',
11259   '    s: array[1..2] of longint;',
11260   '    m: array[1..2,3..4] of longint;',
11261   '    p: TPoint;',
11262   '  end;',
11263   '  TPoints = array of TPoint;',
11264   'const',
11265   '  r: TRec = (',
11266   '    i:1;',
11267   '    a:(2,3);',
11268   '    s:(4,5);',
11269   '    m:( (11,12), (13,14) );',
11270   '    p: (x:21; y:22)',
11271   '  );',
11272   '  p: TPoints = ( (x:1;y:2), (x:3;y:4) );',
11273   'begin']);
11274   ConvertProgram;
11275   CheckSource('TestRecord_Const',
11276     LinesToStr([ // statements
11277     'rtl.recNewT($mod, "TPoint", function () {',
11278     '  this.x = 0;',
11279     '  this.y = 0;',
11280     '  this.$eq = function (b) {',
11281     '    return (this.x === b.x) && (this.y === b.y);',
11282     '  };',
11283     '  this.$assign = function (s) {',
11284     '    this.x = s.x;',
11285     '    this.y = s.y;',
11286     '    return this;',
11287     '  };',
11288     '});',
11289     'rtl.recNewT($mod, "TRec", function () {',
11290     '  this.i = 0;',
11291     '  this.$new = function () {',
11292     '    var r = Object.create(this);',
11293     '    r.a = [];',
11294     '    r.s = rtl.arraySetLength(null, 0, 2);',
11295     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
11296     '    r.p = $mod.TPoint.$new();',
11297     '    return r;',
11298     '  };',
11299     '  this.$eq = function (b) {',
11300     '    return (this.i === b.i) && (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && this.p.$eq(b.p);',
11301     '  };',
11302     '  this.$assign = function (s) {',
11303     '    this.i = s.i;',
11304     '    this.a = rtl.arrayRef(s.a);',
11305     '    this.s = s.s.slice(0);',
11306     '    this.m = s.m.slice(0);',
11307     '    this.p.$assign(s.p);',
11308     '    return this;',
11309     '  };',
11310     '});',
11311     'this.r = $mod.TRec.$clone({',
11312     '  i: 1,',
11313     '  a: [2, 3],',
11314     '  s: [4, 5],',
11315     '  m: [[11, 12], [13, 14]],',
11316     '  p: $mod.TPoint.$clone({',
11317     '      x: 21,',
11318     '      y: 22',
11319     '    })',
11320     '});',
11321     'this.p = [$mod.TPoint.$clone({',
11322     '  x: 1,',
11323     '  y: 2',
11324     '}), $mod.TPoint.$clone({',
11325     '  x: 3,',
11326     '  y: 4',
11327     '})];',
11328     '']),
11329     LinesToStr([ // $mod.$main
11330     '']));
11331 end;
11332 
11333 procedure TTestModule.TestRecord_TypecastFail;
11334 begin
11335   StartProgram(false);
11336   Add([
11337   'type',
11338   '  TPoint = record x,y: longint; end;',
11339   '  TRec = record l: longint end;',
11340   'var p: TPoint;',
11341   'begin',
11342   '  if TRec(p).l=2 then ;']);
11343   SetExpectedPasResolverError('Illegal type conversion: "TPoint" to "record TRec"',
11344     nIllegalTypeConversionTo);
11345   ConvertProgram;
11346 end;
11347 
11348 procedure TTestModule.TestRecord_InFunction;
11349 begin
11350   StartProgram(false);
11351   Add([
11352   'var TPoint: longint = 3;',
11353   'procedure DoIt;',
11354   'type',
11355   '  TPoint = record x,y: longint; end;',
11356   '  TPoints = array of TPoint;',
11357   'var',
11358   '  r: TPoint;',
11359   '  p: TPoints;',
11360   'begin',
11361   '  SetLength(p,2);',
11362   'end;',
11363   'begin']);
11364   ConvertProgram;
11365   CheckSource('TestRecord_InFunction',
11366     LinesToStr([ // statements
11367     'this.TPoint = 3;',
11368     'var TPoint$1 = rtl.recNewT(null, "", function () {',
11369     '  this.x = 0;',
11370     '  this.y = 0;',
11371     '  this.$eq = function (b) {',
11372     '    return (this.x === b.x) && (this.y === b.y);',
11373     '  };',
11374     '  this.$assign = function (s) {',
11375     '    this.x = s.x;',
11376     '    this.y = s.y;',
11377     '    return this;',
11378     '  };',
11379     '});',
11380     'this.DoIt = function () {',
11381     '  var r = TPoint$1.$new();',
11382     '  var p = [];',
11383     '  p = rtl.arraySetLength(p, TPoint$1, 2);',
11384     '};',
11385     '']),
11386     LinesToStr([ // $mod.$main
11387     '']));
11388 end;
11389 
11390 procedure TTestModule.TestRecord_AnonymousFail;
11391 begin
11392   StartProgram(false);
11393   Add([
11394   'var',
11395   '  r: record x: word end;',
11396   'begin']);
11397   SetExpectedPasResolverError('not yet implemented: :TPasRecordType [20190408224556] "anonymous record type"',
11398     nNotYetImplemented);
11399   ConvertProgram;
11400 end;
11401 
11402 procedure TTestModule.TestAdvRecord_Function;
11403 begin
11404   StartProgram(false);
11405   Parser.Options:=Parser.Options+[po_cassignments];
11406   Add([
11407   '{$modeswitch AdvancedRecords}',
11408   'type',
11409   '  TPoint = record',
11410   '    x,y: word;',
11411   '    function Add(const apt: TPoint): TPoint;',
11412   '  end;',
11413   'function TPoint.Add(const apt: TPoint): TPoint;',
11414   'begin',
11415   '  Result:=Self;',
11416   '  Result.x+=apt.x;',
11417   '  Result.y:=Result.y+apt.y;',
11418   '  Self:=apt;',
11419   'end;',
11420   'var p,q: TPoint;',
11421   'begin',
11422   '  p.add(q);',
11423   '  p:=default(TPoint);',
11424   '  p:=q;',
11425   '']);
11426   ConvertProgram;
11427   CheckSource('TestAdvRecord_Function',
11428     LinesToStr([ // statements
11429     'rtl.recNewT($mod, "TPoint", function () {',
11430     '  this.x = 0;',
11431     '  this.y = 0;',
11432     '  this.$eq = function (b) {',
11433     '    return (this.x === b.x) && (this.y === b.y);',
11434     '  };',
11435     '  this.$assign = function (s) {',
11436     '    this.x = s.x;',
11437     '    this.y = s.y;',
11438     '    return this;',
11439     '  };',
11440     '  this.Add = function (apt) {',
11441     '    var Result = $mod.TPoint.$new();',
11442     '    Result.$assign(this);',
11443     '    Result.x += apt.x;',
11444     '    Result.y = Result.y + apt.y;',
11445     '    this.$assign(apt);',
11446     '    return Result;',
11447     '  };',
11448     '});',
11449     'this.p = $mod.TPoint.$new();',
11450     'this.q = $mod.TPoint.$new();',
11451     '']),
11452     LinesToStr([ // $mod.$main
11453     '$mod.p.Add($mod.q);',
11454     '$mod.p.$assign($mod.TPoint.$new());',
11455     '$mod.p.$assign($mod.q);',
11456     '']));
11457 end;
11458 
11459 procedure TTestModule.TestAdvRecord_Property;
11460 begin
11461   StartProgram(false);
11462   Add([
11463   '{$modeswitch AdvancedRecords}',
11464   'type',
11465   '  TPoint = record',
11466   '    x,y: word;',
11467   '  strict private',
11468   '    function GetSize: longword;',
11469   '    procedure SetSize(Value: longword);',
11470   '  public',
11471   '    property Size: longword read GetSize write SetSize;',
11472   '    property Left: word read x write y;',
11473   '  end;',
11474   'procedure SetSize(Value: longword); begin end;',// check auto rename
11475   'function TPoint.GetSize: longword;',
11476   'begin',
11477   '  x:=y;',
11478   '  Size:=Size;',
11479   '  Left:=Left;',
11480   'end;',
11481   'procedure TPoint.SetSize(Value: longword);',
11482   'begin',
11483   'end;',
11484   'var p,q: TPoint;',
11485   'begin',
11486   '  p.Size:=q.Size;',
11487   '  p.Left:=q.Left;',
11488   '']);
11489   ConvertProgram;
11490   CheckSource('TestAdvRecord_Property',
11491     LinesToStr([ // statements
11492     'rtl.recNewT($mod, "TPoint", function () {',
11493     '  this.x = 0;',
11494     '  this.y = 0;',
11495     '  this.$eq = function (b) {',
11496     '    return (this.x === b.x) && (this.y === b.y);',
11497     '  };',
11498     '  this.$assign = function (s) {',
11499     '    this.x = s.x;',
11500     '    this.y = s.y;',
11501     '    return this;',
11502     '  };',
11503     '  this.GetSize = function () {',
11504     '    var Result = 0;',
11505     '    this.x = this.y;',
11506     '    this.SetSize(this.GetSize());',
11507     '    this.y = this.x;',
11508     '    return Result;',
11509     '  };',
11510     '  this.SetSize = function (Value) {',
11511     '  };',
11512     '});',
11513     'this.SetSize = function (Value) {',
11514     '};',
11515     'this.p = $mod.TPoint.$new();',
11516     'this.q = $mod.TPoint.$new();',
11517     '']),
11518     LinesToStr([ // $mod.$main
11519     '$mod.p.SetSize($mod.q.GetSize());',
11520     '$mod.p.y = $mod.q.x;',
11521     '']));
11522 end;
11523 
11524 procedure TTestModule.TestAdvRecord_PropertyDefault;
11525 begin
11526   StartProgram(false);
11527   Add([
11528   '{$modeswitch AdvancedRecords}',
11529   'type',
11530   '  TPoint = record',
11531   '  strict private',
11532   '    function GetItems(Index: word): word;',
11533   '    procedure SetItems(Index: word; Value: word);',
11534   '  public',
11535   '    property Items[Index: word]: word read GetItems write SetItems; default;',
11536   '  end;',
11537   'function TPoint.GetItems(Index: word): word;',
11538   'begin',
11539   '  Items[index]:=Items[index];',
11540   '  self.Items[index]:=self.Items[index];',
11541   'end;',
11542   'procedure TPoint.SetItems(Index: word; Value: word);',
11543   'begin',
11544   'end;',
11545   'var p: TPoint;',
11546   'begin',
11547   '  p[1]:=p[2];',
11548   '  p.Items[3]:=p.Items[4];',
11549   '']);
11550   ConvertProgram;
11551   CheckSource('TestAdvRecord_PropertyDefault',
11552     LinesToStr([ // statements
11553     'rtl.recNewT($mod, "TPoint", function () {',
11554     '  this.$eq = function (b) {',
11555     '    return true;',
11556     '  };',
11557     '  this.$assign = function (s) {',
11558     '    return this;',
11559     '  };',
11560     '  this.GetItems = function (Index) {',
11561     '    var Result = 0;',
11562     '    this.SetItems(Index, this.GetItems(Index));',
11563     '    this.SetItems(Index, this.GetItems(Index));',
11564     '    return Result;',
11565     '  };',
11566     '  this.SetItems = function (Index, Value) {',
11567     '  };',
11568     '});',
11569     'this.p = $mod.TPoint.$new();',
11570     '']),
11571     LinesToStr([ // $mod.$main
11572     '$mod.p.SetItems(1, $mod.p.GetItems(2));',
11573     '$mod.p.SetItems(3, $mod.p.GetItems(4));',
11574     '']));
11575 end;
11576 
11577 procedure TTestModule.TestAdvRecord_Property_ClassMethod;
11578 begin
11579   StartProgram(false);
11580   Add([
11581   '{$modeswitch AdvancedRecords}',
11582   'type',
11583   '  TRec = record',
11584   '    class var',
11585   '      Fx: longint;',
11586   '      Fy: longint;',
11587   '    class function GetInt: longint; static;',
11588   '    class procedure SetInt(Value: longint); static;',
11589   '    class procedure DoIt; static;',
11590   '    class property IntA: longint read Fx write Fy;',
11591   '    class property IntB: longint read GetInt write SetInt;',
11592   '  end;',
11593   'class function trec.getint: longint;',
11594   'begin',
11595   '  result:=fx;',
11596   'end;',
11597   'class procedure trec.setint(value: longint);',
11598   'begin',
11599   'end;',
11600   'class procedure trec.doit;',
11601   'begin',
11602   '  IntA:=IntA+1;',
11603   '  IntB:=IntB+1;',
11604   'end;',
11605   'var r: trec;',
11606   'begin',
11607   '  trec.inta:=trec.inta+1;',
11608   '  if trec.intb=2 then;',
11609   '  trec.intb:=trec.intb+2;',
11610   '  trec.setint(trec.inta);',
11611   '  r.inta:=r.inta+1;',
11612   '  if r.intb=2 then;',
11613   '  r.intb:=r.intb+2;',
11614   '  r.setint(r.inta);']);
11615   ConvertProgram;
11616   CheckSource('TestAdvRecord_Property_ClassMethod',
11617     LinesToStr([ // statements
11618     'rtl.recNewT($mod, "TRec", function () {',
11619     '  this.Fx = 0;',
11620     '  this.Fy = 0;',
11621     '  this.$eq = function (b) {',
11622     '    return true;',
11623     '  };',
11624     '  this.$assign = function (s) {',
11625     '    return this;',
11626     '  };',
11627     '  this.GetInt = function () {',
11628     '    var Result = 0;',
11629     '    Result = $mod.TRec.Fx;',
11630     '    return Result;',
11631     '  };',
11632     '  this.SetInt = function (Value) {',
11633     '  };',
11634     '  this.DoIt = function () {',
11635     '    $mod.TRec.Fy = $mod.TRec.Fx + 1;',
11636     '    $mod.TRec.SetInt($mod.TRec.GetInt() + 1);',
11637     '  };',
11638     '}, true);',
11639     'this.r = $mod.TRec.$new();',
11640     '']),
11641     LinesToStr([ // $mod.$main
11642     '$mod.TRec.Fy = $mod.TRec.Fx + 1;',
11643     'if ($mod.TRec.GetInt() === 2) ;',
11644     '$mod.TRec.SetInt($mod.TRec.GetInt() + 2);',
11645     '$mod.TRec.SetInt($mod.TRec.Fx);',
11646     '$mod.TRec.Fy = $mod.r.Fx + 1;',
11647     'if ($mod.r.GetInt() === 2) ;',
11648     '$mod.r.SetInt($mod.r.GetInt() + 2);',
11649     '$mod.r.SetInt($mod.r.Fx);',
11650     '']));
11651 end;
11652 
11653 procedure TTestModule.TestAdvRecord_Const;
11654 begin
11655   StartProgram(false);
11656   Add([
11657   '{$modeswitch AdvancedRecords}',
11658   'type',
11659   '  TArrInt = array[3..4] of longint;',
11660   '  TPoint = record',
11661   '    x,y: longint;',
11662   '    class var Count: nativeint;',
11663   '  end;',
11664   '  TRec = record',
11665   '    i: longint;',
11666   '    a: array of longint;',
11667   '    s: array[1..2] of longint;',
11668   '    m: array[1..2,3..4] of longint;',
11669   '    p: TPoint;',
11670   '  end;',
11671   '  TPoints = array of TPoint;',
11672   'const',
11673   '  r: TRec = (',
11674   '    i:1;',
11675   '    a:(2,3);',
11676   '    s:(4,5);',
11677   '    m:( (11,12), (13,14) );',
11678   '    p: (x:21)',
11679   '  );',
11680   '  p: TPoints = ( (x:1;y:2), (x:3;y:4) );',
11681   'begin']);
11682   ConvertProgram;
11683   CheckSource('TestAdvRecord_Const',
11684     LinesToStr([ // statements
11685     'rtl.recNewT($mod, "TPoint", function () {',
11686     '  this.x = 0;',
11687     '  this.y = 0;',
11688     '  this.Count = 0;',
11689     '  this.$eq = function (b) {',
11690     '    return (this.x === b.x) && (this.y === b.y);',
11691     '  };',
11692     '  this.$assign = function (s) {',
11693     '    this.x = s.x;',
11694     '    this.y = s.y;',
11695     '    return this;',
11696     '  };',
11697     '}, true);',
11698     'rtl.recNewT($mod, "TRec", function () {',
11699     '  this.i = 0;',
11700     '  this.$new = function () {',
11701     '    var r = Object.create(this);',
11702     '    r.a = [];',
11703     '    r.s = rtl.arraySetLength(null, 0, 2);',
11704     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
11705     '    r.p = $mod.TPoint.$new();',
11706     '    return r;',
11707     '  };',
11708     '  this.$eq = function (b) {',
11709     '    return (this.i === b.i) && (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && this.p.$eq(b.p);',
11710     '  };',
11711     '  this.$assign = function (s) {',
11712     '    this.i = s.i;',
11713     '    this.a = rtl.arrayRef(s.a);',
11714     '    this.s = s.s.slice(0);',
11715     '    this.m = s.m.slice(0);',
11716     '    this.p.$assign(s.p);',
11717     '    return this;',
11718     '  };',
11719     '});',
11720     'this.r = $mod.TRec.$clone({',
11721     '  i: 1,',
11722     '  a: [2, 3],',
11723     '  s: [4, 5],',
11724     '  m: [[11, 12], [13, 14]],',
11725     '  p: $mod.TPoint.$clone({',
11726     '      x: 21,',
11727     '      y: 0',
11728     '    })',
11729     '});',
11730     'this.p = [$mod.TPoint.$clone({',
11731     '  x: 1,',
11732     '  y: 2',
11733     '}), $mod.TPoint.$clone({',
11734     '  x: 3,',
11735     '  y: 4',
11736     '})];',
11737     '']),
11738     LinesToStr([ // $mod.$main
11739     '']));
11740 end;
11741 
11742 procedure TTestModule.TestAdvRecord_ExternalField;
11743 begin
11744   StartProgram(false);
11745   Add([
11746   '{$modeswitch AdvancedRecords}',
11747   '{$modeswitch externalclass}',
11748   'type',
11749   '  TCar = record',
11750   '  public',
11751   '    Intern: longint external name ''$Intern'';',
11752   '    Intern2: longint external name ''$Intern2'';',
11753   '    Bracket: longint external name ''["A B"]'';',
11754   '    procedure DoIt;',
11755   '  end;',
11756   'procedure tcar.doit;',
11757   'begin',
11758   '  Intern:=Intern+1;',
11759   '  Intern2:=Intern2+2;',
11760   '  Bracket:=Bracket+3;',
11761   'end;',
11762   'var Rec: TCar = (intern: 11; intern2: 12; bracket: 13);',
11763   'begin',
11764   '  Rec.intern:=Rec.intern+1;',
11765   '  Rec.intern2:=Rec.intern2+2;',
11766   '  Rec.Bracket:=Rec.Bracket+3;',
11767   '  with Rec do begin',
11768   '    intern:=intern+1;',
11769   '    intern2:=intern2+2;',
11770   '    Bracket:=Bracket+3;',
11771   '  end;']);
11772   ConvertProgram;
11773   CheckSource('TestAdvRecord_ExternalField',
11774     LinesToStr([ // statements
11775     'rtl.recNewT($mod, "TCar", function () {',
11776     '  this.$eq = function (b) {',
11777     '    return (this.$Intern === b.$Intern) && (this.$Intern2 === b.$Intern2) && (this["A B"] === b["A B"]);',
11778     '  };',
11779     '  this.$assign = function (s) {',
11780     '    this.$Intern = s.$Intern;',
11781     '    this.$Intern2 = s.$Intern2;',
11782     '    this["A B"] = s["A B"];',
11783     '    return this;',
11784     '  };',
11785     '  this.DoIt = function () {',
11786     '    this.$Intern = this.$Intern + 1;',
11787     '    this.$Intern2 = this.$Intern2 + 2;',
11788     '    this["A B"] = this["A B"] + 3;',
11789     '  };',
11790     '});',
11791     'this.Rec = $mod.TCar.$clone({',
11792     '  $Intern: 11,',
11793     '  $Intern2: 12,',
11794     '  "A B": 13',
11795     '});',
11796     '']),
11797     LinesToStr([ // $mod.$main
11798     '$mod.Rec.$Intern = $mod.Rec.$Intern + 1;',
11799     '$mod.Rec.$Intern2 = $mod.Rec.$Intern2 + 2;',
11800     '$mod.Rec["A B"] = $mod.Rec["A B"] + 3;',
11801     'var $with = $mod.Rec;',
11802     '$with.$Intern = $with.$Intern + 1;',
11803     '$with.$Intern2 = $with.$Intern2 + 2;',
11804     '$with["A B"] = $with["A B"] + 3;',
11805     '']));
11806 end;
11807 
11808 procedure TTestModule.TestAdvRecord_SubRecord;
11809 begin
11810   StartProgram(false);
11811   Add([
11812   '{$modeswitch AdvancedRecords}',
11813   'type',
11814   '  TRec = record',
11815   '  type',
11816   '    TPoint = record',
11817   '      x,y: longint;',
11818   '      class var Count: nativeint;',
11819   '      procedure DoIt;',
11820   '      class procedure DoThat; static;',
11821   '    end;',
11822   '  var',
11823   '    i: longint;',
11824   '    p: TPoint;',
11825   '    procedure DoSome;',
11826   '  end;',
11827   'const',
11828   '  r: TRec = (',
11829   '    i:1;',
11830   '    p: (x:21;y:22)',
11831   '  );',
11832   'procedure TRec.DoSome;',
11833   'begin',
11834   '  p.x:=p.y+1;',
11835   '  p.Count:=p.Count+2;',
11836   'end;',
11837   'procedure TRec.TPoint.DoIt;',
11838   'begin',
11839   '  Count:=Count+3;',
11840   'end;',
11841   'class procedure TRec.TPoint.DoThat;',
11842   'begin',
11843   '  Count:=Count+4;',
11844   'end;',
11845   'begin']);
11846   ConvertProgram;
11847   CheckSource('TestAdvRecord_SubRecord',
11848     LinesToStr([ // statements
11849     'rtl.recNewT($mod, "TRec", function () {',
11850     '  rtl.recNewT(this, "TPoint", function () {',
11851     '    this.x = 0;',
11852     '    this.y = 0;',
11853     '    this.Count = 0;',
11854     '    this.$eq = function (b) {',
11855     '      return (this.x === b.x) && (this.y === b.y);',
11856     '    };',
11857     '    this.$assign = function (s) {',
11858     '      this.x = s.x;',
11859     '      this.y = s.y;',
11860     '      return this;',
11861     '    };',
11862     '    this.DoIt = function () {',
11863     '      $mod.TRec.TPoint.Count = this.Count + 3;',
11864     '    };',
11865     '    this.DoThat = function () {',
11866     '      $mod.TRec.TPoint.Count = $mod.TRec.TPoint.Count + 4;',
11867     '    };',
11868     '  }, true);',
11869     '  this.i = 0;',
11870     '  this.$new = function () {',
11871     '    var r = Object.create(this);',
11872     '    r.p = this.TPoint.$new();',
11873     '    return r;',
11874     '  };',
11875     '  this.$eq = function (b) {',
11876     '    return (this.i === b.i) && this.p.$eq(b.p);',
11877     '  };',
11878     '  this.$assign = function (s) {',
11879     '    this.i = s.i;',
11880     '    this.p.$assign(s.p);',
11881     '    return this;',
11882     '  };',
11883     '  this.DoSome = function () {',
11884     '    this.p.x = this.p.y + 1;',
11885     '    this.TPoint.Count = this.p.Count + 2;',
11886     '  };',
11887     '}, true);',
11888     'this.r = $mod.TRec.$clone({',
11889     '  i: 1,',
11890     '  p: $mod.TRec.TPoint.$clone({',
11891     '      x: 21,',
11892     '      y: 22',
11893     '    })',
11894     '});',
11895     '']),
11896     LinesToStr([ // $mod.$main
11897     '']));
11898 end;
11899 
11900 procedure TTestModule.TestAdvRecord_SubClass;
11901 begin
11902   StartProgram(false);
11903   Add([
11904   '{$modeswitch AdvancedRecords}',
11905   'type',
11906   '  TObject = class end;',
11907   '  TPoint = record',
11908   '  type',
11909   '    TBird = class',
11910   '      procedure DoIt;',
11911   '      class procedure Glob;',
11912   '    end;',
11913   '    procedure DoIt(b: TBird);',
11914   '  end;',
11915   'procedure TPoint.TBird.DoIt;',
11916   'begin',
11917   '  doit;',
11918   '  self.doit;',
11919   '  glob;',
11920   '  self.glob;',
11921   'end;',
11922   'class procedure TPoint.TBird.Glob;',
11923   'begin',
11924   '  glob;',
11925   '  self.glob;',
11926   'end;',
11927   'procedure TPoint.DoIt(b: TBird);',
11928   'begin',
11929   '  b.doit;',
11930   '  b.glob;',
11931   '  TBird.glob;',
11932   'end;',
11933   'begin',
11934   '']);
11935   ConvertProgram;
11936   CheckSource('TestAdvRecord_SubClass',
11937     LinesToStr([ // statements
11938     'rtl.createClass($mod, "TObject", null, function () {',
11939     '  this.$init = function () {',
11940     '  };',
11941     '  this.$final = function () {',
11942     '  };',
11943     '});',
11944     'rtl.recNewT($mod, "TPoint", function () {',
11945     '  rtl.createClass(this, "TBird", $mod.TObject, function () {',
11946     '    this.DoIt = function () {',
11947     '      this.DoIt();',
11948     '      this.DoIt();',
11949     '      this.$class.Glob();',
11950     '      this.$class.Glob();',
11951     '    };',
11952     '    this.Glob = function () {',
11953     '      this.Glob();',
11954     '      this.Glob();',
11955     '    };',
11956     '  });',
11957     '  this.$eq = function (b) {',
11958     '    return true;',
11959     '  };',
11960     '  this.$assign = function (s) {',
11961     '    return this;',
11962     '  };',
11963     '  this.DoIt = function (b) {',
11964     '    b.DoIt();',
11965     '    b.$class.Glob();',
11966     '    this.TBird.Glob();',
11967     '  };',
11968     '}, true);',
11969     '']),
11970     LinesToStr([ // $mod.$main
11971     '']));
11972 end;
11973 
11974 procedure TTestModule.TestAdvRecord_SubInterfaceFail;
11975 begin
11976   StartProgram(false);
11977   Add([
11978   '{$modeswitch AdvancedRecords}',
11979   'type',
11980   '  IUnknown = interface end;',
11981   '  TPoint = record',
11982   '    type IBird = interface end;',
11983   '  end;',
11984   'begin',
11985   '']);
11986   SetExpectedPasResolverError('not yet implemented: IBird:TPasClassType [20190105143752] "interface inside record"',
11987     nNotYetImplemented);
11988   ParseProgram;
11989 end;
11990 
11991 procedure TTestModule.TestAdvRecord_Constructor;
11992 begin
11993   StartProgram(false);
11994   Add([
11995   '{$modeswitch AdvancedRecords}',
11996   'type',
11997   '  TPoint = record',
11998   '    x,y: longint;',
11999   '    constructor Create(ax: longint; ay: longint = -1);',
12000   '  end;',
12001   'constructor tpoint.create(ax,ay: longint);',
12002   'begin',
12003   '  x:=ax;',
12004   '  self.y:=ay;',
12005   'end;',
12006   'var r: TPoint;',
12007   'begin',
12008   '  r:=TPoint.Create(1,2);',
12009   '  with TPoint do r:=Create(1,2);',
12010   '  r.Create(3);',
12011   '  r:=r.Create(4);',
12012   '']);
12013   ConvertProgram;
12014   CheckSource('TestAdvRecord_Constructor',
12015     LinesToStr([ // statements
12016     'rtl.recNewT($mod, "TPoint", function () {',
12017     '  this.x = 0;',
12018     '  this.y = 0;',
12019     '  this.$eq = function (b) {',
12020     '    return (this.x === b.x) && (this.y === b.y);',
12021     '  };',
12022     '  this.$assign = function (s) {',
12023     '    this.x = s.x;',
12024     '    this.y = s.y;',
12025     '    return this;',
12026     '  };',
12027     '  this.Create = function (ax, ay) {',
12028     '    this.x = ax;',
12029     '    this.y = ay;',
12030     '    return this;',
12031     '  };',
12032     '}, true);',
12033     'this.r = $mod.TPoint.$new();',
12034     '']),
12035     LinesToStr([ // $mod.$main
12036     '$mod.r.$assign($mod.TPoint.$new().Create(1, 2));',
12037     'var $with = $mod.TPoint;',
12038     '$mod.r.$assign($with.$new().Create(1, 2));',
12039     '$mod.r.Create(3, -1);',
12040     '$mod.r.$assign($mod.r.Create(4, -1));',
12041     '']));
12042 end;
12043 
12044 procedure TTestModule.TestAdvRecord_ClassConstructor_Program;
12045 begin
12046   StartProgram(false);
12047   Add([
12048   '{$modeswitch AdvancedRecords}',
12049   'type',
12050   '  TPoint = record',
12051   '    class var x: longint;',
12052   '    class procedure Fly; static;',
12053   '    class constructor Init;',
12054   '  end;',
12055   'var count: word;',
12056   'class procedure Tpoint.Fly;',
12057   'begin',
12058   'end;',
12059   'class constructor tpoint.init;',
12060   'begin',
12061   '  count:=count+1;',
12062   '  x:=x+3;',
12063   '  tpoint.x:=tpoint.x+4;',
12064   '  fly;',
12065   '  tpoint.fly;',
12066   'end;',
12067   'var r: TPoint;',
12068   'begin',
12069   '  r.x:=r.x+10;',
12070   '  r.Fly;',
12071   '  r.Fly();',
12072   '']);
12073   ConvertProgram;
12074   CheckSource('TestAdvRecord_ClassConstructor_Program',
12075     LinesToStr([ // statements
12076     'rtl.recNewT($mod, "TPoint", function () {',
12077     '  this.x = 0;',
12078     '  this.$eq = function (b) {',
12079     '    return true;',
12080     '  };',
12081     '  this.$assign = function (s) {',
12082     '    return this;',
12083     '  };',
12084     '  this.Fly = function () {',
12085     '  };',
12086     '}, true);',
12087     'this.count = 0;',
12088     'this.r = $mod.TPoint.$new();',
12089     '']),
12090     LinesToStr([ // $mod.$main
12091     '(function () {',
12092     '  $mod.count = $mod.count + 1;',
12093     '  $mod.TPoint.x = $mod.TPoint.x + 3;',
12094     '  $mod.TPoint.x = $mod.TPoint.x + 4;',
12095     '  $mod.TPoint.Fly();',
12096     '  $mod.TPoint.Fly();',
12097     '})();',
12098     '$mod.TPoint.x = $mod.r.x + 10;',
12099     '$mod.r.Fly();',
12100     '$mod.r.Fly();',
12101     '']));
12102 end;
12103 
12104 procedure TTestModule.TestAdvRecord_ClassConstructor_Unit;
12105 begin
12106   StartUnit(false);
12107   Add([
12108   'interface',
12109   '{$modeswitch AdvancedRecords}',
12110   'type',
12111   '  TPoint = record',
12112   '    class var x: longint;',
12113   '    class procedure Fly; static;',
12114   '    class constructor Init;',
12115   '  end;',
12116   'implementation',
12117   'var count: word;',
12118   'class procedure Tpoint.Fly;',
12119   'begin',
12120   'end;',
12121   'class constructor tpoint.init;',
12122   'begin',
12123   '  count:=count+1;',
12124   '  x:=3;',
12125   '  tpoint.x:=4;',
12126   '  fly;',
12127   '  tpoint.fly;',
12128   'end;',
12129   '']);
12130   ConvertUnit;
12131   CheckSource('TestAdvRecord_ClassConstructor_Unit',
12132     LinesToStr([ // statements
12133     'var $impl = $mod.$impl;',
12134     'rtl.recNewT($mod, "TPoint", function () {',
12135     '  this.x = 0;',
12136     '  this.$eq = function (b) {',
12137     '    return true;',
12138     '  };',
12139     '  this.$assign = function (s) {',
12140     '    return this;',
12141     '  };',
12142     '  this.Fly = function () {',
12143     '  };',
12144     '}, true);',
12145     '']),
12146     LinesToStr([ // $mod.$init
12147     '(function () {',
12148     '  $impl.count = $impl.count + 1;',
12149     '  $mod.TPoint.x = 3;',
12150     '  $mod.TPoint.x = 4;',
12151     '  $mod.TPoint.Fly();',
12152     '  $mod.TPoint.Fly();',
12153     '})();',
12154     '']),
12155     LinesToStr([ // $mod.$main
12156     '$impl.count = 0;',
12157     '']));
12158 end;
12159 
12160 procedure TTestModule.TestClass_TObjectDefaultConstructor;
12161 begin
12162   StartProgram(false);
12163   Add(['type',
12164   '  TObject = class',
12165   '  public',
12166   '    constructor Create;',
12167   '    destructor Destroy;',
12168   '  end;',
12169   '  TBird = TObject;',
12170   'constructor tobject.create;',
12171   'begin end;',
12172   'destructor tobject.destroy;',
12173   'begin end;',
12174   'var Obj: tobject;',
12175   'begin',
12176   '  obj:=tobject.create;',
12177   '  obj:=tobject.create();',
12178   '  obj:=tbird.create;',
12179   '  obj:=tbird.create();',
12180   '  obj:=obj.create();',
12181   '  obj.destroy;',
12182   '']);
12183   ConvertProgram;
12184   CheckSource('TestClass_TObjectDefaultConstructor',
12185     LinesToStr([ // statements
12186     'rtl.createClass($mod,"TObject",null,function(){',
12187     '  this.$init = function () {',
12188     '  };',
12189     '  this.$final = function () {',
12190     '  };',
12191     '  this.Create = function(){',
12192     '    return this;',
12193     '  };',
12194     '  this.Destroy = function(){',
12195     '  };',
12196     '});',
12197     'this.Obj = null;'
12198     ]),
12199     LinesToStr([ // $mod.$main
12200     '$mod.Obj = $mod.TObject.$create("Create");',
12201     '$mod.Obj = $mod.TObject.$create("Create");',
12202     '$mod.Obj = $mod.TObject.$create("Create");',
12203     '$mod.Obj = $mod.TObject.$create("Create");',
12204     '$mod.Obj = $mod.Obj.Create();',
12205     '$mod.Obj.$destroy("Destroy");',
12206     '']));
12207 end;
12208 
12209 procedure TTestModule.TestClass_TObjectConstructorWithParams;
12210 begin
12211   StartProgram(false);
12212   Add('type');
12213   Add('  TObject = class');
12214   Add('  public');
12215   Add('    constructor Create(Par: longint);');
12216   Add('  end;');
12217   Add('constructor tobject.create(par: longint);');
12218   Add('begin end;');
12219   Add('var Obj: tobject;');
12220   Add('begin');
12221   Add('  obj:=tobject.create(3);');
12222   ConvertProgram;
12223   CheckSource('TestClass_TObjectConstructorWithParams',
12224     LinesToStr([ // statements
12225     'rtl.createClass($mod,"TObject",null,function(){',
12226     '  this.$init = function () {',
12227     '  };',
12228     '  this.$final = function () {',
12229     '  };',
12230     '  this.Create = function(Par){',
12231     '    return this;',
12232     '  };',
12233     '});',
12234     'this.Obj = null;'
12235     ]),
12236     LinesToStr([ // $mod.$main
12237     '$mod.Obj = $mod.TObject.$create("Create",[3]);'
12238     ]));
12239 end;
12240 
12241 procedure TTestModule.TestClass_TObjectConstructorWithDefaultParam;
12242 begin
12243   StartProgram(false);
12244   Add('type');
12245   Add('  TObject = class');
12246   Add('  public');
12247   Add('    constructor Create;');
12248   Add('  end;');
12249   Add('  TTest = class(TObject)');
12250   Add('  public');
12251   Add('    constructor Create(const Par: longint = 1);');
12252   Add('  end;');
12253   Add('constructor tobject.create;');
12254   Add('begin end;');
12255   Add('constructor ttest.create(const par: longint);');
12256   Add('begin end;');
12257   Add('var t: ttest;');
12258   Add('begin');
12259   Add('  t:=ttest.create;');
12260   Add('  t:=ttest.create(2);');
12261   ConvertProgram;
12262   CheckSource('TestClass_TObjectConstructorWithDefaultParam',
12263     LinesToStr([ // statements
12264     'rtl.createClass($mod,"TObject",null,function(){',
12265     '  this.$init = function () {',
12266     '  };',
12267     '  this.$final = function () {',
12268     '  };',
12269     '  this.Create = function(){',
12270     '    return this;',
12271     '  };',
12272     '});',
12273     'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
12274     '  this.Create$1 = function (Par) {',
12275     '    return this;',
12276     '  };',
12277     '});',
12278     'this.t = null;'
12279     ]),
12280     LinesToStr([ // $mod.$main
12281     '$mod.t = $mod.TTest.$create("Create$1", [1]);',
12282     '$mod.t = $mod.TTest.$create("Create$1", [2]);'
12283     ]));
12284 end;
12285 
12286 procedure TTestModule.TestClass_Var;
12287 begin
12288   StartProgram(false);
12289   Add([
12290   'type',
12291   '  TObject = class',
12292   '  public',
12293   '    vI: longint;',
12294   '    constructor Create(Par: longint);',
12295   '  end;',
12296   'constructor tobject.create(par: longint);',
12297   'begin',
12298   '  vi:=par+3',
12299   'end;',
12300   'var Obj: tobject;',
12301   'begin',
12302   '  obj:=tobject.create(4);',
12303   '  obj.vi:=obj.VI+5;']);
12304   ConvertProgram;
12305   CheckSource('TestClass_Var',
12306     LinesToStr([ // statements
12307     'rtl.createClass($mod,"TObject",null,function(){',
12308     '  this.$init = function () {',
12309     '    this.vI = 0;',
12310     '  };',
12311     '  this.$final = function () {',
12312     '  };',
12313     '  this.Create = function(Par){',
12314     '    this.vI = Par+3;',
12315     '    return this;',
12316     '  };',
12317     '});',
12318     'this.Obj = null;'
12319     ]),
12320     LinesToStr([ // $mod.$main
12321     '$mod.Obj = $mod.TObject.$create("Create",[4]);',
12322     '$mod.Obj.vI = $mod.Obj.vI + 5;'
12323     ]));
12324 end;
12325 
12326 procedure TTestModule.TestClass_Method;
12327 begin
12328   StartProgram(false);
12329   Add('type');
12330   Add('  TObject = class');
12331   Add('  public');
12332   Add('    vI: longint;');
12333   Add('    Sub: TObject;');
12334   Add('    constructor Create;');
12335   Add('    function GetIt(Par: longint): tobject;');
12336   Add('  end;');
12337   Add('constructor tobject.create; begin end;');
12338   Add('function tobject.getit(par: longint): tobject;');
12339   Add('begin');
12340   Add('  Self.vi:=par+3;');
12341   Add('  Result:=self.sub;');
12342   Add('end;');
12343   Add('var Obj: tobject;');
12344   Add('begin');
12345   Add('  obj:=tobject.create;');
12346   Add('  obj.getit(4);');
12347   Add('  obj.sub.sub:=nil;');
12348   Add('  obj.sub.getit(5);');
12349   Add('  obj.sub.getit(6).SUB:=nil;');
12350   Add('  obj.sub.getit(7).GETIT(8);');
12351   Add('  obj.sub.getit(9).SuB.getit(10);');
12352   ConvertProgram;
12353   CheckSource('TestClass_Method',
12354     LinesToStr([ // statements
12355     'rtl.createClass($mod,"TObject",null,function(){',
12356     '  this.$init = function () {',
12357     '    this.vI = 0;',
12358     '    this.Sub = null;',
12359     '  };',
12360     '  this.$final = function () {',
12361     '    this.Sub = undefined;',
12362     '  };',
12363     '  this.Create = function(){',
12364     '    return this;',
12365     '  };',
12366     '  this.GetIt = function(Par){',
12367     '    var Result = null;',
12368     '    this.vI = Par + 3;',
12369     '    Result = this.Sub;',
12370     '    return Result;',
12371     '  };',
12372     '});',
12373     'this.Obj = null;'
12374     ]),
12375     LinesToStr([ // $mod.$main
12376     '$mod.Obj = $mod.TObject.$create("Create");',
12377     '$mod.Obj.GetIt(4);',
12378     '$mod.Obj.Sub.Sub=null;',
12379     '$mod.Obj.Sub.GetIt(5);',
12380     '$mod.Obj.Sub.GetIt(6).Sub=null;',
12381     '$mod.Obj.Sub.GetIt(7).GetIt(8);',
12382     '$mod.Obj.Sub.GetIt(9).Sub.GetIt(10);'
12383     ]));
12384 end;
12385 
12386 procedure TTestModule.TestClass_Implementation;
12387 begin
12388   StartUnit(false);
12389   Add([
12390   'interface',
12391   'type',
12392   '  TObject = class',
12393   '    constructor Create;',
12394   '  end;',
12395   'implementation',
12396   'type',
12397   '  TIntClass = class',
12398   '    constructor Create; reintroduce;',
12399   '    class procedure DoGlob;',
12400   '  end;',
12401   'constructor tintclass.create;',
12402   'begin',
12403   '  inherited;',
12404   '  inherited create;',
12405   '  doglob;',
12406   'end;',
12407   'class procedure tintclass.doglob;',
12408   'begin',
12409   'end;',
12410   'constructor tobject.create;',
12411   'var',
12412   '  iC: tintclass;',
12413   'begin',
12414   '  ic:=tintclass.create;',
12415   '  tintclass.doglob;',
12416   '  ic.doglob;',
12417   'end;',
12418   'initialization',
12419   '  tintclass.doglob;',
12420   '']);
12421   ConvertUnit;
12422   CheckSource('TestClass_Implementation',
12423     LinesToStr([ // statements
12424     'var $impl = $mod.$impl;',
12425     'rtl.createClass($mod, "TObject", null, function () {',
12426     '  this.$init = function () {',
12427     '  };',
12428     '  this.$final = function () {',
12429     '  };',
12430     '  this.Create = function () {',
12431     '    var iC = null;',
12432     '    iC = $impl.TIntClass.$create("Create$1");',
12433     '    $impl.TIntClass.DoGlob();',
12434     '    iC.$class.DoGlob();',
12435     '    return this;',
12436     '  };',
12437     '});',
12438     '']),
12439     LinesToStr([ // $mod.$main
12440     '$impl.TIntClass.DoGlob();',
12441     '']),
12442     LinesToStr([
12443     'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
12444     '  this.Create$1 = function () {',
12445     '    $mod.TObject.Create.call(this);',
12446     '    $mod.TObject.Create.call(this);',
12447     '    this.$class.DoGlob();',
12448     '    return this;',
12449     '  };',
12450     '  this.DoGlob = function () {',
12451     '  };',
12452     '});',
12453     '']));
12454 end;
12455 
12456 procedure TTestModule.TestClass_Inheritance;
12457 begin
12458   StartProgram(false);
12459   Add('type');
12460   Add('  TObject = class');
12461   Add('  public');
12462   Add('    constructor Create;');
12463   Add('  end;');
12464   Add('  TClassA = class');
12465   Add('  end;');
12466   Add('  TClassB = class(TObject)');
12467   Add('    procedure ProcB;');
12468   Add('  end;');
12469   Add('constructor tobject.create; begin end;');
12470   Add('procedure tclassb.procb; begin end;');
12471   Add('var');
12472   Add('  oO: TObject;');
12473   Add('  oA: TClassA;');
12474   Add('  oB: TClassB;');
12475   Add('begin');
12476   Add('  oO:=tobject.Create;');
12477   Add('  oA:=tclassa.Create;');
12478   Add('  ob:=tclassb.Create;');
12479   Add('  if oo is tclassa then ;');
12480   Add('  ob:=oo as tclassb;');
12481   Add('  (oo as tclassb).procb;');
12482   ConvertProgram;
12483   CheckSource('TestClass_Inheritance',
12484     LinesToStr([ // statements
12485     'rtl.createClass($mod,"TObject",null,function(){',
12486     '  this.$init = function () {',
12487     '  };',
12488     '  this.$final = function () {',
12489     '  };',
12490     '  this.Create = function () {',
12491     '    return this;',
12492     '  };',
12493     '});',
12494     'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
12495     '});',
12496     'rtl.createClass($mod,"TClassB",$mod.TObject,function(){',
12497     '  this.ProcB = function () {',
12498     '  };',
12499     '});',
12500     'this.oO = null;',
12501     'this.oA = null;',
12502     'this.oB = null;'
12503     ]),
12504     LinesToStr([ // $mod.$main
12505     '$mod.oO = $mod.TObject.$create("Create");',
12506     '$mod.oA = $mod.TClassA.$create("Create");',
12507     '$mod.oB = $mod.TClassB.$create("Create");',
12508     'if ($mod.TClassA.isPrototypeOf($mod.oO));',
12509     '$mod.oB = rtl.as($mod.oO, $mod.TClassB);',
12510     'rtl.as($mod.oO, $mod.TClassB).ProcB();'
12511     ]));
12512 end;
12513 
12514 procedure TTestModule.TestClass_TypeAlias;
12515 begin
12516   StartProgram(false);
12517   Add([
12518   '{$interfaces corba}',
12519   'type',
12520   '  IObject = interface',
12521   '  end;',
12522   '  IBird = type IObject;',
12523   '  TObject = class',
12524   '  end;',
12525   '  TBird = type TObject;',
12526   'var',
12527   '  oObj: TObject;',
12528   '  oBird: TBird;',
12529   '  IntfObj: IObject;',
12530   '  IntfBird: IBird;',
12531   'begin',
12532   '  oObj:=oBird;',
12533   '']);
12534   ConvertProgram;
12535   CheckSource('TestClass_TypeAlias',
12536     LinesToStr([ // statements
12537     'rtl.createInterface($mod, "IObject", "{B92D5841-6F2A-306A-8000-000000000000}", [], null);',
12538     'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-387B-AE88-F10981585074}", [], $mod.IObject);',
12539     'rtl.createClass($mod, "TObject", null, function () {',
12540     '  this.$init = function () {',
12541     '  };',
12542     '  this.$final = function () {',
12543     '  };',
12544     '});',
12545     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
12546     '});',
12547     'this.oObj = null;',
12548     'this.oBird = null;',
12549     'this.IntfObj = null;',
12550     'this.IntfBird = null;',
12551     '']),
12552     LinesToStr([ // $mod.$main
12553     '$mod.oObj = $mod.oBird;',
12554     '']));
12555 end;
12556 
12557 procedure TTestModule.TestClass_AbstractMethod;
12558 begin
12559   StartProgram(false);
12560   Add('type');
12561   Add('  TObject = class');
12562   Add('  public');
12563   Add('    procedure DoIt; virtual; abstract;');
12564   Add('  end;');
12565   Add('begin');
12566   ConvertProgram;
12567   CheckSource('TestClass_AbstractMethod',
12568     LinesToStr([ // statements
12569     'rtl.createClass($mod,"TObject",null,function(){',
12570     '  this.$init = function () {',
12571     '  };',
12572     '  this.$final = function () {',
12573     '  };',
12574     '});'
12575     ]),
12576     LinesToStr([ // this.$main
12577     ''
12578     ]));
12579 end;
12580 
12581 procedure TTestModule.TestClass_CallInherited_ProcNoParams;
12582 begin
12583   StartProgram(false);
12584   Add([
12585   'type',
12586   '  TObject = class',
12587   '    procedure DoAbstract; virtual; abstract;',
12588   '    procedure DoVirtual; virtual;',
12589   '    procedure DoIt;',
12590   '  end;',
12591   '  TA = class',
12592   '    procedure doabstract; override;',
12593   '    procedure dovirtual; override;',
12594   '    procedure DoSome;',
12595   '  end;',
12596   'procedure tobject.dovirtual;',
12597   'begin',
12598   '  inherited; // call non existing ancestor -> ignore silently',
12599   'end;',
12600   'procedure tobject.doit;',
12601   'begin',
12602   'end;',
12603   'procedure ta.doabstract;',
12604   'begin',
12605   '  inherited dovirtual; // call TObject.DoVirtual',
12606   'end;',
12607   'procedure ta.dovirtual;',
12608   'begin',
12609   '  inherited; // call TObject.DoVirtual',
12610   '  inherited dovirtual; // call TObject.DoVirtual',
12611   '  inherited dovirtual(); // call TObject.DoVirtual',
12612   '  doit;',
12613   '  doit();',
12614   'end;',
12615   'procedure ta.dosome;',
12616   'begin',
12617   '  inherited; // call non existing ancestor method -> silently ignore',
12618   'end;',
12619   'begin']);
12620   ConvertProgram;
12621   CheckSource('TestClass_CallInherited_ProcNoParams',
12622     LinesToStr([ // statements
12623     'rtl.createClass($mod,"TObject",null,function(){',
12624     '  this.$init = function () {',
12625     '  };',
12626     '  this.$final = function () {',
12627     '  };',
12628     '  this.DoVirtual = function () {',
12629     '  };',
12630     '  this.DoIt = function () {',
12631     '  };',
12632     '});',
12633     'rtl.createClass($mod, "TA", $mod.TObject, function () {',
12634     '  this.DoAbstract = function () {',
12635     '    $mod.TObject.DoVirtual.call(this);',
12636     '  };',
12637     '  this.DoVirtual = function () {',
12638     '    $mod.TObject.DoVirtual.call(this);',
12639     '    $mod.TObject.DoVirtual.call(this);',
12640     '    $mod.TObject.DoVirtual.call(this);',
12641     '    this.DoIt();',
12642     '    this.DoIt();',
12643     '  };',
12644     '  this.DoSome = function () {',
12645     '  };',
12646     '});'
12647     ]),
12648     LinesToStr([ // this.$main
12649     ''
12650     ]));
12651 end;
12652 
12653 procedure TTestModule.TestClass_CallInherited_WithParams;
12654 begin
12655   StartProgram(false);
12656   Add([
12657   'type',
12658   '  TObject = class',
12659   '    procedure DoAbstract(pA: longint; pB: longint = 0); virtual; abstract;',
12660   '    procedure DoVirtual(pA: longint; pB: longint = 0); virtual;',
12661   '    procedure DoIt(pA: longint; pB: longint = 0);',
12662   '    procedure DoIt2(pA: longint = 1; pB: longint = 2);',
12663   '    function GetIt(pA: longint = 1; pB: longint = 2): longint;',
12664   '  end;',
12665   '  TClassA = class',
12666   '    procedure DoAbstract(pA: longint; pB: longint = 0); override;',
12667   '    procedure DoVirtual(pA: longint; pB: longint = 0); override;',
12668   '    function GetIt(pA: longint = 1; pB: longint = 2): longint;',
12669   '  end;',
12670   'procedure tobject.dovirtual(pa: longint; pb: longint = 0);',
12671   'begin',
12672   'end;',
12673   'procedure tobject.doit(pa: longint; pb: longint = 0);',
12674   'begin',
12675   'end;',
12676   'procedure tobject.doit2(pa: longint; pb: longint = 0);',
12677   'begin',
12678   'end;',
12679   'function tobject.getit(pa: longint; pb: longint = 0): longint;',
12680   'begin',
12681   'end;',
12682   'procedure tclassa.doabstract(pa: longint; pb: longint = 0);',
12683   'begin',
12684   '  inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)',
12685   '  inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)',
12686   'end;',
12687   'procedure tclassa.dovirtual(pa: longint; pb: longint = 0);',
12688   'begin',
12689   '  inherited; // call TObject.DoVirtual(pA,pB)',
12690   '  inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)',
12691   '  inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)',
12692   '  doit(pa,pb);',
12693   '  doit(pa);',
12694   '  doit2(pa);',
12695   '  doit2;',
12696   'end;',
12697   'function tclassa.getit(pa: longint; pb: longint = 0): longint;',
12698   'begin',
12699   '  pa:=inherited;',
12700   'end;',
12701   'begin']);
12702   ConvertProgram;
12703   CheckSource('TestClass_CallInherited_WithParams',
12704     LinesToStr([ // statements
12705     'rtl.createClass($mod,"TObject",null,function(){',
12706     '  this.$init = function () {',
12707     '  };',
12708     '  this.$final = function () {',
12709     '  };',
12710     '  this.DoVirtual = function (pA,pB) {',
12711     '  };',
12712     '  this.DoIt = function (pA,pB) {',
12713     '  };',
12714     '  this.DoIt2 = function (pA,pB) {',
12715     '  };',
12716     '  this.GetIt = function (pA, pB) {',
12717     '    var Result = 0;',
12718     '    return Result;',
12719     '  };',
12720     '});',
12721     'rtl.createClass($mod, "TClassA", $mod.TObject, function () {',
12722     '  this.DoAbstract = function (pA,pB) {',
12723     '    $mod.TObject.DoVirtual.call(this,pA,pB);',
12724     '    $mod.TObject.DoVirtual.call(this,pA,0);',
12725     '  };',
12726     '  this.DoVirtual = function (pA,pB) {',
12727     '    $mod.TObject.DoVirtual.apply(this, arguments);',
12728     '    $mod.TObject.DoVirtual.call(this,pA,pB);',
12729     '    $mod.TObject.DoVirtual.call(this,pA,0);',
12730     '    this.DoIt(pA,pB);',
12731     '    this.DoIt(pA,0);',
12732     '    this.DoIt2(pA,2);',
12733     '    this.DoIt2(1,2);',
12734     '  };',
12735     '  this.GetIt$1 = function (pA, pB) {',
12736     '    var Result = 0;',
12737     '    pA = $mod.TObject.GetIt.apply(this, arguments);',
12738     '    return Result;',
12739     '  };',
12740     '});'
12741     ]),
12742     LinesToStr([ // this.$main
12743     ''
12744     ]));
12745 end;
12746 
12747 procedure TTestModule.TestClasS_CallInheritedConstructor;
12748 begin
12749   StartProgram(false);
12750   Add('type');
12751   Add('  TObject = class');
12752   Add('    constructor Create; virtual;');
12753   Add('    constructor CreateWithB(b: boolean);');
12754   Add('  end;');
12755   Add('  TA = class');
12756   Add('    constructor Create; override;');
12757   Add('    constructor CreateWithC(c: char);');
12758   Add('    procedure DoIt;');
12759   Add('    class function DoSome: TObject;');
12760   Add('  end;');
12761   Add('constructor tobject.create;');
12762   Add('begin');
12763   Add('  inherited; // call non existing ancestor -> ignore silently');
12764   Add('end;');
12765   Add('constructor tobject.createwithb(b: boolean);');
12766   Add('begin');
12767   Add('  inherited; // call non existing ancestor -> ignore silently');
12768   Add('  create; // normal call');
12769   Add('end;');
12770   Add('constructor ta.create;');
12771   Add('begin');
12772   Add('  inherited; // normal call TObject.Create');
12773   Add('  inherited create; // normal call TObject.Create');
12774   Add('  inherited createwithb(false); // normal call TObject.CreateWithB');
12775   Add('end;');
12776   Add('constructor ta.createwithc(c: char);');
12777   Add('begin');
12778   Add('  inherited create; // call TObject.Create');
12779   Add('  inherited createwithb(true); // call TObject.CreateWithB');
12780   Add('  doit;');
12781   Add('  doit();');
12782   Add('  dosome;');
12783   Add('end;');
12784   Add('procedure ta.doit;');
12785   Add('begin');
12786   Add('  create; // normal call');
12787   Add('  createwithb(false); // normal call');
12788   Add('  createwithc(''c''); // normal call');
12789   Add('end;');
12790   Add('class function ta.dosome: TObject;');
12791   Add('begin');
12792   Add('  Result:=create; // constructor');
12793   Add('  Result:=createwithb(true); // constructor');
12794   Add('  Result:=createwithc(''c''); // constructor');
12795   Add('end;');
12796   Add('begin');
12797   ConvertProgram;
12798   CheckSource('TestClass_CallInheritedConstructor',
12799     LinesToStr([ // statements
12800     'rtl.createClass($mod,"TObject",null,function(){',
12801     '  this.$init = function () {',
12802     '  };',
12803     '  this.$final = function () {',
12804     '  };',
12805     '  this.Create = function () {',
12806     '    return this;',
12807     '  };',
12808     '  this.CreateWithB = function (b) {',
12809     '    this.Create();',
12810     '    return this;',
12811     '  };',
12812     '});',
12813     'rtl.createClass($mod, "TA", $mod.TObject, function () {',
12814     '  this.Create = function () {',
12815     '    $mod.TObject.Create.call(this);',
12816     '    $mod.TObject.Create.call(this);',
12817     '    $mod.TObject.CreateWithB.call(this, false);',
12818     '    return this;',
12819     '  };',
12820     '  this.CreateWithC = function (c) {',
12821     '    $mod.TObject.Create.call(this);',
12822     '    $mod.TObject.CreateWithB.call(this, true);',
12823     '    this.DoIt();',
12824     '    this.DoIt();',
12825     '    this.$class.DoSome();',
12826     '    return this;',
12827     '  };',
12828     '  this.DoIt = function () {',
12829     '    this.Create();',
12830     '    this.CreateWithB(false);',
12831     '    this.CreateWithC("c");',
12832     '  };',
12833     '  this.DoSome = function () {',
12834     '    var Result = null;',
12835     '    Result = this.$create("Create");',
12836     '    Result = this.$create("CreateWithB", [true]);',
12837     '    Result = this.$create("CreateWithC", ["c"]);',
12838     '    return Result;',
12839     '  };',
12840     '});'
12841     ]),
12842     LinesToStr([ // this.$main
12843     ''
12844     ]));
12845 end;
12846 
12847 procedure TTestModule.TestClass_ClassVar_Assign;
12848 begin
12849   StartProgram(false);
12850   Add([
12851   'type',
12852   '  TObject = class',
12853   '  public',
12854   '    class var vI: longint;',
12855   '    class var Sub: TObject;',
12856   '    constructor Create;',
12857   '    class function GetIt(var Par: longint): tobject;',
12858   '  end;',
12859   'constructor tobject.create;',
12860   'begin',
12861   '  vi:=vi+1;',
12862   '  Self.vi:=Self.vi+1;',
12863   '  inc(vi);',
12864   'end;',
12865   'class function tobject.getit(var par: longint): tobject;',
12866   'begin',
12867   '  vi:=vi+3;',
12868   '  Self.vi:=Self.vi+4;',
12869   '  inc(vi);',
12870   '  Result:=self.sub;',
12871   '  GetIt(vi);',
12872   'end;',
12873   'var Obj: tobject;',
12874   'begin',
12875   '  obj:=tobject.create;',
12876   '  tobject.vi:=3;',
12877   '  if tobject.vi=4 then ;',
12878   '  tobject.sub:=nil;',
12879   '  obj.sub:=nil;',
12880   '  obj.sub.sub:=nil;']);
12881   ConvertProgram;
12882   CheckSource('TestClass_ClassVar_Assign',
12883     LinesToStr([ // statements
12884     'rtl.createClass($mod,"TObject",null,function(){',
12885     '  this.vI = 0;',
12886     '  this.Sub = null;',
12887     '  this.$init = function () {',
12888     '  };',
12889     '  this.$final = function () {',
12890     '  };',
12891     '  this.Create = function(){',
12892     '    $mod.TObject.vI = this.vI+1;',
12893     '    $mod.TObject.vI = this.vI+1;',
12894     '    $mod.TObject.vI += 1;',
12895     '    return this;',
12896     '  };',
12897     '  this.GetIt = function(Par){',
12898     '    var Result = null;',
12899     '    $mod.TObject.vI = this.vI + 3;',
12900     '    $mod.TObject.vI = this.vI + 4;',
12901     '    $mod.TObject.vI += 1;',
12902     '    Result = this.Sub;',
12903     '    this.GetIt({',
12904     '      p: $mod.TObject,',
12905     '      get: function () {',
12906     '          return this.p.vI;',
12907     '        },',
12908     '      set: function (v) {',
12909     '          this.p.vI = v;',
12910     '        }',
12911     '    });',
12912     '    return Result;',
12913     '  };',
12914     '});',
12915     'this.Obj = null;'
12916     ]),
12917     LinesToStr([ // $mod.$main
12918     '$mod.Obj = $mod.TObject.$create("Create");',
12919     '$mod.TObject.vI = 3;',
12920     'if ($mod.TObject.vI === 4);',
12921     '$mod.TObject.Sub=null;',
12922     '$mod.TObject.Sub=null;',
12923     '$mod.TObject.Sub=null;',
12924     '']));
12925 end;
12926 
12927 procedure TTestModule.TestClass_CallClassMethod;
12928 begin
12929   StartProgram(false);
12930   Add('type');
12931   Add('  TObject = class');
12932   Add('  public');
12933   Add('    class var vI: longint;');
12934   Add('    class var Sub: TObject;');
12935   Add('    constructor Create;');
12936   Add('    function GetMore(Par: longint): longint;');
12937   Add('    class function GetIt(Par: longint): tobject;');
12938   Add('  end;');
12939   Add('constructor tobject.create;');
12940   Add('begin');
12941   Add('  sub:=getit(3);');
12942   Add('  vi:=getmore(4);');
12943   Add('  sub:=Self.getit(5);');
12944   Add('  vi:=Self.getmore(6);');
12945   Add('end;');
12946   Add('function tobject.getmore(par: longint): longint;');
12947   Add('begin');
12948   Add('  sub:=getit(11);');
12949   Add('  vi:=getmore(12);');
12950   Add('  sub:=self.getit(13);');
12951   Add('  vi:=self.getmore(14);');
12952   Add('end;');
12953   Add('class function tobject.getit(par: longint): tobject;');
12954   Add('begin');
12955   Add('  sub:=getit(21);');
12956   Add('  vi:=sub.getmore(22);');
12957   Add('  sub:=self.getit(23);');
12958   Add('  vi:=self.sub.getmore(24);');
12959   Add('end;');
12960   Add('var Obj: tobject;');
12961   Add('begin');
12962   Add('  obj:=tobject.create;');
12963   Add('  tobject.getit(5);');
12964   Add('  obj.getit(6);');
12965   Add('  obj.sub.getit(7);');
12966   Add('  obj.sub.getit(8).SUB:=nil;');
12967   Add('  obj.sub.getit(9).GETIT(10);');
12968   Add('  obj.sub.getit(11).SuB.getit(12);');
12969   ConvertProgram;
12970   CheckSource('TestClass_CallClassMethod',
12971     LinesToStr([ // statements
12972     'rtl.createClass($mod,"TObject",null,function(){',
12973     '  this.vI = 0;',
12974     '  this.Sub = null;',
12975     '  this.$init = function () {',
12976     '  };',
12977     '  this.$final = function () {',
12978     '  };',
12979     '  this.Create = function(){',
12980     '    $mod.TObject.Sub = this.$class.GetIt(3);',
12981     '    $mod.TObject.vI = this.GetMore(4);',
12982     '    $mod.TObject.Sub = this.$class.GetIt(5);',
12983     '    $mod.TObject.vI = this.GetMore(6);',
12984     '    return this;',
12985     '  };',
12986     '  this.GetMore = function(Par){',
12987     '    var Result = 0;',
12988     '    $mod.TObject.Sub = this.$class.GetIt(11);',
12989     '    $mod.TObject.vI = this.GetMore(12);',
12990     '    $mod.TObject.Sub = this.$class.GetIt(13);',
12991     '    $mod.TObject.vI = this.GetMore(14);',
12992     '    return Result;',
12993     '  };',
12994     '  this.GetIt = function(Par){',
12995     '    var Result = null;',
12996     '    $mod.TObject.Sub = this.GetIt(21);',
12997     '    $mod.TObject.vI = this.Sub.GetMore(22);',
12998     '    $mod.TObject.Sub = this.GetIt(23);',
12999     '    $mod.TObject.vI = this.Sub.GetMore(24);',
13000     '    return Result;',
13001     '  };',
13002     '});',
13003     'this.Obj = null;'
13004     ]),
13005     LinesToStr([ // $mod.$main
13006     '$mod.Obj = $mod.TObject.$create("Create");',
13007     '$mod.TObject.GetIt(5);',
13008     '$mod.Obj.$class.GetIt(6);',
13009     '$mod.Obj.Sub.$class.GetIt(7);',
13010     '$mod.TObject.Sub=null;',
13011     '$mod.Obj.Sub.$class.GetIt(9).$class.GetIt(10);',
13012     '$mod.Obj.Sub.$class.GetIt(11).Sub.$class.GetIt(12);',
13013     '']));
13014 end;
13015 
13016 procedure TTestModule.TestClass_Property;
13017 begin
13018   StartProgram(false);
13019   Add('type');
13020   Add('  TObject = class');
13021   Add('    Fx: longint;');
13022   Add('    Fy: longint;');
13023   Add('    function GetInt: longint;');
13024   Add('    procedure SetInt(Value: longint);');
13025   Add('    procedure DoIt;');
13026   Add('    property IntA: longint read Fx write Fy;');
13027   Add('    property IntB: longint read GetInt write SetInt;');
13028   Add('  end;');
13029   Add('function tobject.getint: longint;');
13030   Add('begin');
13031   Add('  result:=fx;');
13032   Add('end;');
13033   Add('procedure tobject.setint(value: longint);');
13034   Add('begin');
13035   Add('  if value=fy then exit;');
13036   Add('  fy:=value;');
13037   Add('end;');
13038   Add('procedure tobject.doit;');
13039   Add('begin');
13040   Add('  IntA:=IntA+1;');
13041   Add('  Self.IntA:=Self.IntA+1;');
13042   Add('  IntB:=IntB+1;');
13043   Add('  Self.IntB:=Self.IntB+1;');
13044   Add('end;');
13045   Add('var Obj: tobject;');
13046   Add('begin');
13047   Add('  obj.inta:=obj.inta+1;');
13048   Add('  if obj.intb=2 then;');
13049   Add('  obj.intb:=obj.intb+2;');
13050   Add('  obj.setint(obj.inta);');
13051   ConvertProgram;
13052   CheckSource('TestClass_Property',
13053     LinesToStr([ // statements
13054     'rtl.createClass($mod, "TObject", null, function () {',
13055     '  this.$init = function () {',
13056     '    this.Fx = 0;',
13057     '    this.Fy = 0;',
13058     '  };',
13059     '  this.$final = function () {',
13060     '  };',
13061     '  this.GetInt = function () {',
13062     '    var Result = 0;',
13063     '    Result = this.Fx;',
13064     '    return Result;',
13065     '  };',
13066     '  this.SetInt = function (Value) {',
13067     '    if (Value === this.Fy) return;',
13068     '    this.Fy = Value;',
13069     '  };',
13070     '  this.DoIt = function () {',
13071     '    this.Fy = this.Fx + 1;',
13072     '    this.Fy = this.Fx + 1;',
13073     '    this.SetInt(this.GetInt() + 1);',
13074     '    this.SetInt(this.GetInt() + 1);',
13075     '  };',
13076     '});',
13077     'this.Obj = null;'
13078     ]),
13079     LinesToStr([ // $mod.$main
13080     '$mod.Obj.Fy = $mod.Obj.Fx + 1;',
13081     'if ($mod.Obj.GetInt() === 2);',
13082     '$mod.Obj.SetInt($mod.Obj.GetInt() + 2);',
13083     '$mod.Obj.SetInt($mod.Obj.Fx);'
13084     ]));
13085 end;
13086 
13087 procedure TTestModule.TestClass_Property_ClassMethod;
13088 begin
13089   StartProgram(false);
13090   Add([
13091   'type',
13092   '  TObject = class',
13093   '    class var Fx: longint;',
13094   '    class var Fy: longint;',
13095   '    class function GetInt: longint;',
13096   '    class procedure SetInt(Value: longint);',
13097   '  end;',
13098   '  TBird = class',
13099   '    class procedure DoIt;',
13100   '    class property IntA: longint read Fx write Fy;',
13101   '    class property IntB: longint read GetInt write SetInt;',
13102   '  end;',
13103   'class function tobject.getint: longint;',
13104   'begin',
13105   '  result:=fx;',
13106   'end;',
13107   'class procedure tobject.setint(value: longint);',
13108   'begin',
13109   'end;',
13110   'class procedure tbird.doit;',
13111   'begin',
13112   '  FX:=3;',
13113   '  IntA:=IntA+1;',
13114   '  Self.IntA:=Self.IntA+1;',
13115   '  IntB:=IntB+1;',
13116   '  Self.IntB:=Self.IntB+1;',
13117   '  with Self do begin',
13118   '    FX:=11;',
13119   '    IntA:=IntA+12;',
13120   '    IntB:=IntB+13;',
13121   '  end;',
13122   'end;',
13123   'var Obj: tbird;',
13124   'begin',
13125   '  tbird.fx:=tbird.fx+1;',
13126   '  tbird.inta:=tbird.inta+1;',
13127   '  if tbird.intb=2 then;',
13128   '  tbird.intb:=tbird.intb+2;',
13129   '  tbird.setint(tbird.inta);',
13130   '  obj.inta:=obj.inta+1;',
13131   '  if obj.intb=2 then;',
13132   '  obj.intb:=obj.intb+2;',
13133   '  obj.setint(obj.inta);',
13134   '  with Tbird do begin',
13135   '    FX:=FY+1;',
13136   '    inta:=inta+2;',
13137   '    intb:=intb+3;',
13138   '  end;',
13139   '  with Obj do begin',
13140   '    FX:=FY+1;',
13141   '    inta:=inta+2;',
13142   '    intb:=intb+3;',
13143   '  end;',
13144   '']);
13145   ConvertProgram;
13146   CheckSource('TestClass_Property_ClassMethod',
13147     LinesToStr([ // statements
13148     'rtl.createClass($mod, "TObject", null, function () {',
13149     '  this.Fx = 0;',
13150     '  this.Fy = 0;',
13151     '  this.$init = function () {',
13152     '  };',
13153     '  this.$final = function () {',
13154     '  };',
13155     '  this.GetInt = function () {',
13156     '    var Result = 0;',
13157     '    Result = this.Fx;',
13158     '    return Result;',
13159     '  };',
13160     '  this.SetInt = function (Value) {',
13161     '  };',
13162     '});',
13163     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
13164     '  this.DoIt = function () {',
13165     '    $mod.TObject.Fx = 3;',
13166     '    $mod.TObject.Fy = this.Fx + 1;',
13167     '    $mod.TObject.Fy = this.Fx + 1;',
13168     '    this.SetInt(this.GetInt() + 1);',
13169     '    this.SetInt(this.GetInt() + 1);',
13170     '    $mod.TObject.Fx = 11;',
13171     '    $mod.TObject.Fy = this.Fx + 12;',
13172     '    this.SetInt(this.GetInt() + 13);',
13173     '  };',
13174     '});',
13175     'this.Obj = null;'
13176     ]),
13177     LinesToStr([ // $mod.$main
13178     '$mod.TObject.Fx = $mod.TBird.Fx + 1;',
13179     '$mod.TObject.Fy = $mod.TBird.Fx + 1;',
13180     'if ($mod.TBird.GetInt() === 2);',
13181     '$mod.TBird.SetInt($mod.TBird.GetInt() + 2);',
13182     '$mod.TBird.SetInt($mod.TBird.Fx);',
13183     '$mod.TObject.Fy = $mod.Obj.Fx + 1;',
13184     'if ($mod.Obj.$class.GetInt() === 2);',
13185     '$mod.Obj.$class.SetInt($mod.Obj.$class.GetInt() + 2);',
13186     '$mod.Obj.$class.SetInt($mod.Obj.Fx);',
13187     'var $with = $mod.TBird;',
13188     '$mod.TObject.Fx = $with.Fy + 1;',
13189     '$mod.TObject.Fy = $with.Fx + 2;',
13190     '$with.SetInt($with.GetInt() + 3);',
13191     'var $with1 = $mod.Obj;',
13192     '$mod.TObject.Fx = $with1.Fy + 1;',
13193     '$mod.TObject.Fy = $with1.Fx + 2;',
13194     '$with1.$class.SetInt($with1.$class.GetInt() + 3);',
13195     '']));
13196 end;
13197 
13198 procedure TTestModule.TestClass_Property_Indexed;
13199 begin
13200   StartProgram(false);
13201   Add([
13202   'type',
13203   '  TObject = class',
13204   '    FItems: array of longint;',
13205   '    function GetItems(Index: longint): longint;',
13206   '    procedure SetItems(Index: longint; Value: longint);',
13207   '    procedure DoIt;',
13208   '    property Items[Index: longint]: longint read getitems write setitems;',
13209   '  end;',
13210   'function tobject.getitems(index: longint): longint;',
13211   'begin',
13212   '  Result:=fitems[index];',
13213   'end;',
13214   'procedure tobject.setitems(index: longint; value: longint);',
13215   'begin',
13216   '  fitems[index]:=value;',
13217   'end;',
13218   'procedure tobject.doit;',
13219   'begin',
13220   '  items[1]:=2;',
13221   '  items[3]:=items[4];',
13222   '  self.items[5]:=self.items[6];',
13223   '  items[items[7]]:=items[items[8]];',
13224   'end;',
13225   'var Obj: tobject;',
13226   'begin',
13227   '  obj.Items[11]:=obj.Items[12];',
13228   '']);
13229   ConvertProgram;
13230   CheckSource('TestClass_Property_Indexed',
13231     LinesToStr([ // statements
13232     'rtl.createClass($mod, "TObject", null, function () {',
13233     '  this.$init = function () {',
13234     '    this.FItems = [];',
13235     '  };',
13236     '  this.$final = function () {',
13237     '    this.FItems = undefined;',
13238     '  };',
13239     '  this.GetItems = function (Index) {',
13240     '    var Result = 0;',
13241     '    Result = this.FItems[Index];',
13242     '    return Result;',
13243     '  };',
13244     '  this.SetItems = function (Index, Value) {',
13245     '    this.FItems[Index] = Value;',
13246     '  };',
13247     '  this.DoIt = function () {',
13248     '    this.SetItems(1, 2);',
13249     '    this.SetItems(3,this.GetItems(4));',
13250     '    this.SetItems(5,this.GetItems(6));',
13251     '    this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
13252     '  };',
13253     '});',
13254     'this.Obj = null;'
13255     ]),
13256     LinesToStr([ // $mod.$main
13257     '$mod.Obj.SetItems(11,$mod.Obj.GetItems(12));'
13258     ]));
13259 end;
13260 
13261 procedure TTestModule.TestClass_Property_IndexSpec;
13262 begin
13263   StartProgram(false);
13264   Add([
13265   'type',
13266   '  TEnum = (red, blue);',
13267   '  TObject = class',
13268   '    function GetIntBool(Index: longint): boolean; virtual; abstract;',
13269   '    procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
13270   '    function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
13271   '    procedure SetEnumBool(Index: TEnum; b: boolean); virtual; abstract;',
13272   '    function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
13273   '    procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
13274   '    property B1: boolean index 1 read GetIntBool write SetIntBool;',
13275   '    property B2: boolean index TEnum.blue read GetEnumBool write SetEnumBool;',
13276   '    property B3: boolean index ord(red) read GetIntBool write SetIntBool;',
13277   '    property I1[A: String]: boolean index ord(blue) read GetStrIntBool write SetStrIntBool;',
13278   '  end;',
13279   'procedure DoIt(b: boolean); begin end;',
13280   'var',
13281   '  o: TObject;',
13282   'begin',
13283   '  o.B1:=o.B1;',
13284   '  o.B2:=o.B2;',
13285   '  o.B3:=o.B3;',
13286   '  o.I1[''a'']:=o.I1[''b''];',
13287   '  doit(o.b1);',
13288   '  doit(o.b2);',
13289   '  doit(o.i1[''c'']);',
13290   '']);
13291   ConvertProgram;
13292   CheckSource('TestClass_Property_IndexSpec',
13293     LinesToStr([ // statements
13294     'this.TEnum = {',
13295     '  "0": "red",',
13296     '  red: 0,',
13297     '  "1": "blue",',
13298     '  blue: 1',
13299     '};',
13300     'rtl.createClass($mod, "TObject", null, function () {',
13301     '  this.$init = function () {',
13302     '  };',
13303     '  this.$final = function () {',
13304     '  };',
13305     '});',
13306     'this.DoIt = function (b) {',
13307     '};',
13308     'this.o = null;',
13309     '']),
13310     LinesToStr([ // $mod.$main
13311     '$mod.o.SetIntBool(1, $mod.o.GetIntBool(1));',
13312     '$mod.o.SetEnumBool($mod.TEnum.blue, $mod.o.GetEnumBool($mod.TEnum.blue));',
13313     '$mod.o.SetIntBool(0, $mod.o.GetIntBool(0));',
13314     '$mod.o.SetStrIntBool("a", 1, $mod.o.GetStrIntBool("b", 1));',
13315     '$mod.DoIt($mod.o.GetIntBool(1));',
13316     '$mod.DoIt($mod.o.GetEnumBool($mod.TEnum.blue));',
13317     '$mod.DoIt($mod.o.GetStrIntBool("c", 1));',
13318     '']));
13319 end;
13320 
13321 procedure TTestModule.TestClass_PropertyOfTypeArray;
13322 begin
13323   StartProgram(false);
13324   Add('type');
13325   Add('  TArray = array of longint;');
13326   Add('  TObject = class');
13327   Add('    FItems: TArray;');
13328   Add('    function GetItems: tarray;');
13329   Add('    procedure SetItems(Value: tarray);');
13330   Add('    property Items: tarray read getitems write setitems;');
13331   Add('    procedure SetNumbers(const Value: tarray);');
13332   Add('    property Numbers: tarray write setnumbers;');
13333   Add('  end;');
13334   Add('function tobject.getitems: tarray;');
13335   Add('begin');
13336   Add('  Result:=fitems;');
13337   Add('end;');
13338   Add('procedure tobject.setitems(value: tarray);');
13339   Add('begin');
13340   Add('  fitems:=value;');
13341   Add('  fitems:=nil;');
13342   Add('  Items:=nil;');
13343   Add('  Items:=Items;');
13344   Add('  Items[1]:=2;');
13345   Add('  fitems[3]:=Items[4];');
13346   Add('  Items[5]:=Items[6];');
13347   Add('  Self.Items[7]:=8;');
13348   Add('  Self.Items[9]:=Self.Items[10];');
13349   Add('  Items[Items[11]]:=Items[Items[12]];');
13350   Add('end;');
13351   Add('procedure tobject.SetNumbers(const Value: tarray);');
13352   Add('begin;');
13353   Add('  Numbers:=nil;');
13354   Add('  Numbers:=Value;');
13355   Add('  Self.Numbers:=Value;');
13356   Add('end;');
13357   Add('var Obj: tobject;');
13358   Add('begin');
13359   Add('  obj.items:=nil;');
13360   Add('  obj.items:=obj.items;');
13361   Add('  obj.items[11]:=obj.items[12];');
13362   ConvertProgram;
13363   CheckSource('TestClass_PropertyOfTypeArray',
13364     LinesToStr([ // statements
13365     'rtl.createClass($mod, "TObject", null, function () {',
13366     '  this.$init = function () {',
13367     '    this.FItems = [];',
13368     '  };',
13369     '  this.$final = function () {',
13370     '    this.FItems = undefined;',
13371     '  };',
13372     '  this.GetItems = function () {',
13373     '    var Result = [];',
13374     '    Result = rtl.arrayRef(this.FItems);',
13375     '    return Result;',
13376     '  };',
13377     '  this.SetItems = function (Value) {',
13378     '    this.FItems = rtl.arrayRef(Value);',
13379     '    this.FItems = [];',
13380     '    this.SetItems([]);',
13381     '    this.SetItems(rtl.arrayRef(this.GetItems()));',
13382     '    this.GetItems()[1] = 2;',
13383     '    this.FItems[3] = this.GetItems()[4];',
13384     '    this.GetItems()[5] = this.GetItems()[6];',
13385     '    this.GetItems()[7] = 8;',
13386     '    this.GetItems()[9] = this.GetItems()[10];',
13387     '    this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
13388     '  };',
13389     '  this.SetNumbers = function (Value) {',
13390     '    this.SetNumbers([]);',
13391     '    this.SetNumbers(Value);',
13392     '    this.SetNumbers(Value);',
13393     '  };',
13394     '});',
13395     'this.Obj = null;'
13396     ]),
13397     LinesToStr([ // $mod.$main
13398     '$mod.Obj.SetItems([]);',
13399     '$mod.Obj.SetItems($mod.Obj.GetItems());',
13400     '$mod.Obj.GetItems()[11] = $mod.Obj.GetItems()[12];'
13401     ]));
13402 end;
13403 
13404 procedure TTestModule.TestClass_PropertyDefault;
13405 begin
13406   StartProgram(false);
13407   Add([
13408   'type',
13409   '  TArray = array of longint;',
13410   '  TObject = class',
13411   '  end;',
13412   '  TBird = class',
13413   '    FItems: TArray;',
13414   '    function GetItems(Index: longint): longint;',
13415   '    procedure SetItems(Index, Value: longint);',
13416   '    property Items[Index: longint]: longint read getitems write setitems; default;',
13417   '  end;',
13418   'function TBird.getitems(index: longint): longint;',
13419   'begin',
13420   'end;',
13421   'procedure TBird.setitems(index, value: longint);',
13422   'begin',
13423   '  Self[1]:=2;',
13424   '  Self[3]:=Self[index];',
13425   '  Self[index]:=Self[Self[value]];',
13426   '  Self[Self[4]]:=value;',
13427   'end;',
13428   'var',
13429   '  Bird: TBird;',
13430   '  Obj: TObject;',
13431   'begin',
13432   '  bird[11]:=12;',
13433   '  bird[13]:=bird[14];',
13434   '  bird[Bird[15]]:=bird[Bird[15]];',
13435   '  TBird(obj)[16]:=TBird(obj)[17];',
13436   '  (obj as tbird)[18]:=19;',
13437   '']);
13438   ConvertProgram;
13439   CheckSource('TestClass_PropertyDefault',
13440     LinesToStr([ // statements
13441     'rtl.createClass($mod, "TObject", null, function () {',
13442     '  this.$init = function () {',
13443     '  };',
13444     '  this.$final = function () {',
13445     '  };',
13446     '});',
13447     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
13448     '  this.$init = function () {',
13449     '    $mod.TObject.$init.call(this);',
13450     '    this.FItems = [];',
13451     '  };',
13452     '  this.$final = function () {',
13453     '    this.FItems = undefined;',
13454     '    $mod.TObject.$final.call(this);',
13455     '  };',
13456     '  this.GetItems = function (Index) {',
13457     '    var Result = 0;',
13458     '    return Result;',
13459     '  };',
13460     '  this.SetItems = function (Index, Value) {',
13461     '    this.SetItems(1, 2);',
13462     '    this.SetItems(3, this.GetItems(Index));',
13463     '    this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
13464     '    this.SetItems(this.GetItems(4), Value);',
13465     '  };',
13466     '});',
13467     'this.Bird = null;',
13468     'this.Obj = null;',
13469     '']),
13470     LinesToStr([ // $mod.$main
13471     '$mod.Bird.SetItems(11, 12);',
13472     '$mod.Bird.SetItems(13, $mod.Bird.GetItems(14));',
13473     '$mod.Bird.SetItems($mod.Bird.GetItems(15), $mod.Bird.GetItems($mod.Bird.GetItems(15)));',
13474     '$mod.Obj.SetItems(16, $mod.Obj.GetItems(17));',
13475     'rtl.as($mod.Obj, $mod.TBird).SetItems(18, 19);',
13476     '']));
13477 end;
13478 
13479 procedure TTestModule.TestClass_PropertyDefault_TypecastToOtherDefault;
13480 begin
13481   StartProgram(false);
13482   Add([
13483   'type',
13484   '  TObject = class end;',
13485   '  TAlphaList = class',
13486   '    function GetAlphas(Index: boolean): Pointer; virtual; abstract;',
13487   '    procedure SetAlphas(Index: boolean; Value: Pointer); virtual; abstract;',
13488   '    property Alphas[Index: boolean]: Pointer read getAlphas write setAlphas; default;',
13489   '  end;',
13490   '  TBetaList = class',
13491   '    function GetBetas(Index: longint): Pointer; virtual; abstract;',
13492   '    procedure SetBetas(Index: longint; Value: Pointer); virtual; abstract;',
13493   '    property Betas[Index: longint]: Pointer read getBetas write setBetas; default;',
13494   '  end;',
13495   '  TBird = class',
13496   '    procedure DoIt;',
13497   '  end;',
13498   'procedure TBird.DoIt;',
13499   'var',
13500   '  List: TAlphaList;',
13501   'begin',
13502   '  if TBetaList(List[true])[3]=nil then ;',
13503   '  TBetaList(List[false])[5]:=nil;',
13504   'end;',
13505   'var',
13506   '  List: TAlphaList;',
13507   'begin',
13508   '  if TBetaList(List[true])[3]=nil then ;',
13509   '  TBetaList(List[false])[5]:=nil;',
13510   '']);
13511   ConvertProgram;
13512   CheckSource('TestClass_PropertyDefault_TypecastToOtherDefault',
13513     LinesToStr([ // statements
13514     'rtl.createClass($mod, "TObject", null, function () {',
13515     '  this.$init = function () {',
13516     '  };',
13517     '  this.$final = function () {',
13518     '  };',
13519     '});',
13520     'rtl.createClass($mod, "TAlphaList", $mod.TObject, function () {',
13521     '});',
13522     'rtl.createClass($mod, "TBetaList", $mod.TObject, function () {',
13523     '});',
13524     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
13525     '  this.DoIt = function () {',
13526     '    var List = null;',
13527     '    if (List.GetAlphas(true).GetBetas(3) === null) ;',
13528     '    List.GetAlphas(false).SetBetas(5, null);',
13529     '  };',
13530     '});',
13531     'this.List = null;',
13532     '']),
13533     LinesToStr([ // $mod.$main
13534     'if ($mod.List.GetAlphas(true).GetBetas(3) === null) ;',
13535     '$mod.List.GetAlphas(false).SetBetas(5, null);',
13536     '']));
13537 end;
13538 
13539 procedure TTestModule.TestClass_PropertyOverride;
13540 begin
13541   StartProgram(false);
13542   Add('type');
13543   Add('  integer = longint;');
13544   Add('  TObject = class');
13545   Add('    FItem: integer;');
13546   Add('    function GetItem: integer; external name ''GetItem'';');
13547   Add('    procedure SetItem(Value: integer); external name ''SetItem'';');
13548   Add('    property Item: integer read getitem write setitem;');
13549   Add('  end;');
13550   Add('  TCar = class');
13551   Add('    FBag: integer;');
13552   Add('    function GetBag: integer; external name ''GetBag'';');
13553   Add('    property Item read getbag;');
13554   Add('  end;');
13555   Add('var');
13556   Add('  Obj: tobject;');
13557   Add('  Car: tcar;');
13558   Add('begin');
13559   Add('  Obj.Item:=Obj.Item;');
13560   Add('  Car.Item:=Car.Item;');
13561   ConvertProgram;
13562   CheckSource('TestClass_PropertyOverride',
13563     LinesToStr([ // statements
13564     'rtl.createClass($mod, "TObject", null, function () {',
13565     '  this.$init = function () {',
13566     '    this.FItem = 0;',
13567     '  };',
13568     '  this.$final = function () {',
13569     '  };',
13570     '});',
13571     'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
13572     '  this.$init = function () {',
13573     '    $mod.TObject.$init.call(this);',
13574     '    this.FBag = 0;',
13575     '  };',
13576     '});',
13577     'this.Obj = null;',
13578     'this.Car = null;',
13579     '']),
13580     LinesToStr([ // $mod.$main
13581     '$mod.Obj.SetItem($mod.Obj.GetItem());',
13582     '$mod.Car.SetItem($mod.Car.GetBag());',
13583     '']));
13584 end;
13585 
13586 procedure TTestModule.TestClass_PropertyIncVisibility;
13587 begin
13588   AddModuleWithIntfImplSrc('unit1.pp',
13589     LinesToStr([
13590     'type',
13591     '  TNumber = longint;',
13592     '  TInteger = longint;',
13593     '  TObject = class',
13594     '  private',
13595     '    function GetItems(Index: TNumber): TInteger; virtual; abstract;',
13596     '    procedure SetItems(Index: TInteger; Value: TNumber); virtual; abstract;',
13597     '  protected',
13598     '    property Items[Index: TNumber]: longint read GetItems write SetItems;',
13599     '  end;']),
13600     LinesToStr([
13601     '']));
13602 
13603   StartProgram(true);
13604   Add([
13605   'uses unit1;',
13606   'type',
13607   '  TBird = class',
13608   '  public',
13609   '    property Items;',
13610   '  end;',
13611   'procedure DoIt(i: TInteger);',
13612   'begin',
13613   'end;',
13614   'var b: TBird;',
13615   'begin',
13616   '  b.Items[1]:=2;',
13617   '  b.Items[3]:=b.Items[4];',
13618   '  DoIt(b.Items[5]);',
13619   '']);
13620   ConvertProgram;
13621   CheckSource('TestClass_PropertyIncVisibility',
13622     LinesToStr([ // statements
13623     'rtl.createClass($mod, "TBird", pas.unit1.TObject, function () {',
13624     '});',
13625     'this.DoIt = function (i) {',
13626     '};',
13627     'this.b = null;'
13628     ]),
13629     LinesToStr([ // $mod.$main
13630     '$mod.b.SetItems(1, 2);',
13631     '$mod.b.SetItems(3, $mod.b.GetItems(4));',
13632     '$mod.DoIt($mod.b.GetItems(5));'
13633     ]));
13634 end;
13635 
13636 procedure TTestModule.TestClass_Assigned;
13637 begin
13638   StartProgram(false);
13639   Add('type');
13640   Add('  TObject = class');
13641   Add('  end;');
13642   Add('var');
13643   Add('  Obj: tobject;');
13644   Add('  b: boolean;');
13645   Add('begin');
13646   Add('  if Assigned(obj) then ;');
13647   Add('  b:=Assigned(obj) or false;');
13648   ConvertProgram;
13649   CheckSource('TestClass_Assigned',
13650     LinesToStr([ // statements
13651     'rtl.createClass($mod, "TObject", null, function () {',
13652     '  this.$init = function () {',
13653     '  };',
13654     '  this.$final = function () {',
13655     '  };',
13656     '});',
13657     'this.Obj = null;',
13658     'this.b = false;'
13659     ]),
13660     LinesToStr([ // $mod.$main
13661     'if ($mod.Obj != null);',
13662     '$mod.b = ($mod.Obj != null) || false;'
13663     ]));
13664 end;
13665 
13666 procedure TTestModule.TestClass_WithClassDoCreate;
13667 begin
13668   StartProgram(false);
13669   Add('type');
13670   Add('  TObject = class');
13671   Add('    aBool: boolean;');
13672   Add('    Arr: array of boolean;');
13673   Add('    constructor Create;');
13674   Add('  end;');
13675   Add('constructor TObject.Create; begin end;');
13676   Add('var');
13677   Add('  Obj: tobject;');
13678   Add('  b: boolean;');
13679   Add('begin');
13680   Add('  with tobject.create do begin');
13681   Add('    b:=abool;');
13682   Add('    abool:=b;');
13683   Add('    b:=arr[1];');
13684   Add('    arr[2]:=b;');
13685   Add('  end;');
13686   Add('  with tobject do');
13687   Add('    obj:=create;');
13688   Add('  with obj do begin');
13689   Add('    create;');
13690   Add('    b:=abool;');
13691   Add('    abool:=b;');
13692   Add('    b:=arr[3];');
13693   Add('    arr[4]:=b;');
13694   Add('  end;');
13695   ConvertProgram;
13696   CheckSource('TestClass_WithClassDoCreate',
13697     LinesToStr([ // statements
13698     'rtl.createClass($mod, "TObject", null, function () {',
13699     '  this.$init = function () {',
13700     '    this.aBool = false;',
13701     '    this.Arr = [];',
13702     '  };',
13703     '  this.$final = function () {',
13704     '    this.Arr = undefined;',
13705     '  };',
13706     '  this.Create = function () {',
13707     '    return this;',
13708     '  };',
13709     '});',
13710     'this.Obj = null;',
13711     'this.b = false;'
13712     ]),
13713     LinesToStr([ // $mod.$main
13714     'var $with = $mod.TObject.$create("Create");',
13715     '$mod.b = $with.aBool;',
13716     '$with.aBool = $mod.b;',
13717     '$mod.b = $with.Arr[1];',
13718     '$with.Arr[2] = $mod.b;',
13719     'var $with1 = $mod.TObject;',
13720     '$mod.Obj = $with1.$create("Create");',
13721     'var $with2 = $mod.Obj;',
13722     '$with2.Create();',
13723     '$mod.b = $with2.aBool;',
13724     '$with2.aBool = $mod.b;',
13725     '$mod.b = $with2.Arr[3];',
13726     '$with2.Arr[4] = $mod.b;',
13727     '']));
13728 end;
13729 
13730 procedure TTestModule.TestClass_WithClassInstDoProperty;
13731 begin
13732   StartProgram(false);
13733   Add('type');
13734   Add('  TObject = class');
13735   Add('    FInt: longint;');
13736   Add('    constructor Create;');
13737   Add('    function GetSize: longint;');
13738   Add('    procedure SetSize(Value: longint);');
13739   Add('    property Int: longint read FInt write FInt;');
13740   Add('    property Size: longint read GetSize write SetSize;');
13741   Add('  end;');
13742   Add('constructor TObject.Create; begin end;');
13743   Add('function TObject.GetSize: longint; begin; end;');
13744   Add('procedure TObject.SetSize(Value: longint); begin; end;');
13745   Add('var');
13746   Add('  Obj: tobject;');
13747   Add('  i: longint;');
13748   Add('begin');
13749   Add('  with TObject.Create do begin');
13750   Add('    i:=int;');
13751   Add('    int:=i;');
13752   Add('    i:=size;');
13753   Add('    size:=i;');
13754   Add('  end;');
13755   Add('  with obj do begin');
13756   Add('    i:=int;');
13757   Add('    int:=i;');
13758   Add('    i:=size;');
13759   Add('    size:=i;');
13760   Add('  end;');
13761   ConvertProgram;
13762   CheckSource('TestClass_WithClassInstDoProperty',
13763     LinesToStr([ // statements
13764     'rtl.createClass($mod, "TObject", null, function () {',
13765     '  this.$init = function () {',
13766     '    this.FInt = 0;',
13767     '  };',
13768     '  this.$final = function () {',
13769     '  };',
13770     '  this.Create = function () {',
13771     '    return this;',
13772     '  };',
13773     '  this.GetSize = function () {',
13774     '    var Result = 0;',
13775     '    return Result;',
13776     '  };',
13777     '  this.SetSize = function (Value) {',
13778     '  };',
13779     '});',
13780     'this.Obj = null;',
13781     'this.i = 0;'
13782     ]),
13783     LinesToStr([ // $mod.$main
13784     'var $with = $mod.TObject.$create("Create");',
13785     '$mod.i = $with.FInt;',
13786     '$with.FInt = $mod.i;',
13787     '$mod.i = $with.GetSize();',
13788     '$with.SetSize($mod.i);',
13789     'var $with1 = $mod.Obj;',
13790     '$mod.i = $with1.FInt;',
13791     '$with1.FInt = $mod.i;',
13792     '$mod.i = $with1.GetSize();',
13793     '$with1.SetSize($mod.i);',
13794     '']));
13795 end;
13796 
13797 procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
13798 begin
13799   StartProgram(false);
13800   Add('type');
13801   Add('  TObject = class');
13802   Add('    constructor Create;');
13803   Add('    function GetItems(Index: longint): longint;');
13804   Add('    procedure SetItems(Index, Value: longint);');
13805   Add('    property Items[Index: longint]: longint read GetItems write SetItems;');
13806   Add('  end;');
13807   Add('constructor TObject.Create; begin end;');
13808   Add('function tobject.getitems(index: longint): longint; begin; end;');
13809   Add('procedure tobject.setitems(index, value: longint); begin; end;');
13810   Add('var');
13811   Add('  Obj: tobject;');
13812   Add('  i: longint;');
13813   Add('begin');
13814   Add('  with TObject.Create do begin');
13815   Add('    i:=Items[1];');
13816   Add('    Items[2]:=i;');
13817   Add('  end;');
13818   Add('  with obj do begin');
13819   Add('    i:=Items[3];');
13820   Add('    Items[4]:=i;');
13821   Add('  end;');
13822   ConvertProgram;
13823   CheckSource('TestClass_WithClassInstDoPropertyWithParams',
13824     LinesToStr([ // statements
13825     'rtl.createClass($mod, "TObject", null, function () {',
13826     '  this.$init = function () {',
13827     '  };',
13828     '  this.$final = function () {',
13829     '  };',
13830     '  this.Create = function () {',
13831     '    return this;',
13832     '  };',
13833     '  this.GetItems = function (Index) {',
13834     '    var Result = 0;',
13835     '    return Result;',
13836     '  };',
13837     '  this.SetItems = function (Index, Value) {',
13838     '  };',
13839     '});',
13840     'this.Obj = null;',
13841     'this.i = 0;'
13842     ]),
13843     LinesToStr([ // $mod.$main
13844     'var $with = $mod.TObject.$create("Create");',
13845     '$mod.i = $with.GetItems(1);',
13846     '$with.SetItems(2, $mod.i);',
13847     'var $with1 = $mod.Obj;',
13848     '$mod.i = $with1.GetItems(3);',
13849     '$with1.SetItems(4, $mod.i);',
13850     '']));
13851 end;
13852 
13853 procedure TTestModule.TestClass_WithClassInstDoFunc;
13854 begin
13855   StartProgram(false);
13856   Add('type');
13857   Add('  TObject = class');
13858   Add('    constructor Create;');
13859   Add('    function GetSize: longint;');
13860   Add('    procedure SetSize(Value: longint);');
13861   Add('  end;');
13862   Add('constructor TObject.Create; begin end;');
13863   Add('function TObject.GetSize: longint; begin; end;');
13864   Add('procedure TObject.SetSize(Value: longint); begin; end;');
13865   Add('var');
13866   Add('  Obj: tobject;');
13867   Add('  i: longint;');
13868   Add('begin');
13869   Add('  with TObject.Create do begin');
13870   Add('    i:=GetSize;');
13871   Add('    i:=GetSize();');
13872   Add('    SetSize(i);');
13873   Add('  end;');
13874   Add('  with obj do begin');
13875   Add('    i:=GetSize;');
13876   Add('    i:=GetSize();');
13877   Add('    SetSize(i);');
13878   Add('  end;');
13879   ConvertProgram;
13880   CheckSource('TestClass_WithClassInstDoFunc',
13881     LinesToStr([ // statements
13882     'rtl.createClass($mod, "TObject", null, function () {',
13883     '  this.$init = function () {',
13884     '  };',
13885     '  this.$final = function () {',
13886     '  };',
13887     '  this.Create = function () {',
13888     '    return this;',
13889     '  };',
13890     '  this.GetSize = function () {',
13891     '    var Result = 0;',
13892     '    return Result;',
13893     '  };',
13894     '  this.SetSize = function (Value) {',
13895     '  };',
13896     '});',
13897     'this.Obj = null;',
13898     'this.i = 0;'
13899     ]),
13900     LinesToStr([ // $mod.$main
13901     'var $with = $mod.TObject.$create("Create");',
13902     '$mod.i = $with.GetSize();',
13903     '$mod.i = $with.GetSize();',
13904     '$with.SetSize($mod.i);',
13905     'var $with1 = $mod.Obj;',
13906     '$mod.i = $with1.GetSize();',
13907     '$mod.i = $with1.GetSize();',
13908     '$with1.SetSize($mod.i);',
13909     '']));
13910 end;
13911 
13912 procedure TTestModule.TestClass_TypeCast;
13913 begin
13914   StartProgram(false);
13915   Add('type');
13916   Add('  TObject = class');
13917   Add('    Next: TObject;');
13918   Add('    constructor Create;');
13919   Add('  end;');
13920   Add('  TControl = class(TObject)');
13921   Add('    Arr: array of TObject;');
13922   Add('    function GetIt(vI: longint = 0): TObject;');
13923   Add('  end;');
13924   Add('constructor tobject.create; begin end;');
13925   Add('function tcontrol.getit(vi: longint = 0): tobject; begin end;');
13926   Add('var');
13927   Add('  Obj: tobject;');
13928   Add('begin');
13929   Add('  obj:=tcontrol(obj).next;');
13930   Add('  tcontrol(obj):=nil;');
13931   Add('  obj:=tcontrol(obj);');
13932   Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit);');
13933   Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
13934   Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
13935   Add('  tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
13936   Add('  obj:=tcontrol(nil);');
13937   ConvertProgram;
13938   CheckSource('TestClass_TypeCast',
13939     LinesToStr([ // statements
13940     'rtl.createClass($mod, "TObject", null, function () {',
13941     '  this.$init = function () {',
13942     '    this.Next = null;',
13943     '  };',
13944     '  this.$final = function () {',
13945     '    this.Next = undefined;',
13946     '  };',
13947     '  this.Create = function () {',
13948     '    return this;',
13949     '  };',
13950     '});',
13951     'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
13952     '  this.$init = function () {',
13953     '    $mod.TObject.$init.call(this);',
13954     '    this.Arr = [];',
13955     '  };',
13956     '  this.$final = function () {',
13957     '    this.Arr = undefined;',
13958     '    $mod.TObject.$final.call(this);',
13959     '  };',
13960     '  this.GetIt = function (vI) {',
13961     '    var Result = null;',
13962     '    return Result;',
13963     '  };',
13964     '});',
13965     'this.Obj = null;'
13966     ]),
13967     LinesToStr([ // $mod.$main
13968     '$mod.Obj = $mod.Obj.Next;',
13969     '$mod.Obj = null;',
13970     '$mod.Obj = $mod.Obj;',
13971     '$mod.Obj = $mod.Obj.GetIt(0);',
13972     '$mod.Obj = $mod.Obj.GetIt(0);',
13973     '$mod.Obj = $mod.Obj.GetIt(1);',
13974     '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
13975     '$mod.Obj = null;',
13976     '']));
13977 end;
13978 
13979 procedure TTestModule.TestClass_TypeCastUntypedParam;
13980 begin
13981   StartProgram(false);
13982   Add('type');
13983   Add('  TObject = class end;');
13984   Add('procedure ProcA(var A);');
13985   Add('begin');
13986   Add('  TObject(A):=nil;');
13987   Add('  TObject(A):=TObject(A);');
13988   Add('  if TObject(A)=nil then ;');
13989   Add('  if nil=TObject(A) then ;');
13990   Add('end;');
13991   Add('procedure ProcB(out A);');
13992   Add('begin');
13993   Add('  TObject(A):=nil;');
13994   Add('  TObject(A):=TObject(A);');
13995   Add('  if TObject(A)=nil then ;');
13996   Add('  if nil=TObject(A) then ;');
13997   Add('end;');
13998   Add('procedure ProcC(const A);');
13999   Add('begin');
14000   Add('  if TObject(A)=nil then ;');
14001   Add('  if nil=TObject(A) then ;');
14002   Add('end;');
14003   Add('var o: TObject;');
14004   Add('begin');
14005   Add('  ProcA(o);');
14006   Add('  ProcB(o);');
14007   Add('  ProcC(o);');
14008   ConvertProgram;
14009   CheckSource('TestClass_TypeCastUntypedParam',
14010     LinesToStr([ // statements
14011     'rtl.createClass($mod, "TObject", null, function () {',
14012     '  this.$init = function () {',
14013     '  };',
14014     '  this.$final = function () {',
14015     '  };',
14016     '});',
14017     'this.ProcA = function (A) {',
14018     '  A.set(null);',
14019     '  A.set(A.get());',
14020     '  if (A.get() === null);',
14021     '  if (null === A.get());',
14022     '};',
14023     'this.ProcB = function (A) {',
14024     '  A.set(null);',
14025     '  A.set(A.get());',
14026     '  if (A.get() === null);',
14027     '  if (null === A.get());',
14028     '};',
14029     'this.ProcC = function (A) {',
14030     '  if (A === null);',
14031     '  if (null === A);',
14032     '};',
14033     'this.o = null;',
14034     '']),
14035     LinesToStr([ // $mod.$main
14036     '$mod.ProcA({',
14037     '  p: $mod,',
14038     '  get: function () {',
14039     '      return this.p.o;',
14040     '    },',
14041     '  set: function (v) {',
14042     '      this.p.o = v;',
14043     '    }',
14044     '});',
14045     '$mod.ProcB({',
14046     '  p: $mod,',
14047     '  get: function () {',
14048     '      return this.p.o;',
14049     '    },',
14050     '  set: function (v) {',
14051     '      this.p.o = v;',
14052     '    }',
14053     '});',
14054     '$mod.ProcC($mod.o);',
14055     '']));
14056 end;
14057 
14058 procedure TTestModule.TestClass_Overloads;
14059 begin
14060   StartProgram(false);
14061   Add('type');
14062   Add('  TObject = class');
14063   Add('    procedure DoIt;');
14064   Add('    procedure DoIt(vI: longint);');
14065   Add('  end;');
14066   Add('procedure TObject.DoIt;');
14067   Add('begin');
14068   Add('  DoIt;');
14069   Add('  DoIt(1);');
14070   Add('end;');
14071   Add('procedure TObject.DoIt(vI: longint); begin end;');
14072   Add('begin');
14073   ConvertProgram;
14074   CheckSource('TestClass_Overloads',
14075     LinesToStr([ // statements
14076     'rtl.createClass($mod, "TObject", null, function () {',
14077     '  this.$init = function () {',
14078     '  };',
14079     '  this.$final = function () {',
14080     '  };',
14081     '  this.DoIt = function () {',
14082     '    this.DoIt();',
14083     '    this.DoIt$1(1);',
14084     '  };',
14085     '  this.DoIt$1 = function (vI) {',
14086     '  };',
14087     '});',
14088     '']),
14089     LinesToStr([ // $mod.$main
14090     '']));
14091 end;
14092 
14093 procedure TTestModule.TestClass_OverloadsAncestor;
14094 begin
14095   StartProgram(false);
14096   Add('type');
14097   Add('  TObject = class;');
14098   Add('  TObject = class');
14099   Add('    procedure DoIt(vA: longint);');
14100   Add('    procedure DoIt(vA, vB: longint);');
14101   Add('  end;');
14102   Add('  TCar = class;');
14103   Add('  TCar = class');
14104   Add('    procedure DoIt(vA: longint);');
14105   Add('    procedure DoIt(vA, vB: longint);');
14106   Add('  end;');
14107   Add('procedure tobject.doit(va: longint);');
14108   Add('begin');
14109   Add('  doit(1);');
14110   Add('  doit(1,2);');
14111   Add('end;');
14112   Add('procedure tobject.doit(va, vb: longint); begin end;');
14113   Add('procedure tcar.doit(va: longint);');
14114   Add('begin');
14115   Add('  doit(1);');
14116   Add('  doit(1,2);');
14117   Add('  inherited doit(1);');
14118   Add('  inherited doit(1,2);');
14119   Add('end;');
14120   Add('procedure tcar.doit(va, vb: longint); begin end;');
14121   Add('begin');
14122   ConvertProgram;
14123   CheckSource('TestClass_OverloadsAncestor',
14124     LinesToStr([ // statements
14125     'rtl.createClass($mod, "TObject", null, function () {',
14126     '  this.$init = function () {',
14127     '  };',
14128     '  this.$final = function () {',
14129     '  };',
14130     '  this.DoIt = function (vA) {',
14131     '    this.DoIt(1);',
14132     '    this.DoIt$1(1,2);',
14133     '  };',
14134     '  this.DoIt$1 = function (vA, vB) {',
14135     '  };',
14136     '});',
14137     'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
14138     '  this.DoIt$2 = function (vA) {',
14139     '    this.DoIt$2(1);',
14140     '    this.DoIt$3(1, 2);',
14141     '    $mod.TObject.DoIt.call(this, 1);',
14142     '    $mod.TObject.DoIt$1.call(this, 1, 2);',
14143     '  };',
14144     '  this.DoIt$3 = function (vA, vB) {',
14145     '  };',
14146     '});',
14147     '']),
14148     LinesToStr([ // $mod.$main
14149     '']));
14150 end;
14151 
14152 procedure TTestModule.TestClass_OverloadConstructor;
14153 begin
14154   StartProgram(false);
14155   Add('type');
14156   Add('  TObject = class');
14157   Add('    constructor Create(vA: longint);');
14158   Add('    constructor Create(vA, vB: longint);');
14159   Add('  end;');
14160   Add('  TCar = class');
14161   Add('    constructor Create(vA: longint);');
14162   Add('    constructor Create(vA, vB: longint);');
14163   Add('  end;');
14164   Add('constructor tobject.create(va: longint);');
14165   Add('begin');
14166   Add('  create(1);');
14167   Add('  create(1,2);');
14168   Add('end;');
14169   Add('constructor tobject.create(va, vb: longint); begin end;');
14170   Add('constructor tcar.create(va: longint);');
14171   Add('begin');
14172   Add('  create(1);');
14173   Add('  create(1,2);');
14174   Add('  inherited create(1);');
14175   Add('  inherited create(1,2);');
14176   Add('end;');
14177   Add('constructor tcar.create(va, vb: longint); begin end;');
14178   Add('begin');
14179   Add('  tobject.create(1);');
14180   Add('  tobject.create(1,2);');
14181   Add('  tcar.create(1);');
14182   Add('  tcar.create(1,2);');
14183   ConvertProgram;
14184   CheckSource('TestClass_OverloadConstructor',
14185     LinesToStr([ // statements
14186     'rtl.createClass($mod, "TObject", null, function () {',
14187     '  this.$init = function () {',
14188     '  };',
14189     '  this.$final = function () {',
14190     '  };',
14191     '  this.Create = function (vA) {',
14192     '    this.Create(1);',
14193     '    this.Create$1(1,2);',
14194     '    return this;',
14195     '  };',
14196     '  this.Create$1 = function (vA, vB) {',
14197     '    return this;',
14198     '  };',
14199     '});',
14200     'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
14201     '  this.Create$2 = function (vA) {',
14202     '    this.Create$2(1);',
14203     '    this.Create$3(1, 2);',
14204     '    $mod.TObject.Create.call(this, 1);',
14205     '    $mod.TObject.Create$1.call(this, 1, 2);',
14206     '    return this;',
14207     '  };',
14208     '  this.Create$3 = function (vA, vB) {',
14209     '    return this;',
14210     '  };',
14211     '});',
14212     '']),
14213     LinesToStr([ // $mod.$main
14214     '$mod.TObject.$create("Create", [1]);',
14215     '$mod.TObject.$create("Create$1", [1, 2]);',
14216     '$mod.TCar.$create("Create$2", [1]);',
14217     '$mod.TCar.$create("Create$3", [1, 2]);',
14218     '']));
14219 end;
14220 
14221 procedure TTestModule.TestClass_OverloadDelphiOverride;
14222 begin
14223   StartProgram(false);
14224   Add([
14225   '{$mode delphi}',
14226   'type',
14227   '  TObject = class end;',
14228   '  TBird = class',
14229   '    function {#a}GetValue: longint; overload; virtual;',
14230   '    function {#b}GetValue(AValue: longint): longint; overload; virtual;',
14231   '  end;',
14232   '  TEagle = class(TBird)',
14233   '    function {#c}GetValue: longint; overload; override;',
14234   '    function {#d}GetValue(AValue: longint): longint; overload; override;',
14235   '  end;',
14236   'function TBird.GetValue: longint;',
14237   'begin',
14238   '  if 3={@a}GetValue then ;',
14239   '  if 4={@b}GetValue(5) then ;',
14240   'end;',
14241   'function TBird.GetValue(AValue: longint): longint;',
14242   'begin',
14243   'end;',
14244   'function TEagle.GetValue: longint;',
14245   'begin',
14246   '  if 13={@c}GetValue then ;',
14247   '  if 14={@d}GetValue(15) then ;',
14248   '  if 15=inherited {@a}GetValue then ;',
14249   '  if 16=inherited {@b}GetValue(17) then ;',
14250   'end;',
14251   'function TEagle.GetValue(AValue: longint): longint;',
14252   'begin',
14253   'end;',
14254   'var',
14255   '  e: TEagle;',
14256   'begin',
14257   '  if 23=e.{@c}GetValue then ;',
14258   '  if 24=e.{@d}GetValue(25) then ;']);
14259   ConvertProgram;
14260   CheckSource('TestClass_OverloadDelphiOverride',
14261     LinesToStr([ // statements
14262     'rtl.createClass($mod, "TObject", null, function () {',
14263     '  this.$init = function () {',
14264     '  };',
14265     '  this.$final = function () {',
14266     '  };',
14267     '});',
14268     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
14269     '  this.GetValue = function () {',
14270     '    var Result = 0;',
14271     '    if (3 === this.GetValue()) ;',
14272     '    if (4 === this.GetValue$1(5)) ;',
14273     '    return Result;',
14274     '  };',
14275     '  this.GetValue$1 = function (AValue) {',
14276     '    var Result = 0;',
14277     '    return Result;',
14278     '  };',
14279     '});',
14280     'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
14281     '  this.GetValue = function () {',
14282     '    var Result = 0;',
14283     '    if (13 === this.GetValue()) ;',
14284     '    if (14 === this.GetValue$1(15)) ;',
14285     '    if (15 === $mod.TBird.GetValue.call(this)) ;',
14286     '    if (16 === $mod.TBird.GetValue$1.call(this, 17)) ;',
14287     '    return Result;',
14288     '  };',
14289     '  this.GetValue$1 = function (AValue) {',
14290     '    var Result = 0;',
14291     '    return Result;',
14292     '  };',
14293     '});',
14294     'this.e = null;',
14295     '']),
14296     LinesToStr([ // $mod.$main
14297     'if (23 === $mod.e.GetValue()) ;',
14298     'if (24 === $mod.e.GetValue$1(25)) ;',
14299     '']));
14300 end;
14301 
14302 procedure TTestModule.TestClass_ReintroduceVarDelphi;
14303 begin
14304   StartProgram(false);
14305   Add([
14306   '{$mode delphi}',
14307   'type',
14308   '  TObject = class end;',
14309   '  TAnimal = class',
14310   '  public',
14311   '    {#animal_a}A: longint;',
14312   '    function {#animal_b}B: longint;',
14313   '  end;',
14314   '  TBird = class(TAnimal)',
14315   '  public',
14316   '    {#bird_a}A: double;',
14317   '    {#bird_b}B: boolean;',
14318   '  end;',
14319   '  TEagle = class(TBird)',
14320   '  public',
14321   '    function {#eagle_a}A: boolean;',
14322   '    {#eagle_b}B: double;',
14323   '  end;',
14324   'function TAnimal.B: longint;',
14325   'begin',
14326   'end;',
14327   'function TEagle.A: boolean;',
14328   'begin',
14329   '  {@eagle_b}B:=3.3;',
14330   '  {@eagle_a}A();',
14331   '  TBird(Self).{@bird_b}B:=true;',
14332   '  TAnimal(Self).{@animal_a}A:=17;',
14333   '  inherited {@bird_b}B:=inherited {bird_a}A>1;', // Delphi allows only inherited <functionname>
14334   'end;',
14335   'var',
14336   '  e: TEagle;',
14337   'begin',
14338   '  e.{@eagle_b}B:=5.3;',
14339   '  if e.{@eagle_a}A then ;',
14340   '']);
14341   ConvertProgram;
14342   CheckSource('TestClass_ReintroduceVarDelphi',
14343     LinesToStr([ // statements
14344     'rtl.createClass($mod, "TObject", null, function () {',
14345     '  this.$init = function () {',
14346     '  };',
14347     '  this.$final = function () {',
14348     '  };',
14349     '});',
14350     'rtl.createClass($mod, "TAnimal", $mod.TObject, function () {',
14351     '  this.$init = function () {',
14352     '    $mod.TObject.$init.call(this);',
14353     '    this.A = 0;',
14354     '  };',
14355     '  this.B = function () {',
14356     '    var Result = 0;',
14357     '    return Result;',
14358     '  };',
14359     '});',
14360     'rtl.createClass($mod, "TBird", $mod.TAnimal, function () {',
14361     '  this.$init = function () {',
14362     '    $mod.TAnimal.$init.call(this);',
14363     '    this.A$1 = 0.0;',
14364     '    this.B$1 = false;',
14365     '  };',
14366     '});',
14367     'rtl.createClass($mod, "TEagle", $mod.TBird, function () {',
14368     '  this.$init = function () {',
14369     '    $mod.TBird.$init.call(this);',
14370     '    this.B$2 = 0.0;',
14371     '  };',
14372     '  this.A$2 = function () {',
14373     '    var Result = false;',
14374     '    this.B$2 = 3.3;',
14375     '    this.A$2();',
14376     '    this.B$1 = true;',
14377     '    this.A = 17;',
14378     '    this.B$1 = this.A$1 > 1;',
14379     '    return Result;',
14380     '  };',
14381     '});',
14382     'this.e = null;',
14383     '']),
14384     LinesToStr([ // $mod.$main
14385     '$mod.e.B$2 = 5.3;',
14386     'if ($mod.e.A$2()) ;',
14387     '']));
14388 end;
14389 
14390 procedure TTestModule.TestClass_ReintroducedVar;
14391 begin
14392   StartProgram(false);
14393   Add('type');
14394   Add('  TObject = class');
14395   Add('  strict private');
14396   Add('    Some: longint;');
14397   Add('  end;');
14398   Add('  TMobile = class');
14399   Add('  strict private');
14400   Add('    Some: string;');
14401   Add('  end;');
14402   Add('  TCar = class(tmobile)');
14403   Add('    procedure Some;');
14404   Add('    procedure Some(vA: longint);');
14405   Add('  end;');
14406   Add('procedure tcar.some;');
14407   Add('begin');
14408   Add('  Some;');
14409   Add('  Some(1);');
14410   Add('end;');
14411   Add('procedure tcar.some(va: longint); begin end;');
14412   Add('begin');
14413   ConvertProgram;
14414   CheckSource('TestClass_ReintroducedVar',
14415     LinesToStr([ // statements
14416     'rtl.createClass($mod, "TObject", null, function () {',
14417     '  this.$init = function () {',
14418     '    this.Some = 0;',
14419     '  };',
14420     '  this.$final = function () {',
14421     '  };',
14422     '});',
14423     'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
14424     '  this.$init = function () {',
14425     '    $mod.TObject.$init.call(this);',
14426     '    this.Some$1 = "";',
14427     '  };',
14428     '});',
14429     'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
14430     '  this.Some$2 = function () {',
14431     '    this.Some$2();',
14432     '    this.Some$3(1);',
14433     '  };',
14434     '  this.Some$3 = function (vA) {',
14435     '  };',
14436     '});',
14437     '']),
14438     LinesToStr([ // $mod.$main
14439     '']));
14440 end;
14441 
14442 procedure TTestModule.TestClass_RaiseDescendant;
14443 begin
14444   StartProgram(false);
14445   Add([
14446   'type',
14447   '  TObject = class',
14448   '    constructor Create(Msg: string);',
14449   '  end;',
14450   '  Exception = class',
14451   '  end;',
14452   '  EConvertError = class(Exception)',
14453   '  end;',
14454   'constructor TObject.Create(Msg: string); begin end;',
14455   'function AssertConv(Msg: string = ''def''): EConvertError; begin end;',
14456   'begin',
14457   '  raise Exception.Create(''Bar1'');',
14458   '  raise EConvertError.Create(''Bar2'');',
14459   '  raise AssertConv(''Bar2'');',
14460   '  raise AssertConv;',
14461   '']);
14462   ConvertProgram;
14463   CheckSource('TestClass_RaiseDescendant',
14464     LinesToStr([ // statements
14465     'rtl.createClass($mod, "TObject", null, function () {',
14466     '  this.$init = function () {',
14467     '  };',
14468     '  this.$final = function () {',
14469     '  };',
14470     '  this.Create = function (Msg) {',
14471     '    return this;',
14472     '  };',
14473     '});',
14474     'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
14475     '});',
14476     'rtl.createClass($mod, "EConvertError", $mod.Exception, function () {',
14477     '});',
14478     'this.AssertConv = function (Msg) {',
14479     '  var Result = null;',
14480     '  return Result;',
14481     '};',
14482     '']),
14483     LinesToStr([ // $mod.$main
14484     'throw $mod.Exception.$create("Create",["Bar1"]);',
14485     'throw $mod.EConvertError.$create("Create",["Bar2"]);',
14486     'throw $mod.AssertConv("Bar2");',
14487     'throw $mod.AssertConv("def");',
14488     '']));
14489 end;
14490 
14491 procedure TTestModule.TestClass_ExternalMethod;
14492 begin
14493   AddModuleWithIntfImplSrc('unit2.pas',
14494     LinesToStr([
14495     'type',
14496     '  TObject = class',
14497     '  public',
14498     '    procedure Intern; external name ''$DoIntern'';',
14499     '  end;',
14500     '']),
14501     LinesToStr([
14502     '']));
14503 
14504   StartUnit(true);
14505   Add('interface');
14506   Add('uses unit2;');
14507   Add('type');
14508   Add('  TCar = class(TObject)');
14509   Add('  public');
14510   Add('    procedure Intern2; external name ''$DoIntern2'';');
14511   Add('    procedure DoIt;');
14512   Add('  end;');
14513   Add('implementation');
14514   Add('procedure tcar.doit;');
14515   Add('begin');
14516   Add('  Intern;');
14517   Add('  Intern();');
14518   Add('  Intern2;');
14519   Add('  Intern2();');
14520   Add('end;');
14521   Add('var Obj: TCar;');
14522   Add('begin');
14523   Add('  obj.intern;');
14524   Add('  obj.intern();');
14525   Add('  obj.intern2;');
14526   Add('  obj.intern2();');
14527   Add('  obj.doit;');
14528   Add('  obj.doit();');
14529   Add('  with obj do begin');
14530   Add('    Intern;');
14531   Add('    Intern();');
14532   Add('    Intern2;');
14533   Add('    Intern2();');
14534   Add('  end;');
14535   ConvertUnit;
14536   CheckSource('TestClass_ExternalMethod',
14537     LinesToStr([
14538     'var $impl = $mod.$impl;',
14539     'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
14540     '    this.DoIt = function () {',
14541     '      this.$DoIntern();',
14542     '      this.$DoIntern();',
14543     '      this.$DoIntern2();',
14544     '      this.$DoIntern2();',
14545     '    };',
14546     '  });',
14547     '']),
14548     LinesToStr([ // this.$init
14549     '$impl.Obj.$DoIntern();',
14550     '$impl.Obj.$DoIntern();',
14551     '$impl.Obj.$DoIntern2();',
14552     '$impl.Obj.$DoIntern2();',
14553     '$impl.Obj.DoIt();',
14554     '$impl.Obj.DoIt();',
14555     'var $with = $impl.Obj;',
14556     '$with.$DoIntern();',
14557     '$with.$DoIntern();',
14558     '$with.$DoIntern2();',
14559     '$with.$DoIntern2();',
14560     '']),
14561     LinesToStr([ // implementation
14562     '$impl.Obj = null;',
14563     '']) );
14564 end;
14565 
14566 procedure TTestModule.TestClass_ExternalVirtualNameMismatchFail;
14567 begin
14568   StartProgram(false);
14569   Add('type');
14570   Add('  TObject = class');
14571   Add('    procedure DoIt; virtual; external name ''Foo'';');
14572   Add('  end;');
14573   Add('begin');
14574   SetExpectedPasResolverError('Virtual method name must match external',
14575     nVirtualMethodNameMustMatchExternal);
14576   ConvertProgram;
14577 end;
14578 
14579 procedure TTestModule.TestClass_ExternalOverrideFail;
14580 begin
14581   StartProgram(false);
14582   Add('type');
14583   Add('  TObject = class');
14584   Add('    procedure DoIt; virtual; external name ''DoIt'';');
14585   Add('  end;');
14586   Add('  TCar = class');
14587   Add('    procedure DoIt; override; external name ''DoIt'';');
14588   Add('  end;');
14589   Add('begin');
14590   SetExpectedPasResolverError('Invalid procedure modifier override,external',
14591     nInvalidXModifierY);
14592   ConvertProgram;
14593 end;
14594 
14595 procedure TTestModule.TestClass_ExternalVar;
14596 begin
14597   AddModuleWithIntfImplSrc('unit2.pas',
14598     LinesToStr([
14599     '{$modeswitch externalclass}',
14600     'type',
14601     '  TObject = class',
14602     '  public',
14603     '    Intern: longint external name ''$Intern'';',
14604     '    Bracket: longint external name ''["A B"]'';',
14605     '  end;',
14606     '']),
14607     LinesToStr([
14608     '']));
14609 
14610   StartUnit(true);
14611   Add([
14612   'interface',
14613   'uses unit2;',
14614   '{$modeswitch externalclass}',
14615   'type',
14616   '  TCar = class(tobject)',
14617   '  public',
14618   '    Intern2: longint external name ''$Intern2'';',
14619   '    procedure DoIt;',
14620   '  end;',
14621   'implementation',
14622   'procedure tcar.doit;',
14623   'begin',
14624   '  Intern:=Intern+1;',
14625   '  Intern2:=Intern2+2;',
14626   '  Bracket:=Bracket+3;',
14627   'end;',
14628   'var Obj: TCar;',
14629   'begin',
14630   '  obj.intern:=obj.intern+1;',
14631   '  obj.intern2:=obj.intern2+2;',
14632   '  obj.Bracket:=obj.Bracket+3;',
14633   '  with obj do begin',
14634   '    intern:=intern+1;',
14635   '    intern2:=intern2+2;',
14636   '    Bracket:=Bracket+3;',
14637   '  end;']);
14638   ConvertUnit;
14639   CheckSource('TestClass_ExternalVar',
14640     LinesToStr([
14641     'var $impl = $mod.$impl;',
14642     'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
14643     '    this.DoIt = function () {',
14644     '      this.$Intern = this.$Intern + 1;',
14645     '      this.$Intern2 = this.$Intern2 + 2;',
14646     '      this["A B"] = this["A B"] + 3;',
14647     '    };',
14648     '  });',
14649     '']),
14650     LinesToStr([
14651     '$impl.Obj.$Intern = $impl.Obj.$Intern + 1;',
14652     '$impl.Obj.$Intern2 = $impl.Obj.$Intern2 + 2;',
14653     '$impl.Obj["A B"] = $impl.Obj["A B"] + 3;',
14654     'var $with = $impl.Obj;',
14655     '$with.$Intern = $with.$Intern + 1;',
14656     '$with.$Intern2 = $with.$Intern2 + 2;',
14657     '$with["A B"] = $with["A B"] + 3;',
14658     '']),
14659     LinesToStr([ // implementation
14660     '$impl.Obj = null;',
14661     '']));
14662 end;
14663 
14664 procedure TTestModule.TestClass_Const;
14665 begin
14666   StartProgram(false);
14667   Add('type');
14668   Add('  integer = longint;');
14669   Add('  TClass = class of TObject;');
14670   Add('  TObject = class');
14671   Add('  public');
14672   Add('    const cI: integer = 3;');
14673   Add('    procedure DoIt;');
14674   Add('    class procedure DoMore;');
14675   Add('  end;');
14676   Add('procedure tobject.doit;');
14677   Add('begin');
14678   Add('  if cI=4 then;');
14679   Add('  if 5=cI then;');
14680   Add('  if Self.cI=6 then;');
14681   Add('  if 7=Self.cI then;');
14682   Add('  with Self do begin');
14683   Add('    if cI=11 then;');
14684   Add('    if 12=cI then;');
14685   Add('  end;');
14686   Add('end;');
14687   Add('class procedure tobject.domore;');
14688   Add('begin');
14689   Add('  if cI=8 then;');
14690   Add('  if Self.cI=9 then;');
14691   Add('  if 10=cI then;');
14692   Add('  if 11=Self.cI then;');
14693   Add('  with Self do begin');
14694   Add('    if cI=13 then;');
14695   Add('    if 14=cI then;');
14696   Add('  end;');
14697   Add('end;');
14698   Add('var');
14699   Add('  Obj: TObject;');
14700   Add('  Cla: TClass;');
14701   Add('begin');
14702   Add('  if TObject.cI=21 then ;');
14703   Add('  if Obj.cI=22 then ;');
14704   Add('  if Cla.cI=23 then ;');
14705   Add('  with obj do if ci=24 then;');
14706   Add('  with TObject do if ci=25 then;');
14707   Add('  with Cla do if ci=26 then;');
14708   ConvertProgram;
14709   CheckSource('TestClass_Const',
14710     LinesToStr([
14711     'rtl.createClass($mod, "TObject", null, function () {',
14712     '  this.cI = 3;',
14713     '  this.$init = function () {',
14714     '  };',
14715     '  this.$final = function () {',
14716     '  };',
14717     '  this.DoIt = function () {',
14718     '    if (this.cI === 4) ;',
14719     '    if (5 === this.cI) ;',
14720     '    if (this.cI === 6) ;',
14721     '    if (7 === this.cI) ;',
14722     '    if (this.cI === 11) ;',
14723     '    if (12 === this.cI) ;',
14724     '  };',
14725     '  this.DoMore = function () {',
14726     '    if (this.cI === 8) ;',
14727     '    if (this.cI === 9) ;',
14728     '    if (10 === this.cI) ;',
14729     '    if (11 === this.cI) ;',
14730     '    if (this.cI === 13) ;',
14731     '    if (14 === this.cI) ;',
14732     '  };',
14733     '});',
14734     'this.Obj = null;',
14735     'this.Cla = null;',
14736     '']),
14737     LinesToStr([
14738     'if ($mod.TObject.cI === 21) ;',
14739     'if ($mod.Obj.cI === 22) ;',
14740     'if ($mod.Cla.cI === 23) ;',
14741     'var $with = $mod.Obj;',
14742     'if ($with.cI === 24) ;',
14743     'var $with1 = $mod.TObject;',
14744     'if ($with1.cI === 25) ;',
14745     'var $with2 = $mod.Cla;',
14746     'if ($with2.cI === 26) ;',
14747     '']));
14748 end;
14749 
14750 procedure TTestModule.TestClass_LocalConstDuplicate_Prg;
14751 begin
14752   StartProgram(false);
14753   Add([
14754   'type',
14755   '  TObject = class',
14756   '    const cI: longint = 3;',
14757   '    procedure Fly;',
14758   '    procedure Run;',
14759   '  end;',
14760   '  TBird = class',
14761   '    procedure Go;',
14762   '  end;',
14763   'procedure tobject.fly;',
14764   'const cI: word = 4;',
14765   'begin',
14766   '  if cI=Self.cI then ;',
14767   'end;',
14768   'procedure tobject.run;',
14769   'const cI: word = 5;',
14770   'begin',
14771   '  if cI=Self.cI then ;',
14772   'end;',
14773   'procedure tbird.go;',
14774   'const cI: word = 6;',
14775   'begin',
14776   '  if cI=Self.cI then ;',
14777   'end;',
14778   'begin',
14779   '']);
14780   ConvertProgram;
14781   CheckSource('TestClass_LocalConstDuplicate_Prg',
14782     LinesToStr([
14783     'rtl.createClass($mod, "TObject", null, function () {',
14784     '  this.cI = 3;',
14785     '  this.$init = function () {',
14786     '  };',
14787     '  this.$final = function () {',
14788     '  };',
14789     '  var cI$1 = 4;',
14790     '  this.Fly = function () {',
14791     '    if (cI$1 === this.cI) ;',
14792     '  };',
14793     '  var cI$2 = 5;',
14794     '  this.Run = function () {',
14795     '    if (cI$2 === this.cI) ;',
14796     '  };',
14797     '});',
14798     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
14799     '  var cI$3 = 6;',
14800     '  this.Go = function () {',
14801     '    if (cI$3 === this.cI) ;',
14802     '  };',
14803     '});',
14804     '']),
14805     LinesToStr([
14806     '']));
14807 end;
14808 
14809 procedure TTestModule.TestClass_LocalConstDuplicate_Unit;
14810 begin
14811   StartUnit(false);
14812   Add([
14813   'interface',
14814   'type',
14815   '  TObject = class',
14816   '    const cI: longint = 3;',
14817   '    procedure Fly;',
14818   '    procedure Run;',
14819   '  end;',
14820   '  TBird = class',
14821   '    procedure Go;',
14822   '  end;',
14823   'implementation',
14824   'procedure tobject.fly;',
14825   'const cI: word = 4;',
14826   'begin',
14827   '  if cI=Self.cI then ;',
14828   'end;',
14829   'procedure tobject.run;',
14830   'const cI: word = 5;',
14831   'begin',
14832   '  if cI=Self.cI then ;',
14833   'end;',
14834   'procedure tbird.go;',
14835   'const cI: word = 6;',
14836   'begin',
14837   '  if cI=Self.cI then ;',
14838   'end;',
14839   '']);
14840   ConvertUnit;
14841   CheckSource('TestClass_LocalConstDuplicate_Unit',
14842     LinesToStr([
14843     'rtl.createClass($mod, "TObject", null, function () {',
14844     '  this.cI = 3;',
14845     '  this.$init = function () {',
14846     '  };',
14847     '  this.$final = function () {',
14848     '  };',
14849     '  var cI$1 = 4;',
14850     '  this.Fly = function () {',
14851     '    if (cI$1 === this.cI) ;',
14852     '  };',
14853     '  var cI$2 = 5;',
14854     '  this.Run = function () {',
14855     '    if (cI$2 === this.cI) ;',
14856     '  };',
14857     '});',
14858     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
14859     '  var cI$3 = 6;',
14860     '  this.Go = function () {',
14861     '    if (cI$3 === this.cI) ;',
14862     '  };',
14863     '});',
14864     '']),
14865     '',
14866     '');
14867 end;
14868 
14869 procedure TTestModule.TestClass_LocalVarSelfFail;
14870 begin
14871   StartProgram(false);
14872   Add([
14873   'type',
14874   '  TObject = class',
14875   '    constructor Create;',
14876   '  end;',
14877   'constructor tobject.create;',
14878   'var self: longint;',
14879   'begin',
14880   'end',
14881   'begin',
14882   '']);
14883   SetExpectedPasResolverError('Duplicate identifier "self" at (0)',nDuplicateIdentifier);
14884   ConvertProgram;
14885 end;
14886 
14887 procedure TTestModule.TestClass_ArgSelfFail;
14888 begin
14889   StartProgram(false);
14890   Add([
14891   'type',
14892   '  TObject = class',
14893   '    procedure DoIt(Self: longint);',
14894   '  end;',
14895   'procedure tobject.doit(self: longint);',
14896   'begin',
14897   'end',
14898   'begin',
14899   '']);
14900   SetExpectedPasResolverError('Duplicate identifier "Self" at test1.pp(5,24)',nDuplicateIdentifier);
14901   ConvertProgram;
14902 end;
14903 
14904 procedure TTestModule.TestClass_NestedProcSelf;
14905 begin
14906   StartProgram(false);
14907   Add([
14908   'type',
14909   '  TObject = class',
14910   '    Key: longint;',
14911   '    class var State: longint;',
14912   '    procedure DoIt;',
14913   '    function GetSize: longint; virtual; abstract;',
14914   '    procedure SetSize(Value: longint); virtual; abstract;',
14915   '    property Size: longint read GetSize write SetSize;',
14916   '  end;',
14917   'procedure tobject.doit;',
14918   '  procedure Sub;',
14919   '  begin',
14920   '    key:=key+2;',
14921   '    self.key:=self.key+3;',
14922   '    state:=state+4;',
14923   '    self.state:=self.state+5;',
14924   '    tobject.state:=tobject.state+6;',
14925   '    size:=size+7;',
14926   '    self.size:=self.size+8;',
14927   '  end;',
14928   'begin',
14929   '  sub;',
14930   '  key:=key+12;',
14931   '  self.key:=self.key+13;',
14932   '  state:=state+14;',
14933   '  self.state:=self.state+15;',
14934   '  tobject.state:=tobject.state+16;',
14935   '  size:=size+17;',
14936   '  self.size:=self.size+18;',
14937   'end;',
14938   'begin',
14939   '']);
14940   ConvertProgram;
14941   CheckSource('TestClass_NestedProcSelf',
14942     LinesToStr([ // statements
14943     'rtl.createClass($mod, "TObject", null, function () {',
14944     '  this.State = 0;',
14945     '  this.$init = function () {',
14946     '    this.Key = 0;',
14947     '  };',
14948     '  this.$final = function () {',
14949     '  };',
14950     '  this.DoIt = function () {',
14951     '    var $Self = this;',
14952     '    function Sub() {',
14953     '      $Self.Key = $Self.Key + 2;',
14954     '      $Self.Key = $Self.Key + 3;',
14955     '      $mod.TObject.State = $Self.State + 4;',
14956     '      $mod.TObject.State = $Self.State + 5;',
14957     '      $mod.TObject.State = $mod.TObject.State + 6;',
14958     '      $Self.SetSize($Self.GetSize() + 7);',
14959     '      $Self.SetSize($Self.GetSize() + 8);',
14960     '    };',
14961     '    Sub();',
14962     '    $Self.Key = $Self.Key + 12;',
14963     '    $Self.Key = $Self.Key + 13;',
14964     '    $mod.TObject.State = $Self.State + 14;',
14965     '    $mod.TObject.State = $Self.State + 15;',
14966     '    $mod.TObject.State = $mod.TObject.State + 16;',
14967     '    $Self.SetSize($Self.GetSize() + 17);',
14968     '    $Self.SetSize($Self.GetSize() + 18);',
14969     '  };',
14970     '});',
14971     '']),
14972     LinesToStr([ // $mod.$main
14973     '']));
14974 end;
14975 
14976 procedure TTestModule.TestClass_NestedProcSelf2;
14977 begin
14978   StartProgram(false);
14979   Add([
14980   'type',
14981   '  TObject = class',
14982   '    Key: longint;',
14983   '    class var State: longint;',
14984   '    function GetSize: longint; virtual; abstract;',
14985   '    procedure SetSize(Value: longint); virtual; abstract;',
14986   '    property Size: longint read GetSize write SetSize;',
14987   '  end;',
14988   '  TBird = class',
14989   '    procedure DoIt;',
14990   '  end;',
14991   'procedure tbird.doit;',
14992   '  procedure Sub;',
14993   '  begin',
14994   '    key:=key+2;',
14995   '    self.key:=self.key+3;',
14996   '    state:=state+4;',
14997   '    self.state:=self.state+5;',
14998   '    tobject.state:=tobject.state+6;',
14999   '    size:=size+7;',
15000   '    self.size:=self.size+8;',
15001   '  end;',
15002   'begin',
15003   '  sub;',
15004   '  key:=key+12;',
15005   '  self.key:=self.key+13;',
15006   '  state:=state+14;',
15007   '  self.state:=self.state+15;',
15008   '  tobject.state:=tobject.state+16;',
15009   '  size:=size+17;',
15010   '  self.size:=self.size+18;',
15011   'end;',
15012   'begin',
15013   '']);
15014   ConvertProgram;
15015   CheckSource('TestClass_NestedProcSelf2',
15016     LinesToStr([ // statements
15017     'rtl.createClass($mod, "TObject", null, function () {',
15018     '  this.State = 0;',
15019     '  this.$init = function () {',
15020     '    this.Key = 0;',
15021     '  };',
15022     '  this.$final = function () {',
15023     '  };',
15024     '});',
15025     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
15026     '  this.DoIt = function () {',
15027     '    var $Self = this;',
15028     '    function Sub() {',
15029     '      $Self.Key = $Self.Key + 2;',
15030     '      $Self.Key = $Self.Key + 3;',
15031     '      $mod.TObject.State = $Self.State + 4;',
15032     '      $mod.TObject.State = $Self.State + 5;',
15033     '      $mod.TObject.State = $mod.TObject.State + 6;',
15034     '      $Self.SetSize($Self.GetSize() + 7);',
15035     '      $Self.SetSize($Self.GetSize() + 8);',
15036     '    };',
15037     '    Sub();',
15038     '    $Self.Key = $Self.Key + 12;',
15039     '    $Self.Key = $Self.Key + 13;',
15040     '    $mod.TObject.State = $Self.State + 14;',
15041     '    $mod.TObject.State = $Self.State + 15;',
15042     '    $mod.TObject.State = $mod.TObject.State + 16;',
15043     '    $Self.SetSize($Self.GetSize() + 17);',
15044     '    $Self.SetSize($Self.GetSize() + 18);',
15045     '  };',
15046     '});',
15047     '']),
15048     LinesToStr([ // $mod.$main
15049     '']));
15050 end;
15051 
15052 procedure TTestModule.TestClass_NestedProcClassSelf;
15053 begin
15054   StartProgram(false);
15055   Add([
15056   'type',
15057   '  TObject = class',
15058   '    class var State: longint;',
15059   '    class procedure DoIt;',
15060   '    class function GetSize: longint; virtual; abstract;',
15061   '    class procedure SetSize(Value: longint); virtual; abstract;',
15062   '    class property Size: longint read GetSize write SetSize;',
15063   '  end;',
15064   'class procedure tobject.doit;',
15065   '  procedure Sub;',
15066   '  begin',
15067   '    state:=state+2;',
15068   '    self.state:=self.state+3;',
15069   '    tobject.state:=tobject.state+4;',
15070   '    size:=size+5;',
15071   '    self.size:=self.size+6;',
15072   '    tobject.size:=tobject.size+7;',
15073   '  end;',
15074   'begin',
15075   '  sub;',
15076   '  state:=state+12;',
15077   '  self.state:=self.state+13;',
15078   '  tobject.state:=tobject.state+14;',
15079   '  size:=size+15;',
15080   '  self.size:=self.size+16;',
15081   '  tobject.size:=tobject.size+17;',
15082   'end;',
15083   'begin',
15084   '']);
15085   ConvertProgram;
15086   CheckSource('TestClass_NestedProcClassSelf',
15087     LinesToStr([ // statements
15088     'rtl.createClass($mod, "TObject", null, function () {',
15089     '  this.State = 0;',
15090     '  this.$init = function () {',
15091     '  };',
15092     '  this.$final = function () {',
15093     '  };',
15094     '  this.DoIt = function () {',
15095     '    var $Self = this;',
15096     '    function Sub() {',
15097     '      $mod.TObject.State = $Self.State + 2;',
15098     '      $mod.TObject.State = $Self.State + 3;',
15099     '      $mod.TObject.State = $mod.TObject.State + 4;',
15100     '      $Self.SetSize($Self.GetSize() + 5);',
15101     '      $Self.SetSize($Self.GetSize() + 6);',
15102     '      $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
15103     '    };',
15104     '    Sub();',
15105     '    $mod.TObject.State = $Self.State + 12;',
15106     '    $mod.TObject.State = $Self.State + 13;',
15107     '    $mod.TObject.State = $mod.TObject.State + 14;',
15108     '    $Self.SetSize($Self.GetSize() + 15);',
15109     '    $Self.SetSize($Self.GetSize() + 16);',
15110     '    $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
15111     '  };',
15112     '});',
15113     '']),
15114     LinesToStr([ // $mod.$main
15115     '']));
15116 end;
15117 
15118 procedure TTestModule.TestClass_NestedProcCallInherited;
15119 begin
15120   StartProgram(false);
15121   Add([
15122   'type',
15123   '  TObject = class',
15124   '    function DoIt(k: boolean): longint; virtual;',
15125   '  end;',
15126   '  TBird = class',
15127   '    function DoIt(k: boolean): longint; override;',
15128   '  end;',
15129   'function tobject.doit(k: boolean): longint;',
15130   'begin',
15131   'end;',
15132   'function tbird.doit(k: boolean): longint;',
15133   '  procedure Sub;',
15134   '  begin',
15135   '    inherited DoIt(true);',
15136   //'    if inherited DoIt(false)=4 then ;',
15137   '  end;',
15138   'begin',
15139   '  Sub;',
15140   '  inherited;',
15141   '  inherited DoIt(true);',
15142   //'  if inherited DoIt(false)=14 then ;',
15143   'end;',
15144   'begin',
15145   '']);
15146   ConvertProgram;
15147   CheckSource('TestClass_NestedProcCallInherited',
15148     LinesToStr([ // statements
15149     'rtl.createClass($mod, "TObject", null, function () {',
15150     '  this.$init = function () {',
15151     '  };',
15152     '  this.$final = function () {',
15153     '  };',
15154     '  this.DoIt = function (k) {',
15155     '    var Result = 0;',
15156     '    return Result;',
15157     '  };',
15158     '});',
15159     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
15160     '  this.DoIt = function (k) {',
15161     '    var $Self = this;',
15162     '    var Result = 0;',
15163     '    function Sub() {',
15164     '      $mod.TObject.DoIt.call($Self, true);',
15165     '    };',
15166     '    Sub();',
15167     '    $mod.TObject.DoIt.apply($Self, arguments);',
15168     '    $mod.TObject.DoIt.call($Self, true);',
15169     '    return Result;',
15170     '  };',
15171     '});',
15172     '']),
15173     LinesToStr([ // $mod.$main
15174     '']));
15175 end;
15176 
15177 procedure TTestModule.TestClass_TObjectFree;
15178 begin
15179   StartProgram(false);
15180   Add([
15181   'type',
15182   '  TObject = class',
15183   '    Obj: tobject;',
15184   '    procedure Free;',
15185   '    procedure Release;',
15186   '  end;',
15187   'procedure tobject.free;',
15188   'begin',
15189   'end;',
15190   'procedure tobject.release;',
15191   'begin',
15192   '  free;',
15193   '  if true then free;',
15194   'end;',
15195   'function DoIt(o: tobject): tobject;',
15196   'var l: tobject;',
15197   'begin',
15198   '  o.free;',
15199   '  o.free();',
15200   '  l.free;',
15201   '  l.free();',
15202   '  o.obj.free;',
15203   '  o.obj.free();',
15204   '  with o do obj.free;',
15205   '  with o do obj.free();',
15206   '  result.Free;',
15207   '  result.Free();',
15208   'end;',
15209   'var o: tobject;',
15210   '  a: array of tobject;',
15211   'begin',
15212   '  o.free;',
15213   '  o.obj.free;',
15214   '  a[1+2].free;',
15215   '']);
15216   ConvertProgram;
15217   CheckSource('TestClass_TObjectFree',
15218     LinesToStr([ // statements
15219     'rtl.createClass($mod, "TObject", null, function () {',
15220     '  this.$init = function () {',
15221     '    this.Obj = null;',
15222     '  };',
15223     '  this.$final = function () {',
15224     '    this.Obj = undefined;',
15225     '  };',
15226     '  this.Free = function () {',
15227     '  };',
15228     '  this.Release = function () {',
15229     '    this.Free();',
15230     '    if (true) this.Free();',
15231     '  };',
15232     '});',
15233     'this.DoIt = function (o) {',
15234     '  var Result = null;',
15235     '  var l = null;',
15236     '  o = rtl.freeLoc(o);',
15237     '  o = rtl.freeLoc(o);',
15238     '  l = rtl.freeLoc(l);',
15239     '  l = rtl.freeLoc(l);',
15240     '  rtl.free(o, "Obj");',
15241     '  rtl.free(o, "Obj");',
15242     '  rtl.free(o, "Obj");',
15243     '  rtl.free(o, "Obj");',
15244     '  Result = rtl.freeLoc(Result);',
15245     '  Result = rtl.freeLoc(Result);',
15246     '  return Result;',
15247     '};',
15248     'this.o = null;',
15249     'this.a = [];',
15250     '']),
15251     LinesToStr([ // $mod.$main
15252     'rtl.free($mod, "o");',
15253     'rtl.free($mod.o, "Obj");',
15254     'rtl.free($mod.a, 1 + 2);',
15255     '']));
15256 end;
15257 
15258 procedure TTestModule.TestClass_TObjectFree_VarArg;
15259 begin
15260   StartProgram(false);
15261   Add([
15262   'type',
15263   '  TObject = class',
15264   '    Obj: tobject;',
15265   '    procedure Free;',
15266   '  end;',
15267   'procedure tobject.free;',
15268   'begin',
15269   'end;',
15270   'procedure DoIt(var o: tobject);',
15271   'begin',
15272   '  o.free;',
15273   '  o.free();',
15274   'end;',
15275   'begin',
15276   '']);
15277   ConvertProgram;
15278   CheckSource('TestClass_TObjectFree_VarArg',
15279     LinesToStr([ // statements
15280     'rtl.createClass($mod, "TObject", null, function () {',
15281     '  this.$init = function () {',
15282     '    this.Obj = null;',
15283     '  };',
15284     '  this.$final = function () {',
15285     '    this.Obj = undefined;',
15286     '  };',
15287     '  this.Free = function () {',
15288     '  };',
15289     '});',
15290     'this.DoIt = function (o) {',
15291     '  o.set(rtl.freeLoc(o.get()));',
15292     '  o.set(rtl.freeLoc(o.get()));',
15293     '};',
15294     '']),
15295     LinesToStr([ // $mod.$main
15296     '']));
15297 end;
15298 
15299 procedure TTestModule.TestClass_TObjectFreeNewInstance;
15300 begin
15301   StartProgram(false);
15302   Add([
15303   'type',
15304   '  TObject = class',
15305   '    constructor Create;',
15306   '    procedure Free;',
15307   '  end;',
15308   'constructor TObject.Create; begin end;',
15309   'procedure tobject.free; begin end;',
15310   'begin',
15311   '  with tobject.create do free;',
15312   '']);
15313   ConvertProgram;
15314   CheckSource('TestClass_TObjectFreeNewInstance',
15315     LinesToStr([ // statements
15316     'rtl.createClass($mod, "TObject", null, function () {',
15317     '  this.$init = function () {',
15318     '  };',
15319     '  this.$final = function () {',
15320     '  };',
15321     '  this.Create = function () {',
15322     '    return this;',
15323     '  };',
15324     '  this.Free = function () {',
15325     '  };',
15326     '});',
15327     '']),
15328     LinesToStr([ // $mod.$main
15329     'var $with = $mod.TObject.$create("Create");',
15330     '$with=rtl.freeLoc($with);',
15331     '']));
15332 end;
15333 
15334 procedure TTestModule.TestClass_TObjectFreeLowerCase;
15335 begin
15336   StartProgram(false);
15337   Add([
15338   'type',
15339   '  TObject = class',
15340   '    destructor Destroy;',
15341   '    procedure Free;',
15342   '  end;',
15343   'destructor TObject.Destroy; begin end;',
15344   'procedure tobject.free; begin end;',
15345   'var o: tobject;',
15346   'begin',
15347   '  o.free;',
15348   '']);
15349   Converter.UseLowerCase:=true;
15350   ConvertProgram;
15351   CheckSource('TestClass_TObjectFreeLowerCase',
15352     LinesToStr([ // statements
15353     'rtl.createClass($mod, "tobject", null, function () {',
15354     '  this.$init = function () {',
15355     '  };',
15356     '  this.$final = function () {',
15357     '  };',
15358     '  rtl.tObjectDestroy = "destroy";',
15359     '  this.destroy = function () {',
15360     '  };',
15361     '  this.free = function () {',
15362     '  };',
15363     '});',
15364     'this.o = null;',
15365     '']),
15366     LinesToStr([ // $mod.$main
15367     'rtl.free($mod, "o");',
15368     '']));
15369 end;
15370 
15371 procedure TTestModule.TestClass_TObjectFreeFunctionFail;
15372 begin
15373   StartProgram(false);
15374   Add([
15375   'type',
15376   '  TObject = class',
15377   '    procedure Free;',
15378   '    function GetObj: tobject; virtual; abstract;',
15379   '  end;',
15380   'procedure tobject.free;',
15381   'begin',
15382   'end;',
15383   'var o: tobject;',
15384   'begin',
15385   '  o.getobj.free;',
15386   '']);
15387   SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
15388   ConvertProgram;
15389 end;
15390 
15391 procedure TTestModule.TestClass_TObjectFreePropertyFail;
15392 begin
15393   StartProgram(false);
15394   Add([
15395   'type',
15396   '  TObject = class',
15397   '    procedure Free;',
15398   '    FObj: TObject;',
15399   '    property Obj: tobject read FObj write FObj;',
15400   '  end;',
15401   'procedure tobject.free;',
15402   'begin',
15403   'end;',
15404   'var o: tobject;',
15405   'begin',
15406   '  o.obj.free;',
15407   '']);
15408   SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
15409   ConvertProgram;
15410 end;
15411 
15412 procedure TTestModule.TestClass_ForIn;
15413 begin
15414   StartProgram(false);
15415   Add([
15416   'type',
15417   '  TObject = class end;',
15418   '  TItem = TObject;',
15419   '  TEnumerator = class',
15420   '    FCurrent: TItem;',
15421   '    property Current: TItem read FCurrent;',
15422   '    function MoveNext: boolean;',
15423   '  end;',
15424   '  TBird = class',
15425   '    function GetEnumerator: TEnumerator;',
15426   '  end;',
15427   'function TEnumerator.MoveNext: boolean;',
15428   'begin',
15429   'end;',
15430   'function TBird.GetEnumerator: TEnumerator;',
15431   'begin',
15432   'end;',
15433   'var',
15434   '  b: TBird;',
15435   '  i, i2: TItem;',
15436   'begin',
15437   '  for i in b do i2:=i;']);
15438   ConvertProgram;
15439   CheckSource('TestClass_ForIn',
15440     LinesToStr([ // statements
15441     'rtl.createClass($mod, "TObject", null, function () {',
15442     '  this.$init = function () {',
15443     '  };',
15444     '  this.$final = function () {',
15445     '  };',
15446     '});',
15447     'rtl.createClass($mod, "TEnumerator", $mod.TObject, function () {',
15448     '  this.$init = function () {',
15449     '    $mod.TObject.$init.call(this);',
15450     '    this.FCurrent = null;',
15451     '  };',
15452     '  this.$final = function () {',
15453     '    this.FCurrent = undefined;',
15454     '    $mod.TObject.$final.call(this);',
15455     '  };',
15456     '  this.MoveNext = function () {',
15457     '    var Result = false;',
15458     '    return Result;',
15459     '  };',
15460     '});',
15461     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
15462     '  this.GetEnumerator = function () {',
15463     '    var Result = null;',
15464     '    return Result;',
15465     '  };',
15466     '});',
15467     'this.b = null;',
15468     'this.i = null;',
15469     'this.i2 = null;'
15470     ]),
15471     LinesToStr([ // $mod.$main
15472     'var $in = $mod.b.GetEnumerator();',
15473     'try {',
15474     '  while ($in.MoveNext()){',
15475     '    $mod.i = $in.FCurrent;',
15476     '    $mod.i2 = $mod.i;',
15477     '  }',
15478     '} finally {',
15479     '  $in = rtl.freeLoc($in)',
15480     '};',
15481     '']));
15482 end;
15483 
15484 procedure TTestModule.TestClass_DispatchMessage;
15485 begin
15486   StartProgram(false);
15487   Add([
15488   'type',
15489   '  TObject = class',
15490   '    {$DispatchField DispInt}',
15491   '    procedure Dispatch(var Msg); virtual; abstract;',
15492   '    {$DispatchStrField DispStr}',
15493   '    procedure DispatchStr(var Msg); virtual; abstract;',
15494   '  end;',
15495   '  THopMsg = record',
15496   '    DispInt: longint;',
15497   '  end;',
15498   '  TPutMsg = record',
15499   '    DispStr: string;',
15500   '  end;',
15501   '  TBird = class',
15502   '    procedure Fly(var Msg); virtual; abstract; message 2;',
15503   '    procedure Run; overload; virtual; abstract;',
15504   '    procedure Run(var Msg); overload; message ''Fast'';',
15505   '    procedure Hop(var Msg: THopMsg); virtual; abstract; message 3;',
15506   '    procedure Put(var Msg: TPutMsg); virtual; abstract; message ''foo'';',
15507   '  end;',
15508   'procedure TBird.Run(var Msg);',
15509   'begin',
15510   'end;',
15511   'begin',
15512   '']);
15513   ConvertProgram;
15514   CheckSource('TestClass_Message',
15515     LinesToStr([ // statements
15516     'rtl.createClass($mod, "TObject", null, function () {',
15517     '  this.$init = function () {',
15518     '  };',
15519     '  this.$final = function () {',
15520     '  };',
15521     '});',
15522     'rtl.recNewT($mod, "THopMsg", function () {',
15523     '  this.DispInt = 0;',
15524     '  this.$eq = function (b) {',
15525     '    return this.DispInt === b.DispInt;',
15526     '  };',
15527     '  this.$assign = function (s) {',
15528     '    this.DispInt = s.DispInt;',
15529     '    return this;',
15530     '  };',
15531     '});',
15532     'rtl.recNewT($mod, "TPutMsg", function () {',
15533     '  this.DispStr = "";',
15534     '  this.$eq = function (b) {',
15535     '    return this.DispStr === b.DispStr;',
15536     '  };',
15537     '  this.$assign = function (s) {',
15538     '    this.DispStr = s.DispStr;',
15539     '    return this;',
15540     '  };',
15541     '});',
15542     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
15543     '  this.Run$1 = function (Msg) {',
15544     '  };',
15545     '  this.$msgint = {',
15546     '    "2": "Fly",',
15547     '    "3": "Hop"',
15548     '  };',
15549     '  this.$msgstr = {',
15550     '    Fast: "Run$1",',
15551     '    foo: "Put"',
15552     '  };',
15553     '});',
15554     '']),
15555     LinesToStr([ // $mod.$main
15556     '']));
15557 end;
15558 
15559 procedure TTestModule.TestClass_Message_DuplicateIntFail;
15560 begin
15561   StartProgram(false);
15562   Add([
15563   'type',
15564   '  TObject = class',
15565   '    procedure Fly(var Msg); virtual; abstract; message 3;',
15566   '    procedure Run(var Msg); virtual; abstract; message 1+2;',
15567   '  end;',
15568   'begin',
15569   '']);
15570   SetExpectedPasResolverError('Duplicate message id "3" at test1.pp(5,56)',nDuplicateMessageIdXAtY);
15571   ConvertProgram;
15572 end;
15573 
15574 procedure TTestModule.TestClass_DispatchMessage_WrongFieldNameFail;
15575 begin
15576   StartProgram(false);
15577   Add([
15578   'type',
15579   '  TObject = class',
15580   '    {$dispatchfield Msg}',
15581   '    procedure Dispatch(var Msg); virtual; abstract;',
15582   '  end;',
15583   '  TFlyMsg = record',
15584   '    FlyId: longint;',
15585   '  end;',
15586   '  TBird = class',
15587   '    procedure Fly(var Msg: TFlyMsg); virtual; abstract; message 3;',
15588   '  end;',
15589   'begin',
15590   '']);
15591   ConvertProgram;
15592   CheckHint(mtWarning,nDispatchRequiresX,'Dispatch requires record field "Msg"');
15593 end;
15594 
15595 procedure TTestModule.TestClassOf_Create;
15596 begin
15597   StartProgram(false);
15598   Add('type');
15599   Add('  TObject = class');
15600   Add('    constructor Create;');
15601   Add('  end;');
15602   Add('  TClass = class of TObject;');
15603   Add('constructor tobject.create; begin end;');
15604   Add('var');
15605   Add('  Obj: tobject;');
15606   Add('  C: tclass;');
15607   Add('begin');
15608   Add('  obj:=C.create;');
15609   Add('  with c do obj:=create;');
15610   ConvertProgram;
15611   CheckSource('TestClassOf_Create',
15612     LinesToStr([ // statements
15613     'rtl.createClass($mod, "TObject", null, function () {',
15614     '  this.$init = function () {',
15615     '  };',
15616     '  this.$final = function () {',
15617     '  };',
15618     '  this.Create = function () {',
15619     '    return this;',
15620     '  };',
15621     '});',
15622     'this.Obj = null;',
15623     'this.C = null;'
15624     ]),
15625     LinesToStr([ // $mod.$main
15626     '$mod.Obj = $mod.C.$create("Create");',
15627     'var $with = $mod.C;',
15628     '$mod.Obj = $with.$create("Create");',
15629     '']));
15630 end;
15631 
15632 procedure TTestModule.TestClassOf_Call;
15633 begin
15634   StartProgram(false);
15635   Add('type');
15636   Add('  TObject = class');
15637   Add('    class procedure DoIt;');
15638   Add('  end;');
15639   Add('  TClass = class of TObject;');
15640   Add('class procedure tobject.doit; begin end;');
15641   Add('var');
15642   Add('  C: tclass;');
15643   Add('begin');
15644   Add('  c.doit;');
15645   Add('  with c do doit;');
15646   ConvertProgram;
15647   CheckSource('TestClassOf_Call',
15648     LinesToStr([ // statements
15649     'rtl.createClass($mod, "TObject", null, function () {',
15650     '  this.$init = function () {',
15651     '  };',
15652     '  this.$final = function () {',
15653     '  };',
15654     '  this.DoIt = function () {',
15655     '  };',
15656     '});',
15657     'this.C = null;'
15658     ]),
15659     LinesToStr([ // $mod.$main
15660     '$mod.C.DoIt();',
15661     'var $with = $mod.C;',
15662     '$with.DoIt();',
15663     '']));
15664 end;
15665 
15666 procedure TTestModule.TestClassOf_Assign;
15667 begin
15668   StartProgram(false);
15669   Add('type');
15670   Add('  TClass = class of TObject;');
15671   Add('  TObject = class');
15672   Add('    ClassType: TClass; ');
15673   Add('  end;');
15674   Add('var');
15675   Add('  Obj: tobject;');
15676   Add('  C: tclass;');
15677   Add('begin');
15678   Add('  c:=nil;');
15679   Add('  c:=obj.classtype;');
15680   ConvertProgram;
15681   CheckSource('TestClassOf_Assign',
15682     LinesToStr([ // statements
15683     'rtl.createClass($mod, "TObject", null, function () {',
15684     '  this.$init = function () {',
15685     '    this.ClassType = null;',
15686     '  };',
15687     '  this.$final = function () {',
15688     '    this.ClassType = undefined;',
15689     '  };',
15690     '});',
15691     'this.Obj = null;',
15692     'this.C = null;'
15693     ]),
15694     LinesToStr([ // $mod.$main
15695     '$mod.C = null;',
15696     '$mod.C = $mod.Obj.ClassType;',
15697     '']));
15698 end;
15699 
15700 procedure TTestModule.TestClassOf_Is;
15701 begin
15702   StartProgram(false);
15703   Add('type');
15704   Add('  TClass = class of TObject;');
15705   Add('  TObject = class');
15706   Add('  end;');
15707   Add('  TCar = class');
15708   Add('  end;');
15709   Add('  TCars = class of TCar;');
15710   Add('var');
15711   Add('  Obj: tobject;');
15712   Add('  C: tclass;');
15713   Add('  Cars: tcars;');
15714   Add('begin');
15715   Add('  if c is tcar then ;');
15716   Add('  if c is tcars then ;');
15717   ConvertProgram;
15718   CheckSource('TestClassOf_Is',
15719     LinesToStr([ // statements
15720     'rtl.createClass($mod, "TObject", null, function () {',
15721     '  this.$init = function () {',
15722     '  };',
15723     '  this.$final = function () {',
15724     '  };',
15725     '});',
15726     'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
15727     '});',
15728     'this.Obj = null;',
15729     'this.C = null;',
15730     'this.Cars = null;'
15731     ]),
15732     LinesToStr([ // $mod.$main
15733     'if(rtl.is($mod.C,$mod.TCar));',
15734     'if(rtl.is($mod.C,$mod.TCar));',
15735     '']));
15736 end;
15737 
15738 procedure TTestModule.TestClassOf_Compare;
15739 begin
15740   StartProgram(false);
15741   Add('type');
15742   Add('  TClass = class of TObject;');
15743   Add('  TObject = class');
15744   Add('    ClassType: TClass; ');
15745   Add('  end;');
15746   Add('var');
15747   Add('  b: boolean;');
15748   Add('  Obj: tobject;');
15749   Add('  C: tclass;');
15750   Add('begin');
15751   Add('  b:=c=nil;');
15752   Add('  b:=nil=c;');
15753   Add('  b:=c=obj.classtype;');
15754   Add('  b:=obj.classtype=c;');
15755   Add('  b:=c=TObject;');
15756   Add('  b:=TObject=c;');
15757   Add('  b:=c<>nil;');
15758   Add('  b:=nil<>c;');
15759   Add('  b:=c<>obj.classtype;');
15760   Add('  b:=obj.classtype<>c;');
15761   Add('  b:=c<>TObject;');
15762   Add('  b:=TObject<>c;');
15763   ConvertProgram;
15764   CheckSource('TestClassOf_Compare',
15765     LinesToStr([ // statements
15766     'rtl.createClass($mod, "TObject", null, function () {',
15767     '  this.$init = function () {',
15768     '    this.ClassType = null;',
15769     '  };',
15770     '  this.$final = function () {',
15771     '    this.ClassType = undefined;',
15772     '  };',
15773     '});',
15774     'this.b = false;',
15775     'this.Obj = null;',
15776     'this.C = null;'
15777     ]),
15778     LinesToStr([ // $mod.$main
15779     '$mod.b = $mod.C === null;',
15780     '$mod.b = null === $mod.C;',
15781     '$mod.b = $mod.C === $mod.Obj.ClassType;',
15782     '$mod.b = $mod.Obj.ClassType === $mod.C;',
15783     '$mod.b = $mod.C === $mod.TObject;',
15784     '$mod.b = $mod.TObject === $mod.C;',
15785     '$mod.b = $mod.C !== null;',
15786     '$mod.b = null !== $mod.C;',
15787     '$mod.b = $mod.C !== $mod.Obj.ClassType;',
15788     '$mod.b = $mod.Obj.ClassType !== $mod.C;',
15789     '$mod.b = $mod.C !== $mod.TObject;',
15790     '$mod.b = $mod.TObject !== $mod.C;',
15791     '']));
15792 end;
15793 
15794 procedure TTestModule.TestClassOf_ClassVar;
15795 begin
15796   StartProgram(false);
15797   Add('type');
15798   Add('  TObject = class');
15799   Add('    class var id: longint;');
15800   Add('  end;');
15801   Add('  TClass = class of TObject;');
15802   Add('var');
15803   Add('  C: tclass;');
15804   Add('begin');
15805   Add('  C.id:=C.id;');
15806   ConvertProgram;
15807   CheckSource('TestClassOf_ClassVar',
15808     LinesToStr([ // statements
15809     'rtl.createClass($mod, "TObject", null, function () {',
15810     '  this.id = 0;',
15811     '  this.$init = function () {',
15812     '  };',
15813     '  this.$final = function () {',
15814     '  };',
15815     '});',
15816     'this.C = null;'
15817     ]),
15818     LinesToStr([ // $mod.$main
15819     '$mod.TObject.id = $mod.C.id;',
15820     '']));
15821 end;
15822 
15823 procedure TTestModule.TestClassOf_ClassMethod;
15824 begin
15825   StartProgram(false);
15826   Add('type');
15827   Add('  TObject = class');
15828   Add('    class function DoIt(i: longint = 0): longint;');
15829   Add('  end;');
15830   Add('  TClass = class of TObject;');
15831   Add('class function tobject.doit(i: longint = 0): longint; begin end;');
15832   Add('var');
15833   Add('  i: longint;');
15834   Add('  C: tclass;');
15835   Add('begin');
15836   Add('  C.DoIt;');
15837   Add('  C.DoIt();');
15838   Add('  i:=C.DoIt;');
15839   Add('  i:=C.DoIt();');
15840   ConvertProgram;
15841   CheckSource('TestClassOf_ClassMethod',
15842     LinesToStr([ // statements
15843     'rtl.createClass($mod, "TObject", null, function () {',
15844     '  this.$init = function () {',
15845     '  };',
15846     '  this.$final = function () {',
15847     '  };',
15848     '  this.DoIt = function (i) {',
15849     '    var Result = 0;',
15850     '    return Result;',
15851     '  };',
15852     '});',
15853     'this.i = 0;',
15854     'this.C = null;'
15855     ]),
15856     LinesToStr([ // $mod.$main
15857     '$mod.C.DoIt(0);',
15858     '$mod.C.DoIt(0);',
15859     '$mod.i = $mod.C.DoIt(0);',
15860     '$mod.i = $mod.C.DoIt(0);',
15861     '']));
15862 end;
15863 
15864 procedure TTestModule.TestClassOf_ClassProperty;
15865 begin
15866   StartProgram(false);
15867   Add([
15868   'type',
15869   '  TObject = class',
15870   '    class var FA: longint;',
15871   '    class function GetA: longint;',
15872   '    class procedure SetA(Value: longint);',
15873   '    class property pA: longint read fa write fa;',
15874   '    class property pB: longint read geta write seta;',
15875   '  end;',
15876   '  TObjectClass = class of tobject;',
15877   'class function tobject.geta: longint; begin end;',
15878   'class procedure tobject.seta(value: longint); begin end;',
15879   'var',
15880   '  b: boolean;',
15881   '  Obj: tobject;',
15882   '  Cla: tobjectclass;',
15883   'begin',
15884   '  obj.pa:=obj.pa;',
15885   '  obj.pb:=obj.pb;',
15886   '  b:=obj.pa=4;',
15887   '  b:=obj.pb=obj.pb;',
15888   '  b:=5=obj.pa;',
15889   '  cla.pa:=6;',
15890   '  cla.pa:=cla.pa;',
15891   '  cla.pb:=cla.pb;',
15892   '  b:=cla.pa=7;',
15893   '  b:=cla.pb=cla.pb;',
15894   '  b:=8=cla.pa;',
15895   '  tobject.pa:=9;',
15896   '  tobject.pb:=tobject.pb;',
15897   '  b:=tobject.pa=10;',
15898   '  b:=11=tobject.pa;',
15899   '']);
15900   ConvertProgram;
15901   CheckSource('TestClassOf_ClassProperty',
15902     LinesToStr([ // statements
15903     'rtl.createClass($mod, "TObject", null, function () {',
15904     '  this.FA = 0;',
15905     '  this.$init = function () {',
15906     '  };',
15907     '  this.$final = function () {',
15908     '  };',
15909     '  this.GetA = function () {',
15910     '    var Result = 0;',
15911     '    return Result;',
15912     '  };',
15913     '  this.SetA = function (Value) {',
15914     '  };',
15915     '});',
15916     'this.b = false;',
15917     'this.Obj = null;',
15918     'this.Cla = null;'
15919     ]),
15920     LinesToStr([ // $mod.$main
15921     '$mod.TObject.FA = $mod.Obj.FA;',
15922     '$mod.Obj.$class.SetA($mod.Obj.$class.GetA());',
15923     '$mod.b = $mod.Obj.FA === 4;',
15924     '$mod.b = $mod.Obj.$class.GetA() === $mod.Obj.$class.GetA();',
15925     '$mod.b = 5 === $mod.Obj.FA;',
15926     '$mod.TObject.FA = 6;',
15927     '$mod.TObject.FA = $mod.Cla.FA;',
15928     '$mod.Cla.SetA($mod.Cla.GetA());',
15929     '$mod.b = $mod.Cla.FA === 7;',
15930     '$mod.b = $mod.Cla.GetA() === $mod.Cla.GetA();',
15931     '$mod.b = 8 === $mod.Cla.FA;',
15932     '$mod.TObject.FA = 9;',
15933     '$mod.TObject.SetA($mod.TObject.GetA());',
15934     '$mod.b = $mod.TObject.FA === 10;',
15935     '$mod.b = 11 === $mod.TObject.FA;',
15936     '']));
15937 end;
15938 
15939 procedure TTestModule.TestClassOf_ClassMethodSelf;
15940 begin
15941   StartProgram(false);
15942   Add('type');
15943   Add('  TObject = class');
15944   Add('    class var GlobalId: longint;');
15945   Add('    class procedure ProcA;');
15946   Add('  end;');
15947   Add('class procedure tobject.proca;');
15948   Add('var b: boolean;');
15949   Add('begin');
15950   Add('  b:=self=nil;');
15951   Add('  b:=self.globalid=3;');
15952   Add('  b:=4=self.globalid;');
15953   Add('  self.globalid:=5;');
15954   Add('  self.proca;');
15955   Add('end;');
15956   Add('begin');
15957   ConvertProgram;
15958   CheckSource('TestClassOf_ClassMethodSelf',
15959     LinesToStr([ // statements
15960     'rtl.createClass($mod, "TObject", null, function () {',
15961     '  this.GlobalId = 0;',
15962     '  this.$init = function () {',
15963     '  };',
15964     '  this.$final = function () {',
15965     '  };',
15966     '  this.ProcA = function () {',
15967     '    var b = false;',
15968     '    b = this === null;',
15969     '    b = this.GlobalId === 3;',
15970     '    b = 4 === this.GlobalId;',
15971     '    $mod.TObject.GlobalId = 5;',
15972     '    this.ProcA();',
15973     '  };',
15974     '});'
15975     ]),
15976     LinesToStr([ // $mod.$main
15977     '']));
15978 end;
15979 
15980 procedure TTestModule.TestClassOf_TypeCast;
15981 begin
15982   StartProgram(false);
15983   Add('type');
15984   Add('  TObject = class');
15985   Add('    class procedure {#TObject_DoIt}DoIt;');
15986   Add('  end;');
15987   Add('  TClass = class of TObject;');
15988   Add('  TMobile = class');
15989   Add('    class procedure {#TMobile_DoIt}DoIt;');
15990   Add('  end;');
15991   Add('  TMobileClass = class of TMobile;');
15992   Add('  TCar = class(TMobile)');
15993   Add('    class procedure {#TCar_DoIt}DoIt;');
15994   Add('  end;');
15995   Add('  TCarClass = class of TCar;');
15996   Add('class procedure TObject.DoIt;');
15997   Add('begin');
15998   Add('  TClass(Self).{@TObject_DoIt}DoIt;');
15999   Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
16000   Add('end;');
16001   Add('class procedure TMobile.DoIt;');
16002   Add('begin');
16003   Add('  TClass(Self).{@TObject_DoIt}DoIt;');
16004   Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
16005   Add('  TCarClass(Self).{@TCar_DoIt}DoIt;');
16006   Add('end;');
16007   Add('class procedure TCar.DoIt; begin end;');
16008   Add('var');
16009   Add('  ObjC: TClass;');
16010   Add('  MobileC: TMobileClass;');
16011   Add('  CarC: TCarClass;');
16012   Add('begin');
16013   Add('  ObjC.{@TObject_DoIt}DoIt;');
16014   Add('  MobileC.{@TMobile_DoIt}DoIt;');
16015   Add('  CarC.{@TCar_DoIt}DoIt;');
16016   Add('  TClass(ObjC).{@TObject_DoIt}DoIt;');
16017   Add('  TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
16018   Add('  TCarClass(ObjC).{@TCar_DoIt}DoIt;');
16019   Add('  TClass(MobileC).{@TObject_DoIt}DoIt;');
16020   Add('  TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
16021   Add('  TCarClass(MobileC).{@TCar_DoIt}DoIt;');
16022   Add('  TClass(CarC).{@TObject_DoIt}DoIt;');
16023   Add('  TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
16024   Add('  TCarClass(CarC).{@TCar_DoIt}DoIt;');
16025   ConvertProgram;
16026   CheckSource('TestClassOf_TypeCast',
16027     LinesToStr([ // statements
16028     'rtl.createClass($mod, "TObject", null, function () {',
16029     '  this.$init = function () {',
16030     '  };',
16031     '  this.$final = function () {',
16032     '  };',
16033     '  this.DoIt = function () {',
16034     '    this.DoIt();',
16035     '    this.DoIt$1();',
16036     '  };',
16037     '});',
16038     'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
16039     '  this.DoIt$1 = function () {',
16040     '    this.DoIt();',
16041     '    this.DoIt$1();',
16042     '    this.DoIt$2();',
16043     '  };',
16044     '});',
16045     'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
16046     '  this.DoIt$2 = function () {',
16047     '  };',
16048     '});',
16049     'this.ObjC = null;',
16050     'this.MobileC = null;',
16051     'this.CarC = null;',
16052     '']),
16053     LinesToStr([ // $mod.$main
16054     '$mod.ObjC.DoIt();',
16055     '$mod.MobileC.DoIt$1();',
16056     '$mod.CarC.DoIt$2();',
16057     '$mod.ObjC.DoIt();',
16058     '$mod.ObjC.DoIt$1();',
16059     '$mod.ObjC.DoIt$2();',
16060     '$mod.MobileC.DoIt();',
16061     '$mod.MobileC.DoIt$1();',
16062     '$mod.MobileC.DoIt$2();',
16063     '$mod.CarC.DoIt();',
16064     '$mod.CarC.DoIt$1();',
16065     '$mod.CarC.DoIt$2();',
16066     '']));
16067 end;
16068 
16069 procedure TTestModule.TestClassOf_ImplicitFunctionCall;
16070 begin
16071   StartProgram(false);
16072   Add('type');
16073   Add('  TObject = class');
16074   Add('    function CurNow: longint; ');
16075   Add('    class function Now: longint; ');
16076   Add('  end;');
16077   Add('function TObject.CurNow: longint; begin end;');
16078   Add('class function TObject.Now: longint; begin end;');
16079   Add('var');
16080   Add('  Obj: tobject;');
16081   Add('  vI: longint;');
16082   Add('begin');
16083   Add('  obj.curnow;');
16084   Add('  vi:=obj.curnow;');
16085   Add('  tobject.now;');
16086   Add('  vi:=tobject.now;');
16087   ConvertProgram;
16088   CheckSource('TestClassOf_ImplicitFunctionCall',
16089     LinesToStr([ // statements
16090     'rtl.createClass($mod, "TObject", null, function () {',
16091     '  this.$init = function () {',
16092     '  };',
16093     '  this.$final = function () {',
16094     '  };',
16095     '  this.CurNow = function () {',
16096     '    var Result = 0;',
16097     '    return Result;',
16098     '  };',
16099     '  this.Now = function () {',
16100     '    var Result = 0;',
16101     '    return Result;',
16102     '  };',
16103     '});',
16104     'this.Obj = null;',
16105     'this.vI = 0;',
16106     '']),
16107     LinesToStr([ // $mod.$main
16108     '$mod.Obj.CurNow();',
16109     '$mod.vI = $mod.Obj.CurNow();',
16110     '$mod.TObject.Now();',
16111     '$mod.vI = $mod.TObject.Now();',
16112     '']));
16113 end;
16114 
16115 procedure TTestModule.TestClassOf_Const;
16116 begin
16117   StartProgram(false);
16118   Add([
16119   'type',
16120   '  TObject = class',
16121   '  end;',
16122   '  TBird = TObject;',
16123   '  TBirds = class of TBird;',
16124   '  TEagles = TBirds;',
16125   '  THawk = class(TBird);',
16126   'const',
16127   '  Hawk: TEagles = THawk;',
16128   '  DefaultBirdClasses : Array [1..2] of TEagles = (',
16129   '    TBird,',
16130   '    THawk',
16131   '  );',
16132   'begin']);
16133   ConvertProgram;
16134   CheckSource('TestClassOf_Const',
16135     LinesToStr([ // statements
16136     'rtl.createClass($mod, "TObject", null, function () {',
16137     '  this.$init = function () {',
16138     '  };',
16139     '  this.$final = function () {',
16140     '  };',
16141     '});',
16142     'rtl.createClass($mod, "THawk", $mod.TObject, function () {',
16143     '});',
16144     'this.Hawk = $mod.THawk;',
16145     'this.DefaultBirdClasses = [$mod.TObject, $mod.THawk];',
16146     '']),
16147     LinesToStr([ // $mod.$main
16148     '']));
16149 end;
16150 
16151 procedure TTestModule.TestNestedClass_Alias;
16152 begin
16153   Converter.Options:=Converter.Options-[coNoTypeInfo];
16154   StartProgram(false);
16155   Add([
16156   'type',
16157   '  TObject = class',
16158   '    type TNested = type longint;',
16159   '  end;',
16160   'type TAlias = type tobject.tnested;',
16161   'var i: tobject.tnested = 3;',
16162   'var j: TAlias = 4;',
16163   'begin',
16164   '  if typeinfo(TAlias)=nil then ;',
16165   '  if typeinfo(tobject.tnested)=nil then ;',
16166   '']);
16167   ConvertProgram;
16168   CheckSource('TestNestedClass_Alias',
16169     LinesToStr([ // statements
16170     'rtl.createClass($mod, "TObject", null, function () {',
16171     '  $mod.$rtti.$inherited("TObject.TNested", rtl.longint, {});',
16172     '  this.$init = function () {',
16173     '  };',
16174     '  this.$final = function () {',
16175     '  };',
16176     '});',
16177     '$mod.$rtti.$inherited("TAlias", $mod.$rtti["TObject.TNested"], {});',
16178     'this.i = 3;',
16179     'this.j = 4;',
16180     '']),
16181     LinesToStr([ // $mod.$main
16182     'if ($mod.$rtti["TAlias"] === null) ;',
16183     'if ($mod.$rtti["TObject.TNested"] === null) ;',
16184     '']));
16185 end;
16186 
16187 procedure TTestModule.TestNestedClass_Record;
16188 begin
16189   Converter.Options:=Converter.Options-[coNoTypeInfo];
16190   StartProgram(false);
16191   Add([
16192   'type',
16193   '  TObject = class',
16194   '    type TPoint = record',
16195   '       x,y: byte;',
16196   '    end;',
16197   '    procedure DoIt(t: TPoint);',
16198   '  end;',
16199   'procedure tobject.DoIt(t: TPoint);',
16200   'var p: TPoint;',
16201   'begin',
16202   '  t.x:=t.y;',
16203   '  p:=t;',
16204   'end;',
16205   'var',
16206   '  p: tobject.tpoint = (x:2; y:4);',
16207   '  o: TObject;',
16208   'begin',
16209   '  p:=p;',
16210   '  o.doit(p);',
16211   '']);
16212   ConvertProgram;
16213   CheckSource('TestNestedClass_Record',
16214     LinesToStr([ // statements
16215     'rtl.createClass($mod, "TObject", null, function () {',
16216     '  rtl.recNewT(this, "TPoint", function () {',
16217     '    this.x = 0;',
16218     '    this.y = 0;',
16219     '    this.$eq = function (b) {',
16220     '      return (this.x === b.x) && (this.y === b.y);',
16221     '    };',
16222     '    this.$assign = function (s) {',
16223     '      this.x = s.x;',
16224     '      this.y = s.y;',
16225     '      return this;',
16226     '    };',
16227     '    var $r = $mod.$rtti.$Record("TObject.TPoint", {});',
16228     '    $r.addField("x", rtl.byte);',
16229     '    $r.addField("y", rtl.byte);',
16230     '  });',
16231     '  this.$init = function () {',
16232     '  };',
16233     '  this.$final = function () {',
16234     '  };',
16235     '  this.DoIt = function (t) {',
16236     '    var p = this.TPoint.$new();',
16237     '    t.x = t.y;',
16238     '    p.$assign(t);',
16239     '  };',
16240     '});',
16241     'this.p = $mod.TObject.TPoint.$clone({',
16242     '  x: 2,',
16243     '  y: 4',
16244     '});',
16245     'this.o = null;',
16246     '']),
16247     LinesToStr([ // $mod.$main
16248     '$mod.p.$assign($mod.p);',
16249     '$mod.o.DoIt($mod.TObject.TPoint.$clone($mod.p));',
16250     '']));
16251 end;
16252 
16253 procedure TTestModule.TestNestedClass_Class;
16254 begin
16255   Converter.Options:=Converter.Options-[coNoTypeInfo];
16256   StartProgram(false);
16257   Add([
16258   'type',
16259   '  TObject = class end;',
16260   '  TBird = class',
16261   '    type TLeg = class',
16262   '      FId: longint;',
16263   '      constructor Create;',
16264   '      function Create(i: longint): TLeg;',
16265   '    end;',
16266   '    function DoIt(b: TBird): Tleg;',
16267   '  end;',
16268   'constructor tbird.tleg.create;',
16269   'begin',
16270   '  FId:=3;',
16271   'end;',
16272   'function tbird.tleg.Create(i: longint): TLeg;',
16273   'begin',
16274   '  Create;',
16275   '  Result:=TLeg.Create;',
16276   '  Result:=TBird.TLeg.Create;',
16277   '  Result:=Create(3);',
16278   '  FId:=i;',
16279   'end;',
16280   'function tbird.DoIt(b: tbird): tleg;',
16281   'begin',
16282   '  Result.Create;',
16283   '  Result:=TLeg.Create;',
16284   '  Result:=TBird.TLeg.Create;',
16285   '  Result:=Result.Create(3);',
16286   'end;',
16287   'var',
16288   '  b: Tbird.tleg;',
16289   'begin',
16290   '  b.Create;',
16291   '  b:=TBird.TLeg.Create;',
16292   '  b:=b.Create(3);',
16293   '']);
16294   ConvertProgram;
16295   CheckSource('TestNestedClass_Class',
16296     LinesToStr([ // statements
16297     'rtl.createClass($mod, "TObject", null, function () {',
16298     '  this.$init = function () {',
16299     '  };',
16300     '  this.$final = function () {',
16301     '  };',
16302     '});',
16303     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
16304     '  rtl.createClass(this, "TLeg", $mod.TObject, function () {',
16305     '    this.$init = function () {',
16306     '      $mod.TObject.$init.call(this);',
16307     '      this.FId = 0;',
16308     '    };',
16309     '    this.Create = function () {',
16310     '      this.FId = 3;',
16311     '      return this;',
16312     '    };',
16313     '    this.Create$1 = function (i) {',
16314     '      var Result = null;',
16315     '      this.Create();',
16316     '      Result = $mod.TBird.TLeg.$create("Create");',
16317     '      Result = $mod.TBird.TLeg.$create("Create");',
16318     '      Result = this.Create$1(3);',
16319     '      this.FId = i;',
16320     '      return Result;',
16321     '    };',
16322     '  });',
16323     '  this.DoIt = function (b) {',
16324     '    var Result = null;',
16325     '    Result.Create();',
16326     '    Result = this.TLeg.$create("Create");',
16327     '    Result = $mod.TBird.TLeg.$create("Create");',
16328     '    Result = Result.Create$1(3);',
16329     '    return Result;',
16330     '  };',
16331     '});',
16332     'this.b = null;',
16333     '']),
16334     LinesToStr([ // $mod.$main
16335     '$mod.b.Create();',
16336     '$mod.b = $mod.TBird.TLeg.$create("Create");',
16337     '$mod.b = $mod.b.Create$1(3);',
16338     '']));
16339 end;
16340 
16341 procedure TTestModule.TestExternalClass_Var;
16342 begin
16343   StartProgram(false);
16344   Add([
16345   '{$modeswitch externalclass}',
16346   'type',
16347   '  TExtA = class external name ''ExtObj''',
16348   '    Id: longint external name ''$Id'';',
16349   '    B: longint;',
16350   '  end;',
16351   'var Obj: TExtA;',
16352   'begin',
16353   '  obj.id:=obj.id+1;',
16354   '  obj.B:=obj.B+1;']);
16355   ConvertProgram;
16356   CheckSource('TestExternalClass_Var',
16357     LinesToStr([ // statements
16358     'this.Obj = null;',
16359     '']),
16360     LinesToStr([ // $mod.$main
16361     '$mod.Obj.$Id = $mod.Obj.$Id + 1;',
16362     '$mod.Obj.B = $mod.Obj.B + 1;',
16363     '']));
16364 end;
16365 
16366 procedure TTestModule.TestExternalClass_Const;
16367 begin
16368   StartProgram(false);
16369   Add([
16370   '{$modeswitch externalclass}',
16371   'type',
16372   '  TExtA = class external name ''ExtObj''',
16373   '    const Two: longint = 2;',
16374   '    const Three = 3;',
16375   '    const Id: longint;',
16376   '  end;',
16377   '  TExtB = class external name ''ExtB''',
16378   '    A: TExtA;',
16379   '  end;',
16380   'var',
16381   '  A: texta;',
16382   '  B: textb;',
16383   '  i: longint;',
16384   'begin',
16385   '  i:=a.two;',
16386   '  i:=texta.two;',
16387   '  i:=a.three;',
16388   '  i:=texta.three;',
16389   '  i:=a.id;',
16390   '  i:=texta.id;',
16391   '']);
16392   ConvertProgram;
16393   CheckSource('TestExternalClass_Const',
16394     LinesToStr([ // statements
16395     'this.A = null;',
16396     'this.B = null;',
16397     'this.i = 0;',
16398     '']),
16399     LinesToStr([ // $mod.$main
16400     '$mod.i = 2;',
16401     '$mod.i = 2;',
16402     '$mod.i = 3;',
16403     '$mod.i = 3;',
16404     '$mod.i = $mod.A.Id;',
16405     '$mod.i = ExtObj.Id;',
16406     '']));
16407 end;
16408 
16409 procedure TTestModule.TestExternalClass_Dollar;
16410 begin
16411   StartProgram(false);
16412   Add([
16413   '{$modeswitch externalclass}',
16414   'type',
16415   '  TExtA = class external name ''$''',
16416   '    Id: longint external name ''$'';',
16417   '    function Bla(i: longint): longint; external name ''$'';',
16418   '  end;',
16419   'function dollar(k: longint): longint; external name ''$'';',
16420   'var Obj: TExtA;',
16421   'begin',
16422   '  dollar(1);',
16423   '  obj.id:=obj.id+2;',
16424   '  obj.Bla(3);',
16425   '']);
16426   ConvertProgram;
16427   CheckSource('TestExternalClass_Dollar',
16428     LinesToStr([ // statements
16429     'this.Obj = null;',
16430     '']),
16431     LinesToStr([ // $mod.$main
16432     '$(1);',
16433     '$mod.Obj.$ = $mod.Obj.$ + 2;',
16434     '$mod.Obj.$(3);',
16435     '']));
16436 end;
16437 
16438 procedure TTestModule.TestExternalClass_DuplicateVarFail;
16439 begin
16440   StartProgram(false);
16441   Add('{$modeswitch externalclass}');
16442   Add('type');
16443   Add('  TExtA = class external name ''ExtA''');
16444   Add('    Id: longint external name ''$Id'';');
16445   Add('  end;');
16446   Add('  TExtB = class external ''lib'' name ''ExtB''(TExtA)');
16447   Add('    Id: longint;');
16448   Add('  end;');
16449   Add('begin');
16450   SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,5)',nDuplicateIdentifier);
16451   ConvertProgram;
16452 end;
16453 
16454 procedure TTestModule.TestExternalClass_Method;
16455 begin
16456   StartProgram(false);
16457   Add(['{$modeswitch externalclass}',
16458   'type',
16459   '  TExtA = class external name ''ExtObj''',
16460   '    procedure DoIt(Id: longint = 1); external name ''$Execute'';',
16461   '    procedure DoSome(Id: longint = 1);',
16462   '  end;',
16463   'var Obj: texta;',
16464   'begin',
16465   '  obj.doit;',
16466   '  obj.doit();',
16467   '  obj.doit(2);',
16468   '  with obj do begin',
16469   '    doit;',
16470   '    doit();',
16471   '    doit(3);',
16472   '  end;']);
16473   ConvertProgram;
16474   CheckSource('TestExternalClass_Method',
16475     LinesToStr([ // statements
16476     'this.Obj = null;',
16477     '']),
16478     LinesToStr([ // $mod.$main
16479     '$mod.Obj.$Execute(1);',
16480     '$mod.Obj.$Execute(1);',
16481     '$mod.Obj.$Execute(2);',
16482     'var $with = $mod.Obj;',
16483     '$with.$Execute(1);',
16484     '$with.$Execute(1);',
16485     '$with.$Execute(3);',
16486     '']));
16487 end;
16488 
16489 procedure TTestModule.TestExternalClass_ClassMethod;
16490 begin
16491   StartProgram(false);
16492   Add([
16493   '{$modeswitch externalclass}',
16494   'type',
16495   '  TExtA = class external name ''ExtObj''',
16496   '    class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
16497   '  end;',
16498   '  TExtB = TExtA;',
16499   'var p: Pointer;',
16500   'begin',
16501   '  texta.doit;',
16502   '  texta.doit();',
16503   '  texta.doit(2);',
16504   '  p:=@TExtA.DoIt;',
16505   '  with texta do begin',
16506   '    doit;',
16507   '    doit();',
16508   '    doit(3);',
16509   '    p:=@DoIt;',
16510   '  end;',
16511   '  textb.doit;',
16512   '  textb.doit();',
16513   '  textb.doit(4);',
16514   '  with textb do begin',
16515   '    doit;',
16516   '    doit();',
16517   '    doit(5);',
16518   '  end;',
16519   '']);
16520   ConvertProgram;
16521   CheckSource('TestExternalClass_ClassMethod',
16522     LinesToStr([ // statements
16523     'this.p = null;',
16524     '']),
16525     LinesToStr([ // $mod.$main
16526     'ExtObj.$Execute(1);',
16527     'ExtObj.$Execute(1);',
16528     'ExtObj.$Execute(2);',
16529     '$mod.p = rtl.createCallback(ExtObj, "$Execute");',
16530     'ExtObj.$Execute(1);',
16531     'ExtObj.$Execute(1);',
16532     'ExtObj.$Execute(3);',
16533     '$mod.p = rtl.createCallback(ExtObj, "$Execute");',
16534     'ExtObj.$Execute(1);',
16535     'ExtObj.$Execute(1);',
16536     'ExtObj.$Execute(4);',
16537     'ExtObj.$Execute(1);',
16538     'ExtObj.$Execute(1);',
16539     'ExtObj.$Execute(5);',
16540     '']));
16541 end;
16542 
16543 procedure TTestModule.TestExternalClass_ClassMethodStatic;
16544 begin
16545   StartProgram(false);
16546   Add([
16547   '{$modeswitch externalclass}',
16548   'type',
16549   '  TExtA = class external name ''ExtObj''',
16550   '    class procedure DoIt(Id: longint = 1); static;',
16551   '  end;',
16552   'var p: Pointer;',
16553   'begin',
16554   '  texta.doit;',
16555   '  texta.doit();',
16556   '  texta.doit(2);',
16557   '  p:=@TExtA.DoIt;',
16558   '  with texta do begin',
16559   '    doit;',
16560   '    doit();',
16561   '    doit(3);',
16562   '    p:=@DoIt;',
16563   '  end;',
16564   '']);
16565   ConvertProgram;
16566   CheckSource('TestExternalClass_ClassMethodStatic',
16567     LinesToStr([ // statements
16568     'this.p = null;',
16569     '']),
16570     LinesToStr([ // $mod.$main
16571     'ExtObj.DoIt(1);',
16572     'ExtObj.DoIt(1);',
16573     'ExtObj.DoIt(2);',
16574     '$mod.p = ExtObj.DoIt;',
16575     'ExtObj.DoIt(1);',
16576     'ExtObj.DoIt(1);',
16577     'ExtObj.DoIt(3);',
16578     '$mod.p = ExtObj.DoIt;',
16579     '']));
16580 end;
16581 
16582 procedure TTestModule.TestExternalClass_FunctionResultInTypeCast;
16583 begin
16584   StartProgram(false);
16585   Add([
16586   '{$modeswitch externalclass}',
16587   'type',
16588   '  TBird = class external name ''Array''',
16589   '  end;',
16590   'function GetPtr: Pointer;',
16591   'begin',
16592   'end;',
16593   'procedure Write(const p);',
16594   'begin',
16595   'end;',
16596   'procedure WriteLn; varargs;',
16597   'begin',
16598   'end;',
16599   'begin',
16600   '  if TBird(GetPtr)=nil then ;',
16601   '  Write(GetPtr);',
16602   '  WriteLn(GetPtr);',
16603   '  Write(TBird(GetPtr));',
16604   '  WriteLn(TBird(GetPtr));',
16605   '']);
16606   ConvertProgram;
16607   CheckSource('TestFunctionResultInTypeCast',
16608     LinesToStr([ // statements
16609     'this.GetPtr = function () {',
16610     '  var Result = null;',
16611     '  return Result;',
16612     '};',
16613     'this.Write = function (p) {',
16614     '};',
16615     'this.WriteLn = function () {',
16616     '};',
16617     '']),
16618     LinesToStr([
16619     'if ($mod.GetPtr() === null) ;',
16620     '$mod.Write($mod.GetPtr());',
16621     '$mod.WriteLn($mod.GetPtr());',
16622     '$mod.Write($mod.GetPtr());',
16623     '$mod.WriteLn($mod.GetPtr());',
16624     '']));
16625 end;
16626 
16627 procedure TTestModule.TestExternalClass_NonExternalOverride;
16628 begin
16629   StartProgram(false);
16630   Add([
16631   '{$modeswitch externalclass}',
16632   'type',
16633   '  TExtA = class external name ''ExtObjA''',
16634   '    procedure ProcA; virtual;',
16635   '    procedure ProcB; virtual;',
16636   '  end;',
16637   '  TExtB = class external name ''ExtObjB'' (TExtA)',
16638   '  end;',
16639   '  TExtC = class (TExtB)',
16640   '    procedure ProcA; override;',
16641   '  end;',
16642   'procedure TExtC.ProcA;',
16643   'begin',
16644   '  ProcA;',
16645   '  Self.ProcA;',
16646   '  ProcB;',
16647   '  Self.ProcB;',
16648   'end;',
16649   'var',
16650   '  A: texta;',
16651   '  B: textb;',
16652   '  C: textc;',
16653   'begin',
16654   '  a.proca;',
16655   '  b.proca;',
16656   '  c.proca;']);
16657   ConvertProgram;
16658   CheckSource('TestExternalClass_NonExternalOverride',
16659     LinesToStr([ // statements
16660     'rtl.createClassExt($mod, "TExtC", ExtObjB, "", function () {',
16661     '  this.$init = function () {',
16662     '  };',
16663     '  this.$final = function () {',
16664     '  };',
16665     '  this.ProcA = function () {',
16666     '    this.ProcA();',
16667     '    this.ProcA();',
16668     '    this.ProcB();',
16669     '    this.ProcB();',
16670     '  };',
16671     '});',
16672     'this.A = null;',
16673     'this.B = null;',
16674     'this.C = null;',
16675     '']),
16676     LinesToStr([ // $mod.$main
16677     '$mod.A.ProcA();',
16678     '$mod.B.ProcA();',
16679     '$mod.C.ProcA();',
16680     '']));
16681 end;
16682 
16683 procedure TTestModule.TestExternalClass_OverloadHint;
16684 begin
16685   StartProgram(false);
16686   Add([
16687   '{$modeswitch externalclass}',
16688   'type',
16689   '  TExtA = class external name ''ExtObjA''',
16690   '    procedure DoIt;',
16691   '    procedure DoIt(i: longint);',
16692   '  end;',
16693   'begin',
16694   '']);
16695   ConvertProgram;
16696   CheckResolverUnexpectedHints(true);
16697   CheckSource('TestExternalClass_OverloadHint',
16698     LinesToStr([ // statements
16699     '']),
16700     LinesToStr([ // $mod.$main
16701     '']));
16702 end;
16703 
16704 procedure TTestModule.TestExternalClass_SameNamePublishedProperty;
16705 begin
16706   StartProgram(false);
16707   Add([
16708   '{$modeswitch externalclass}',
16709   'type',
16710   '  JSwiper = class external name ''Swiper''',
16711   '    constructor New;',
16712   '  end;',
16713   '  TObject = class',
16714   '  private',
16715   '    FSwiper: JSwiper;',
16716   '  published',
16717   '    property Swiper: JSwiper read FSwiper write FSwiper;',
16718   '  end;',
16719   'begin',
16720   '  JSwiper.new;',
16721   '']);
16722   ConvertProgram;
16723   CheckSource('TestExternalClass_SameNamePublishedProperty',
16724     LinesToStr([ // statements
16725     'rtl.createClass($mod, "TObject", null, function () {',
16726     '  this.$init = function () {',
16727     '    this.FSwiper = null;',
16728     '  };',
16729     '  this.$final = function () {',
16730     '    this.FSwiper = undefined;',
16731     '  };',
16732     '  var $r = this.$rtti;',
16733     '  $r.addProperty("Swiper", 0, $mod.$rtti["JSwiper"], "FSwiper", "FSwiper");',
16734     '});',
16735     '']),
16736     LinesToStr([ // $mod.$main
16737     'new Swiper();',
16738     '']));
16739 end;
16740 
16741 procedure TTestModule.TestExternalClass_Property;
16742 begin
16743   StartProgram(false);
16744   Add([
16745   '{$modeswitch externalclass}',
16746   'type',
16747   '  TExtA = class external name ''ExtA''',
16748   '    function getYear: longint;',
16749   '    procedure setYear(Value: longint);',
16750   '    property Year: longint read getyear write setyear;',
16751   '  end;',
16752   '  TExtB = class (TExtA)',
16753   '    procedure OtherSetYear(Value: longint);',
16754   '    property year write othersetyear;',
16755   '  end;',
16756   'procedure textb.othersetyear(value: longint);',
16757   'begin',
16758   '  setYear(Value+4);',
16759   'end;',
16760   'var',
16761   '  A: texta;',
16762   '  B: textb;',
16763   'begin',
16764   '  a.year:=a.year+1;',
16765   '  b.year:=b.year+2;']);
16766   ConvertProgram;
16767   CheckSource('TestExternalClass_NonExternalOverride',
16768     LinesToStr([ // statements
16769     'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
16770     '  this.$init = function () {',
16771     '  };',
16772     '  this.$final = function () {',
16773     '  };',
16774     '  this.OtherSetYear = function (Value) {',
16775     '    this.setYear(Value+4);',
16776     '  };',
16777     '});',
16778     'this.A = null;',
16779     'this.B = null;',
16780     '']),
16781     LinesToStr([ // $mod.$main
16782     '$mod.A.setYear($mod.A.getYear()+1);',
16783     '$mod.B.OtherSetYear($mod.B.getYear()+2);',
16784     '']));
16785 end;
16786 
16787 procedure TTestModule.TestExternalClass_PropertyDate;
16788 begin
16789   StartProgram(false);
16790   Add([
16791   '{$modeswitch externalclass}',
16792   'type',
16793   '  TExtA = class external name ''ExtA''',
16794   '  end;',
16795   '  TExtB = class (TExtA)',
16796   '    FDate: string;',
16797   '    property Date: string read FDate write FDate;',
16798   '    property ExtA: string read FDate write FDate;',
16799   '  end;',
16800   '  {$M+}',
16801   '  TObject = class',
16802   '    FDate: string;',
16803   '  published',
16804   '    property Date: string read FDate write FDate;',
16805   '    property ExtA: string read FDate write FDate;',
16806   '  end;',
16807   'var',
16808   '  B: textb;',
16809   '  o: TObject;',
16810   'begin',
16811   '  b.date:=b.exta;',
16812   '  o.date:=o.exta;']);
16813   ConvertProgram;
16814   CheckSource('TestExternalClass_PropertyDate',
16815     LinesToStr([ // statements
16816     'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
16817     '  this.$init = function () {',
16818     '    this.FDate = "";',
16819     '  };',
16820     '  this.$final = function () {',
16821     '  };',
16822     '});',
16823     'rtl.createClass($mod, "TObject", null, function () {',
16824     '  this.$init = function () {',
16825     '    this.FDate = "";',
16826     '  };',
16827     '  this.$final = function () {',
16828     '  };',
16829     '  var $r = this.$rtti;',
16830     '  $r.addField("FDate", rtl.string);',
16831     '  $r.addProperty("Date", 0, rtl.string, "FDate", "FDate");',
16832     '  $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate");',
16833     '});',
16834     'this.B = null;',
16835     'this.o = null;',
16836     '']),
16837     LinesToStr([ // $mod.$main
16838     '$mod.B.FDate = $mod.B.FDate;',
16839     '$mod.o.FDate = $mod.o.FDate;',
16840     '']));
16841 end;
16842 
16843 procedure TTestModule.TestExternalClass_ClassProperty;
16844 begin
16845   StartProgram(false);
16846   Add('{$modeswitch externalclass}');
16847   Add('type');
16848   Add('  TExtA = class external name ''ExtA''');
16849   Add('    class function getYear: longint;');
16850   Add('    class procedure setYear(Value: longint);');
16851   Add('    class property Year: longint read getyear write setyear;');
16852   Add('  end;');
16853   Add('  TExtB = class (TExtA)');
16854   Add('    class function GetCentury: longint;');
16855   Add('    class procedure SetCentury(Value: longint);');
16856   Add('    class property Century: longint read getcentury write setcentury;');
16857   Add('  end;');
16858   Add('class function textb.getcentury: longint;');
16859   Add('begin');
16860   Add('end;');
16861   Add('class procedure textb.setcentury(value: longint);');
16862   Add('begin');
16863   Add('  setyear(value+11);');
16864   Add('  texta.year:=texta.year+12;');
16865   Add('  year:=year+13;');
16866   Add('  textb.century:=textb.century+14;');
16867   Add('  century:=century+15;');
16868   Add('end;');
16869   Add('var');
16870   Add('  A: texta;');
16871   Add('  B: textb;');
16872   Add('begin');
16873   Add('  texta.year:=texta.year+1;');
16874   Add('  textb.year:=textb.year+2;');
16875   Add('  TextA.year:=TextA.year+3;');
16876   Add('  b.year:=b.year+4;');
16877   Add('  textb.century:=textb.century+5;');
16878   Add('  b.century:=b.century+6;');
16879   ConvertProgram;
16880   CheckSource('TestExternalClass_ClassProperty',
16881     LinesToStr([ // statements
16882     'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
16883     '  this.$init = function () {',
16884     '  };',
16885     '  this.$final = function () {',
16886     '  };',
16887     '  this.GetCentury = function () {',
16888     '    var Result = 0;',
16889     '    return Result;',
16890     '  };',
16891     '  this.SetCentury = function (Value) {',
16892     '    this.setYear(Value + 11);',
16893     '    ExtA.setYear(ExtA.getYear() + 12);',
16894     '    this.setYear(this.getYear() + 13);',
16895     '    $mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 14);',
16896     '    this.SetCentury(this.GetCentury() + 15);',
16897     '  };',
16898     '});',
16899     'this.A = null;',
16900     'this.B = null;',
16901     '']),
16902     LinesToStr([ // $mod.$main
16903     'ExtA.setYear(ExtA.getYear() + 1);',
16904     '$mod.TExtB.setYear($mod.TExtB.getYear() + 2);',
16905     'ExtA.setYear(ExtA.getYear() + 3);',
16906     '$mod.B.setYear($mod.B.getYear() + 4);',
16907     '$mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 5);',
16908     '$mod.B.$class.SetCentury($mod.B.$class.GetCentury() + 6);',
16909     '']));
16910 end;
16911 
16912 procedure TTestModule.TestExternalClass_ClassOf;
16913 begin
16914   StartProgram(false);
16915   Add('{$modeswitch externalclass}');
16916   Add('type');
16917   Add('  TExtA = class external name ''ExtA''');
16918   Add('    procedure ProcA; virtual;');
16919   Add('    procedure ProcB; virtual;');
16920   Add('  end;');
16921   Add('  TExtAClass = class of TExtA;');
16922   Add('  TExtB = class external name ''ExtB'' (TExtA)');
16923   Add('  end;');
16924   Add('  TExtBClass = class of TExtB;');
16925   Add('  TExtC = class (TExtB)');
16926   Add('    procedure ProcA; override;');
16927   Add('  end;');
16928   Add('  TExtCClass = class of TExtC;');
16929   Add('procedure TExtC.ProcA; begin end;');
16930   Add('var');
16931   Add('  A: texta; ClA: TExtAClass;');
16932   Add('  B: textb; ClB: TExtBClass;');
16933   Add('  C: textc; ClC: TExtCClass;');
16934   Add('begin');
16935   Add('  ClA:=texta;');
16936   Add('  ClA:=textb;');
16937   Add('  ClA:=textc;');
16938   Add('  ClB:=textb;');
16939   Add('  ClB:=textc;');
16940   Add('  ClC:=textc;');
16941   ConvertProgram;
16942   CheckSource('TestExternalClass_ClassOf',
16943     LinesToStr([ // statements
16944     'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
16945     '  this.$init = function () {',
16946     '  };',
16947     '  this.$final = function () {',
16948     '  };',
16949     '  this.ProcA = function () {',
16950     '  };',
16951     '});',
16952     'this.A = null;',
16953     'this.ClA = null;',
16954     'this.B = null;',
16955     'this.ClB = null;',
16956     'this.C = null;',
16957     'this.ClC = null;',
16958     '']),
16959     LinesToStr([ // $mod.$main
16960     '$mod.ClA = ExtA;',
16961     '$mod.ClA = ExtB;',
16962     '$mod.ClA = $mod.TExtC;',
16963     '$mod.ClB = ExtB;',
16964     '$mod.ClB = $mod.TExtC;',
16965     '$mod.ClC = $mod.TExtC;',
16966     '']));
16967 end;
16968 
16969 procedure TTestModule.TestExternalClass_ClassOtherUnit;
16970 begin
16971   AddModuleWithIntfImplSrc('unit2.pas',
16972     LinesToStr([
16973     '{$modeswitch externalclass}',
16974     'type',
16975     '  TExtA = class external name ''ExtA''',
16976     '    class var Id: longint;',
16977     '  end;',
16978     '']),
16979     '');
16980 
16981   StartUnit(true);
16982   Add('interface');
16983   Add('uses unit2;');
16984   Add('implementation');
16985   Add('begin');
16986   Add('  unit2.texta.id:=unit2.texta.id+1;');
16987   ConvertUnit;
16988   CheckSource('TestExternalClass_ClassOtherUnit',
16989     LinesToStr([
16990     '']),
16991     LinesToStr([
16992     'ExtA.Id = ExtA.Id + 1;',
16993     '']));
16994 end;
16995 
16996 procedure TTestModule.TestExternalClass_Is;
16997 begin
16998   StartProgram(false);
16999   Add([
17000   '{$modeswitch externalclass}',
17001   'type',
17002   '  TExtA = class external name ''ExtA''',
17003   '  end;',
17004   '  TExtAClass = class of TExtA;',
17005   '  TExtB = class external name ''ExtB'' (TExtA)',
17006   '  end;',
17007   '  TExtBClass = class of TExtB;',
17008   '  TExtC = class (TExtB)',
17009   '  end;',
17010   '  TExtCClass = class of TExtC;',
17011   'var',
17012   '  A: texta; ClA: TExtAClass;',
17013   '  B: textb; ClB: TExtBClass;',
17014   '  C: textc; ClC: TExtCClass;',
17015   'begin',
17016   '  if a is textb then ;',
17017   '  if a is textc then ;',
17018   '  if b is textc then ;',
17019   '  if cla is textb then ;',
17020   '  if cla is textc then ;',
17021   '  if clb is textc then ;',
17022   '  try',
17023   '  except',
17024   '  on TExtA do ;',
17025   '  on e: TExtB do ;',
17026   '  end;',
17027   '']);
17028   ConvertProgram;
17029   CheckSource('TestExternalClass_Is',
17030     LinesToStr([ // statements
17031     'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
17032     '  this.$init = function () {',
17033     '  };',
17034     '  this.$final = function () {',
17035     '  };',
17036     '});',
17037     'this.A = null;',
17038     'this.ClA = null;',
17039     'this.B = null;',
17040     'this.ClB = null;',
17041     'this.C = null;',
17042     'this.ClC = null;',
17043     '']),
17044     LinesToStr([ // $mod.$main
17045     'if (rtl.isExt($mod.A, ExtB)) ;',
17046     'if ($mod.TExtC.isPrototypeOf($mod.A)) ;',
17047     'if ($mod.TExtC.isPrototypeOf($mod.B)) ;',
17048     'if (rtl.isExt($mod.ClA, ExtB)) ;',
17049     'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
17050     'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
17051     'try {} catch ($e) {',
17052     '  if (rtl.isExt($e,ExtA)) {}',
17053     '  else if (rtl.isExt($e,ExtB)) {',
17054     '    var e = $e;',
17055     '  } else throw $e',
17056     '};',
17057     '']));
17058 end;
17059 
17060 procedure TTestModule.TestExternalClass_As;
17061 begin
17062   StartProgram(false);
17063   Add('{$modeswitch externalclass}');
17064   Add('type');
17065   Add('  TExtA = class external name ''ExtA''');
17066   Add('  end;');
17067   Add('  TExtB = class external name ''ExtB'' (TExtA)');
17068   Add('  end;');
17069   Add('  TExtC = class (TExtB)');
17070   Add('  end;');
17071   Add('var');
17072   Add('  A: texta;');
17073   Add('  B: textb;');
17074   Add('  C: textc;');
17075   Add('begin');
17076   Add('  b:=a as textb;');
17077   Add('  c:=a as textc;');
17078   Add('  c:=b as textc;');
17079   ConvertProgram;
17080   CheckSource('TestExternalClass_Is',
17081     LinesToStr([ // statements
17082     'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
17083     '  this.$init = function () {',
17084     '  };',
17085     '  this.$final = function () {',
17086     '  };',
17087     '});',
17088     'this.A = null;',
17089     'this.B = null;',
17090     'this.C = null;',
17091     '']),
17092     LinesToStr([ // $mod.$main
17093     '$mod.B = rtl.asExt($mod.A, ExtB);',
17094     '$mod.C = rtl.as($mod.A, $mod.TExtC);',
17095     '$mod.C = rtl.as($mod.B, $mod.TExtC);',
17096     '']));
17097 end;
17098 
17099 procedure TTestModule.TestExternalClass_DestructorFail;
17100 begin
17101   StartProgram(false);
17102   Add('{$modeswitch externalclass}');
17103   Add('type');
17104   Add('  TExtA = class external name ''ExtA''');
17105   Add('    destructor Free;');
17106   Add('  end;');
17107   SetExpectedPasResolverError('Pascal element not supported: destructor',
17108     nPasElementNotSupported);
17109   ConvertProgram;
17110 end;
17111 
17112 procedure TTestModule.TestExternalClass_New;
17113 begin
17114   StartProgram(false);
17115   Add([
17116   '{$modeswitch externalclass}',
17117   'type',
17118   '  TExtA = class external name ''ExtA''',
17119   '    constructor New;',
17120   '    constructor New(i: longint; j: longint = 2);',
17121   '  end;',
17122   'var',
17123   '  A: texta;',
17124   'begin',
17125   '  a:=texta.new;',
17126   '  a:=texta(texta.new);',
17127   '  a:=texta.new();',
17128   '  a:=texta.new(1);',
17129   '  with texta do begin',
17130   '    a:=new;',
17131   '    a:=new();',
17132   '    a:=new(2);',
17133   '  end;',
17134   '  a:=test1.texta.new;',
17135   '  a:=test1.texta.new();',
17136   '  a:=test1.texta.new(3);',
17137   '']);
17138   ConvertProgram;
17139   CheckSource('TestExternalClass_New',
17140     LinesToStr([ // statements
17141     'this.A = null;',
17142     '']),
17143     LinesToStr([ // $mod.$main
17144     '$mod.A = new ExtA();',
17145     '$mod.A = new ExtA();',
17146     '$mod.A = new ExtA();',
17147     '$mod.A = new ExtA(1,2);',
17148     '$mod.A = new ExtA();',
17149     '$mod.A = new ExtA();',
17150     '$mod.A = new ExtA(2,2);',
17151     '$mod.A = new ExtA();',
17152     '$mod.A = new ExtA();',
17153     '$mod.A = new ExtA(3,2);',
17154     '']));
17155 end;
17156 
17157 procedure TTestModule.TestExternalClass_ClassOf_New;
17158 begin
17159   StartProgram(false);
17160   Add('{$modeswitch externalclass}');
17161   Add('type');
17162   Add('  TExtAClass = class of TExtA;');
17163   Add('  TExtA = class external name ''ExtA''');
17164   Add('    C: TExtAClass;');
17165   Add('    constructor New;');
17166   Add('  end;');
17167   Add('var');
17168   Add('  A: texta;');
17169   Add('  C: textaclass;');
17170   Add('begin');
17171   Add('  a:=c.new;');
17172   Add('  a:=c.new();');
17173   Add('  with C do begin');
17174   Add('    a:=new;');
17175   Add('    a:=new();');
17176   Add('  end;');
17177   Add('  a:=test1.c.new;');
17178   Add('  a:=test1.c.new();');
17179   Add('  a:=A.c.new();');
17180   ConvertProgram;
17181   CheckSource('TestExternalClass_ClassOf_New',
17182     LinesToStr([ // statements
17183     'this.A = null;',
17184     'this.C = null;',
17185     '']),
17186     LinesToStr([ // $mod.$main
17187     '$mod.A = new $mod.C();',
17188     '$mod.A = new $mod.C();',
17189     'var $with = $mod.C;',
17190     '$mod.A = new $with();',
17191     '$mod.A = new $with();',
17192     '$mod.A = new $mod.C();',
17193     '$mod.A = new $mod.C();',
17194     '$mod.A = new $mod.A.C();',
17195     '']));
17196 end;
17197 
17198 procedure TTestModule.TestExternalClass_FuncClassOf_New;
17199 begin
17200   StartProgram(false);
17201   Add([
17202   '{$modeswitch externalclass}',
17203   'type',
17204   '  TExtAClass = class of TExtA;',
17205   '  TExtA = class external name ''ExtA''',
17206   '    constructor New;',
17207   '  end;',
17208   'function GetCreator: TExtAClass;',
17209   'begin',
17210   '  Result:=TExtA;',
17211   'end;',
17212   'var',
17213   '  A: texta;',
17214   'begin',
17215   '  a:=getcreator.new;',
17216   '  a:=getcreator().new;',
17217   '  a:=getcreator().new();',
17218   '  a:=getcreator.new();',
17219   '  with getcreator do begin',
17220   '    a:=new;',
17221   '    a:=new();',
17222   '  end;']);
17223   ConvertProgram;
17224   CheckSource('TestExternalClass_FuncClassOf_New',
17225     LinesToStr([ // statements
17226     'this.GetCreator = function () {',
17227     '  var Result = null;',
17228     '  Result = ExtA;',
17229     '  return Result;',
17230     '};',
17231     'this.A = null;',
17232     '']),
17233     LinesToStr([ // $mod.$main
17234     '$mod.A = new ($mod.GetCreator())();',
17235     '$mod.A = new ($mod.GetCreator())();',
17236     '$mod.A = new ($mod.GetCreator())();',
17237     '$mod.A = new ($mod.GetCreator())();',
17238     'var $with = $mod.GetCreator();',
17239     '$mod.A = new $with();',
17240     '$mod.A = new $with();',
17241     '']));
17242 end;
17243 
17244 procedure TTestModule.TestExternalClass_New_PasClassFail;
17245 begin
17246   StartProgram(false);
17247   Add([
17248   '{$modeswitch externalclass}',
17249   'type',
17250   '  TExtA = class external name ''ExtA''',
17251   '    constructor New;',
17252   '  end;',
17253   '  TBird = class(TExtA)',
17254   '  end;',
17255   'begin',
17256   '  TBird.new;',
17257   '']);
17258   SetExpectedPasResolverError(sJSNewNotSupported,nJSNewNotSupported);
17259   ConvertProgram;
17260 end;
17261 
17262 procedure TTestModule.TestExternalClass_New_PasClassBracketsFail;
17263 begin
17264   StartProgram(false);
17265   Add([
17266   '{$modeswitch externalclass}',
17267   'type',
17268   '  TExtA = class external name ''ExtA''',
17269   '    constructor New;',
17270   '  end;',
17271   '  TBird = class(TExtA)',
17272   '  end;',
17273   'begin',
17274   '  TBird.new();',
17275   '']);
17276   SetExpectedPasResolverError(sJSNewNotSupported,nJSNewNotSupported);
17277   ConvertProgram;
17278 end;
17279 
17280 procedure TTestModule.TestExternalClass_NewExtName;
17281 begin
17282   StartProgram(false);
17283   Add([
17284   '{$modeswitch externalclass}',
17285   'type',
17286   '  TExtA = class external name ''ExtA''',
17287   '    constructor New; external name ''Other'';',
17288   '    constructor New(i: longint; j: longint = 2); external name ''A.B'';',
17289   '  end;',
17290   'var',
17291   '  A: texta;',
17292   'begin',
17293   '  a:=texta.new;',
17294   '  a:=texta(texta.new);',
17295   '  a:=texta.new();',
17296   '  a:=texta.new(1);',
17297   '  with texta do begin',
17298   '    a:=new;',
17299   '    a:=new();',
17300   '    a:=new(2);',
17301   '  end;',
17302   '  a:=test1.texta.new;',
17303   '  a:=test1.texta.new();',
17304   '  a:=test1.texta.new(3);',
17305   '']);
17306   ConvertProgram;
17307   CheckSource('TestExternalClass_NewExtName',
17308     LinesToStr([ // statements
17309     'this.A = null;',
17310     '']),
17311     LinesToStr([ // $mod.$main
17312     '$mod.A = new Other();',
17313     '$mod.A = new Other();',
17314     '$mod.A = new Other();',
17315     '$mod.A = new A.B(1,2);',
17316     '$mod.A = new Other();',
17317     '$mod.A = new Other();',
17318     '$mod.A = new A.B(2,2);',
17319     '$mod.A = new Other();',
17320     '$mod.A = new Other();',
17321     '$mod.A = new A.B(3,2);',
17322     '']));
17323 end;
17324 
17325 procedure TTestModule.TestExternalClass_Constructor;
17326 begin
17327   StartProgram(false);
17328   Add([
17329   '{$modeswitch externalclass}',
17330   'type',
17331   '  TExtA = class external name ''ExtA''',
17332   '    constructor Create;',
17333   '    constructor Create(i: longint; j: longint = 2);',
17334   '  end;',
17335   'var',
17336   '  A: texta;',
17337   'begin',
17338   '  a:=texta.create;',
17339   '  a:=texta(texta.create);',
17340   '  a:=texta.create();',
17341   '  a:=texta.create(1);',
17342   '  with texta do begin',
17343   '    a:=create;',
17344   '    a:=create();',
17345   '    a:=create(2);',
17346   '  end;',
17347   '  a:=test1.texta.create;',
17348   '  a:=test1.texta.create();',
17349   '  a:=test1.texta.create(3);',
17350   '']);
17351   ConvertProgram;
17352   CheckSource('TestExternalClass_Constructor',
17353     LinesToStr([ // statements
17354     'this.A = null;',
17355     '']),
17356     LinesToStr([ // $mod.$main
17357     '$mod.A = new ExtA.Create();',
17358     '$mod.A = new ExtA.Create();',
17359     '$mod.A = new ExtA.Create();',
17360     '$mod.A = new ExtA.Create(1,2);',
17361     '$mod.A = new ExtA.Create();',
17362     '$mod.A = new ExtA.Create();',
17363     '$mod.A = new ExtA.Create(2,2);',
17364     '$mod.A = new ExtA.Create();',
17365     '$mod.A = new ExtA.Create();',
17366     '$mod.A = new ExtA.Create(3,2);',
17367     '']));
17368 end;
17369 
17370 procedure TTestModule.TestExternalClass_ConstructorBrackets;
17371 begin
17372   StartProgram(false);
17373   Add([
17374   '{$modeswitch externalclass}',
17375   'type',
17376   '  TExtA = class external name ''ExtA''',
17377   '    constructor Create; external name ''{}'';',
17378   '  end;',
17379   'var',
17380   '  A: texta;',
17381   'begin',
17382   '  a:=texta.create;',
17383   '  a:=texta(texta.create);',
17384   '  a:=texta.create();',
17385   '  with texta do begin',
17386   '    a:=create;',
17387   '    a:=create();',
17388   '  end;',
17389   '  a:=test1.texta.create;',
17390   '  a:=test1.texta.create();',
17391   '']);
17392   ConvertProgram;
17393   CheckSource('TestExternalClass_ConstructorBrackets',
17394     LinesToStr([ // statements
17395     'this.A = null;',
17396     '']),
17397     LinesToStr([ // $mod.$main
17398     '$mod.A = {};',
17399     '$mod.A = {};',
17400     '$mod.A = {};',
17401     '$mod.A = {};',
17402     '$mod.A = {};',
17403     '$mod.A = {};',
17404     '$mod.A = {};',
17405     '']));
17406 end;
17407 
17408 procedure TTestModule.TestExternalClass_LocalConstSameName;
17409 begin
17410   StartProgram(false);
17411   Add('{$modeswitch externalclass}');
17412   Add('type');
17413   Add('  TExtA = class external name ''ExtA''');
17414   Add('    constructor New;');
17415   Add('  end;');
17416   Add('function DoIt: longint;');
17417   Add('const ExtA: longint = 3;');
17418   Add('begin');
17419   Add('  Result:=ExtA;');
17420   Add('end;');
17421   Add('var');
17422   Add('  A: texta;');
17423   Add('begin');
17424   Add('  a:=texta.new;');
17425   ConvertProgram;
17426   CheckSource('TestExternalClass_LocalConstSameName',
17427     LinesToStr([ // statements
17428     'var ExtA$1 = 3;',
17429     'this.DoIt = function () {',
17430     '  var Result = 0;',
17431     '  Result = ExtA$1;',
17432     '  return Result;',
17433     '};',
17434     'this.A = null;',
17435     '']),
17436     LinesToStr([ // $mod.$main
17437     '$mod.A = new ExtA();',
17438     '']));
17439 end;
17440 
17441 procedure TTestModule.TestExternalClass_ReintroduceOverload;
17442 begin
17443   StartProgram(false);
17444   Add('{$modeswitch externalclass}');
17445   Add('type');
17446   Add('  TExtA = class external name ''ExtA''');
17447   Add('    procedure DoIt;');
17448   Add('  end;');
17449   Add('  TMyA = class(TExtA)');
17450   Add('    procedure DoIt;');
17451   Add('  end;');
17452   Add('procedure TMyA.DoIt; begin end;');
17453   Add('begin');
17454   ConvertProgram;
17455   CheckSource('TestExternalClass_ReintroduceOverload',
17456     LinesToStr([ // statements
17457     'rtl.createClassExt($mod, "TMyA", ExtA, "", function () {',
17458     '  this.$init = function () {',
17459     '  };',
17460     '  this.$final = function () {',
17461     '  };',
17462     '  this.DoIt$1 = function () {',
17463     '  };',
17464     '});',
17465     '']),
17466     LinesToStr([ // $mod.$main
17467     '']));
17468 end;
17469 
17470 procedure TTestModule.TestExternalClass_Inherited;
17471 begin
17472   StartProgram(false);
17473   Add('{$modeswitch externalclass}');
17474   Add('type');
17475   Add('  TExtA = class external name ''ExtA''');
17476   Add('    procedure DoIt(i: longint = 1); virtual;');
17477   Add('    procedure DoSome(j: longint = 2);');
17478   Add('  end;');
17479   Add('  TExtB = class external name ''ExtB''(TExtA)');
17480   Add('  end;');
17481   Add('  TMyC = class(TExtB)');
17482   Add('    procedure DoIt(i: longint = 1); override;');
17483   Add('    procedure DoSome(j: longint = 2); reintroduce;');
17484   Add('  end;');
17485   Add('procedure TMyC.DoIt(i: longint);');
17486   Add('begin');
17487   Add('  inherited;');
17488   Add('  inherited DoIt;');
17489   Add('  inherited DoIt();');
17490   Add('  inherited DoIt(3);');
17491   Add('  inherited DoSome;');
17492   Add('  inherited DoSome();');
17493   Add('  inherited DoSome(4);');
17494   Add('end;');
17495   Add('procedure TMyC.DoSome(j: longint);');
17496   Add('begin');
17497   Add('  inherited;');
17498   Add('end;');
17499   Add('begin');
17500   ConvertProgram;
17501   CheckSource('TestExternalClass_ReintroduceOverload',
17502     LinesToStr([ // statements
17503     'rtl.createClassExt($mod, "TMyC", ExtB, "", function () {',
17504     '  this.$init = function () {',
17505     '  };',
17506     '  this.$final = function () {',
17507     '  };',
17508     '  this.DoIt = function (i) {',
17509     '    ExtB.DoIt.apply(this, arguments);',
17510     '    ExtB.DoIt.call(this, 1);',
17511     '    ExtB.DoIt.call(this, 1);',
17512     '    ExtB.DoIt.call(this, 3);',
17513     '    ExtB.DoSome.call(this, 2);',
17514     '    ExtB.DoSome.call(this, 2);',
17515     '    ExtB.DoSome.call(this, 4);',
17516     '  };',
17517     '  this.DoSome$1 = function (j) {',
17518     '    ExtB.DoSome.apply(this, arguments);',
17519     '  };',
17520     '});',
17521     '']),
17522     LinesToStr([ // $mod.$main
17523     '']));
17524 end;
17525 
17526 procedure TTestModule.TestExternalClass_PascalAncestorFail;
17527 begin
17528   StartProgram(false);
17529   Add('{$modeswitch externalclass}');
17530   Add('type');
17531   Add('  TObject = class');
17532   Add('  end;');
17533   Add('  TExtA = class external name ''ExtA''(TObject)');
17534   Add('  end;');
17535   Add('begin');
17536   SetExpectedPasResolverError('Ancestor "TObject" is not external',nAncestorIsNotExternal);
17537   ConvertProgram;
17538 end;
17539 
17540 procedure TTestModule.TestExternalClass_NewInstance;
17541 begin
17542   StartProgram(false);
17543   Add('{$modeswitch externalclass}');
17544   Add('type');
17545   Add('  TExtA = class external name ''ExtA''');
17546   Add('  end;');
17547   Add('  TMyB = class(TExtA)');
17548   Add('  protected');
17549   Add('    class function NewInstance(fnname: string; const paramarray): TMyB; virtual;');
17550   Add('  end;');
17551   Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
17552   Add('begin end;');
17553   Add('begin');
17554   ConvertProgram;
17555   CheckSource('TestExternalClass_NewInstance',
17556     LinesToStr([ // statements
17557     'rtl.createClassExt($mod, "TMyB", ExtA, "NewInstance", function () {',
17558     '  this.$init = function () {',
17559     '  };',
17560     '  this.$final = function () {',
17561     '  };',
17562     '  this.NewInstance = function (fnname, paramarray) {',
17563     '    var Result = null;',
17564     '    return Result;',
17565     '  };',
17566     '});',
17567     '']),
17568     LinesToStr([ // $mod.$main
17569     '']));
17570 end;
17571 
17572 procedure TTestModule.TestExternalClass_NewInstance_NonVirtualFail;
17573 begin
17574   StartProgram(false);
17575   Add('{$modeswitch externalclass}');
17576   Add('type');
17577   Add('  TExtA = class external name ''ExtA''');
17578   Add('  end;');
17579   Add('  TMyB = class(TExtA)');
17580   Add('  protected');
17581   Add('    class function NewInstance(fnname: string; const paramarray): TMyB;');
17582   Add('  end;');
17583   Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
17584   Add('begin end;');
17585   Add('begin');
17586   SetExpectedPasResolverError(sNewInstanceFunctionMustBeVirtual,nNewInstanceFunctionMustBeVirtual);
17587   ConvertProgram;
17588 end;
17589 
17590 procedure TTestModule.TestExternalClass_NewInstance_FirstParamNotString_Fail;
17591 begin
17592   StartProgram(false);
17593   Add('{$modeswitch externalclass}');
17594   Add('type');
17595   Add('  TExtA = class external name ''ExtA''');
17596   Add('  end;');
17597   Add('  TMyB = class(TExtA)');
17598   Add('  protected');
17599   Add('    class function NewInstance(fnname: longint; const paramarray): TMyB; virtual;');
17600   Add('  end;');
17601   Add('class function TMyB.NewInstance(fnname: longint; const paramarray): TMyB;');
17602   Add('begin end;');
17603   Add('begin');
17604   SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Longint", expected "String"',
17605     nIncompatibleTypeArgNo);
17606   ConvertProgram;
17607 end;
17608 
17609 procedure TTestModule.TestExternalClass_NewInstance_SecondParamTyped_Fail;
17610 begin
17611   StartProgram(false);
17612   Add('{$modeswitch externalclass}');
17613   Add('type');
17614   Add('  TExtA = class external name ''ExtA''');
17615   Add('  end;');
17616   Add('  TMyB = class(TExtA)');
17617   Add('  protected');
17618   Add('    class function NewInstance(fnname: string; const paramarray: string): TMyB; virtual;');
17619   Add('  end;');
17620   Add('class function TMyB.NewInstance(fnname: string; const paramarray: string): TMyB;');
17621   Add('begin end;');
17622   Add('begin');
17623   SetExpectedPasResolverError('Incompatible type arg no. 2: Got "type", expected "untyped"',
17624     nIncompatibleTypeArgNo);
17625   ConvertProgram;
17626 end;
17627 
17628 procedure TTestModule.TestExternalClass_JSFunctionPasDescendant;
17629 begin
17630   StartProgram(false);
17631   Add([
17632   '{$modeswitch externalclass}',
17633   'type',
17634   '  TJSFunction = class external name ''Function''',
17635   '  end;',
17636   '  TExtA = class external name ''ExtA''(TJSFunction)',
17637   '    constructor New(w: word);',
17638   '  end;',
17639   '  TBird = class (TExtA)',
17640   '  public',
17641   '    Size: word;',
17642   '    class var Legs: word;',
17643   '    constructor Create(a: word);',
17644   '  end;',
17645   '  TEagle = class (TBird)',
17646   '  public',
17647   '    constructor Create(b: word); reintroduce;',
17648   '  end;',
17649   'constructor TBird.Create(a: word);',
17650   'begin',
17651   '  inherited;',  // silently ignored
17652   '  inherited New(a);', // this.$func(a)
17653   'end;',
17654   'constructor TEagle.Create(b: word);',
17655   'begin',
17656   '  inherited Create(b);',
17657   'end;',
17658   'var',
17659   '  Bird: TBird;',
17660   '  Eagle: TEagle;',
17661   'begin',
17662   '  Bird:=TBird.Create(3);',
17663   '  Eagle:=TEagle.Create(4);',
17664   '  Bird.Size:=Bird.Size+5;',
17665   '  Bird.Legs:=Bird.Legs+6;',
17666   '  Eagle.Size:=Eagle.Size+5;',
17667   '  Eagle.Legs:=Eagle.Legs+6;',
17668   '']);
17669   ConvertProgram;
17670   CheckSource('TestExternalClass_JSFunctionPasDescendant',
17671     LinesToStr([ // statements
17672     'rtl.createClassExt($mod, "TBird", ExtA, "", function () {',
17673     '  this.Legs = 0;',
17674     '  this.$init = function () {',
17675     '    this.Size = 0;',
17676     '  };',
17677     '  this.$final = function () {',
17678     '  };',
17679     '  this.Create = function (a) {',
17680     '    this.$ancestorfunc(a);',
17681     '    return this;',
17682     '  };',
17683     '});',
17684     'rtl.createClassExt($mod, "TEagle", $mod.TBird, "", function () {',
17685     '  this.Create$1 = function (b) {',
17686     '    $mod.TBird.Create.call(this, b);',
17687     '    return this;',
17688     '  };',
17689     '});',
17690     'this.Bird = null;',
17691     'this.Eagle = null;',
17692     '']),
17693     LinesToStr([ // $mod.$main
17694     '$mod.Bird = $mod.TBird.$create("Create", [3]);',
17695     '$mod.Eagle = $mod.TEagle.$create("Create$1", [4]);',
17696     '$mod.Bird.Size = $mod.Bird.Size + 5;',
17697     '$mod.TBird.Legs = $mod.Bird.Legs + 6;',
17698     '$mod.Eagle.Size = $mod.Eagle.Size + 5;',
17699     '$mod.TBird.Legs = $mod.Eagle.Legs + 6;',
17700     '']));
17701 end;
17702 
17703 procedure TTestModule.TestExternalClass_PascalProperty;
17704 begin
17705   StartProgram(false);
17706   Add('{$modeswitch externalclass}');
17707   Add('type');
17708   Add('  TJSElement = class;');
17709   Add('  TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
17710   Add('  TJSElement = class external name ''ExtA''');
17711   Add('  end;');
17712   Add('  TControl = class(TJSElement)');
17713   Add('  private');
17714   Add('    FOnClick: TJSNotifyEvent;');
17715   Add('    property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
17716   Add('    procedure Click(Sender: TJSElement);');
17717   Add('  end;');
17718   Add('procedure TControl.Click(Sender: TJSElement);');
17719   Add('begin');
17720   Add('  OnClick(Self);');
17721   Add('end;');
17722   Add('var');
17723   Add('  Ctrl: TControl;');
17724   Add('begin');
17725   Add('  Ctrl.OnClick:=@Ctrl.Click;');
17726   Add('  Ctrl.OnClick(Ctrl);');
17727   ConvertProgram;
17728   CheckSource('TestExternalClass_PascalProperty',
17729     LinesToStr([ // statements
17730     'rtl.createClassExt($mod, "TControl", ExtA, "", function () {',
17731     '  this.$init = function () {',
17732     '    this.FOnClick = null;',
17733     '  };',
17734     '  this.$final = function () {',
17735     '    this.FOnClick = undefined;',
17736     '  };',
17737     '  this.Click = function (Sender) {',
17738     '    this.FOnClick(this);',
17739     '  };',
17740     '});',
17741     'this.Ctrl = null;',
17742     '']),
17743     LinesToStr([ // $mod.$main
17744     '$mod.Ctrl.FOnClick = rtl.createCallback($mod.Ctrl, "Click");',
17745     '$mod.Ctrl.FOnClick($mod.Ctrl);',
17746     '']));
17747 end;
17748 
17749 procedure TTestModule.TestExternalClass_TypeCastToRootClass;
17750 begin
17751   StartProgram(false);
17752   Add([
17753   '{$modeswitch externalclass}',
17754   'type',
17755   '  IUnknown = interface end;',
17756   '  TObject = class',
17757   '  end;',
17758   '  TChild = class',
17759   '  end;',
17760   '  TExtRootA = class external name ''ExtRootA''',
17761   '  end;',
17762   '  TExtChildA = class external name ''ExtChildA''(TExtRootA)',
17763   '  end;',
17764   '  TExtRootB = class external name ''ExtRootB''',
17765   '  end;',
17766   '  TExtChildB = class external name ''ExtChildB''(TExtRootB)',
17767   '  end;',
17768   'var',
17769   '  Obj: TObject;',
17770   '  Child: TChild;',
17771   '  RootA: TExtRootA;',
17772   '  ChildA: TExtChildA;',
17773   '  RootB: TExtRootB;',
17774   '  ChildB: TExtChildB;',
17775   '  i: IUnknown;',
17776   'begin',
17777   '  obj:=tobject(roota);',
17778   '  obj:=tobject(childa);',
17779   '  child:=tchild(tobject(roota));',
17780   '  roota:=textroota(obj);',
17781   '  roota:=textroota(child);',
17782   '  roota:=textroota(rootb);',
17783   '  roota:=textroota(childb);',
17784   '  childa:=textchilda(textroota(obj));',
17785   '  roota:=TExtRootA(i)',
17786   '']);
17787   ConvertProgram;
17788   CheckSource('TestExternalClass_TypeCastToRootClass',
17789     LinesToStr([ // statements
17790     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
17791     'rtl.createClass($mod, "TObject", null, function () {',
17792     '  this.$init = function () {',
17793     '  };',
17794     '  this.$final = function () {',
17795     '  };',
17796     '});',
17797     'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
17798     '});',
17799     'this.Obj = null;',
17800     'this.Child = null;',
17801     'this.RootA = null;',
17802     'this.ChildA = null;',
17803     'this.RootB = null;',
17804     'this.ChildB = null;',
17805     'this.i = null;',
17806     '']),
17807     LinesToStr([ // $mod.$main
17808     '$mod.Obj = $mod.RootA;',
17809     '$mod.Obj = $mod.ChildA;',
17810     '$mod.Child = $mod.RootA;',
17811     '$mod.RootA = $mod.Obj;',
17812     '$mod.RootA = $mod.Child;',
17813     '$mod.RootA = $mod.RootB;',
17814     '$mod.RootA = $mod.ChildB;',
17815     '$mod.ChildA = $mod.Obj;',
17816     '$mod.RootA = $mod.i;',
17817     '']));
17818 end;
17819 
17820 procedure TTestModule.TestExternalClass_TypeCastToJSObject;
17821 begin
17822   StartProgram(false);
17823   Add([
17824   '{$modeswitch externalclass}',
17825   'type',
17826   '  IUnknown = interface end;',
17827   '  IBird = interface(IUnknown) end;',
17828   '  TClass = class of TObject;',
17829   '  TObject = class',
17830   '  end;',
17831   '  TChild = class',
17832   '  end;',
17833   '  TJSObject = class external name ''Object''',
17834   '  end;',
17835   '  TRec = record end;',
17836   'var',
17837   '  Obj: TObject;',
17838   '  Child: TChild;',
17839   '  i: IUnknown;',
17840   '  Bird: IBird;',
17841   '  j: TJSObject;',
17842   '  r: TRec;',
17843   '  c: TClass;',
17844   'begin',
17845   '  j:=tjsobject(IUnknown);',
17846   '  j:=tjsobject(IBird);',
17847   '  j:=tjsobject(TObject);',
17848   '  j:=tjsobject(TChild);',
17849   '  j:=tjsobject(TRec);',
17850   '  j:=tjsobject(Obj);',
17851   '  j:=tjsobject(Child);',
17852   '  j:=tjsobject(i);',
17853   '  j:=tjsobject(Bird);',
17854   '  j:=tjsobject(r);',
17855   '  j:=tjsobject(c);',
17856   '']);
17857   ConvertProgram;
17858   CheckSource('TestExternalClass_TypeCastToJSObject',
17859     LinesToStr([ // statements
17860     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
17861     'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-396E-AE88-000B87785074}", [], $mod.IUnknown);',
17862     'rtl.createClass($mod, "TObject", null, function () {',
17863     '  this.$init = function () {',
17864     '  };',
17865     '  this.$final = function () {',
17866     '  };',
17867     '});',
17868     'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
17869     '});',
17870     'rtl.recNewT($mod, "TRec", function () {',
17871     '  this.$eq = function (b) {',
17872     '    return true;',
17873     '  };',
17874     '  this.$assign = function (s) {',
17875     '    return this;',
17876     '  };',
17877     '});',
17878     'this.Obj = null;',
17879     'this.Child = null;',
17880     'this.i = null;',
17881     'this.Bird = null;',
17882     'this.j = null;',
17883     'this.r = $mod.TRec.$new();',
17884     'this.c = null;',
17885     '']),
17886     LinesToStr([ // $mod.$main
17887     '$mod.j = $mod.IUnknown;',
17888     '$mod.j = $mod.IBird;',
17889     '$mod.j = $mod.TObject;',
17890     '$mod.j = $mod.TChild;',
17891     '$mod.j = $mod.TRec;',
17892     '$mod.j = $mod.Obj;',
17893     '$mod.j = $mod.Child;',
17894     '$mod.j = $mod.i;',
17895     '$mod.j = $mod.Bird;',
17896     '$mod.j = $mod.r;',
17897     '$mod.j = $mod.c;',
17898     '']));
17899 end;
17900 
17901 procedure TTestModule.TestExternalClass_TypeCastStringToExternalString;
17902 begin
17903   StartProgram(false);
17904   Add('{$modeswitch externalclass}');
17905   Add('type');
17906   Add('  TJSString = class external name ''String''');
17907   Add('    class function fromCharCode() : string; varargs;');
17908   Add('    function anchor(const aName : string) : string;');
17909   Add('  end;');
17910   Add('var');
17911   Add('  s: string;');
17912   Add('begin');
17913   Add('  s:=TJSString.fromCharCode(65,66);');
17914   Add('  s:=TJSString(s).anchor(s);');
17915   Add('  s:=TJSString(''foo'').anchor(s);');
17916   ConvertProgram;
17917   CheckSource('TestExternalClass_TypeCastStringToExternalString',
17918     LinesToStr([ // statements
17919     'this.s = "";',
17920     '']),
17921     LinesToStr([ // $mod.$main
17922     '$mod.s = String.fromCharCode(65, 66);',
17923     '$mod.s = $mod.s.anchor($mod.s);',
17924     '$mod.s = "foo".anchor($mod.s);',
17925     '']));
17926 end;
17927 
17928 procedure TTestModule.TestExternalClass_TypeCastToJSFunction;
17929 begin
17930   StartProgram(false);
17931   Add([
17932   '{$modeswitch externalclass}',
17933   'type',
17934   '  TJSObject = class external name ''Object'' end;',
17935   '  TJSFunction = class external name ''Function''',
17936   '    function bind(thisArg: TJSObject): TJSFunction; varargs;',
17937   '    function call(thisArg: TJSObject): JSValue; varargs;',
17938   '  end;',
17939   '  TObject = class',
17940   '    procedure DoIt(i: longint);',
17941   '  end;',
17942   '  TFuncInt = function(o: TObject): longint;',
17943   'function GetIt(o: TObject): longint;',
17944   '  procedure Sub; begin end;',
17945   'var',
17946   '  f: TJSFunction;',
17947   '  fi: TFuncInt;',
17948   'begin',
17949   '  fi:=TFuncInt(f);',
17950   '  f:=TJSFunction(fi);',
17951   '  f:=TJSFunction(@GetIt);',
17952   '  f:=TJSFunction(@GetIt).bind(nil,3);',
17953   '  f:=TJSFunction(@Sub);',
17954   '  f:=TJSFunction(@o.doit);',
17955   '  f:=TJSFunction(fi).bind(nil,4)',
17956   'end;',
17957   'procedure TObject.DoIt(i: longint);',
17958   '  procedure Sub; begin end;',
17959   'var f: TJSFunction;',
17960   'begin',
17961   '  f:=TJSFunction(@DoIt);',
17962   '  f:=TJSFunction(@DoIt).bind(nil,13);',
17963   '  f:=TJSFunction(@Sub);',
17964   '  f:=TJSFunction(@GetIt);',
17965   'end;',
17966   'begin']);
17967   ConvertProgram;
17968   CheckSource('TestExternalClass_TypeCastToJSFunction',
17969     LinesToStr([ // statements
17970     'rtl.createClass($mod, "TObject", null, function () {',
17971     '  this.$init = function () {',
17972     '  };',
17973     '  this.$final = function () {',
17974     '  };',
17975     '  this.DoIt = function (i) {',
17976     '    var $Self = this;',
17977     '    function Sub() {',
17978     '    };',
17979     '    var f = null;',
17980     '    f = $Self.DoIt;',
17981     '    f = $Self.DoIt.bind(null, 13);',
17982     '    f = Sub;',
17983     '    f = $mod.GetIt;',
17984     '  };',
17985     '});',
17986     'this.GetIt = function (o) {',
17987     '  var Result = 0;',
17988     '  function Sub() {',
17989     '  };',
17990     '  var f = null;',
17991     '  var fi = null;',
17992     '  fi = f;',
17993     '  f = fi;',
17994     '  f = $mod.GetIt;',
17995     '  f = $mod.GetIt.bind(null, 3);',
17996     '  f = Sub;',
17997     '  f = $mod.TObject.DoIt;',
17998     '  f = fi.bind(null, 4);',
17999     '  return Result;',
18000     '};',
18001     '']),
18002     LinesToStr([ // $mod.$main
18003     '']));
18004 end;
18005 
18006 procedure TTestModule.TestExternalClass_TypeCastDelphiUnrelated;
18007 begin
18008   StartProgram(false);
18009   Add([
18010   '{$mode delphi}',
18011   '{$modeswitch externalclass}',
18012   'type',
18013   '  TJSObject = class external name ''Object'' end;',
18014   '  TJSWindow = class external name ''Window''(TJSObject)',
18015   '    procedure Open;',
18016   '  end;',
18017   '  TJSEventTarget = class external name ''Event''(TJSObject)',
18018   '    procedure Execute;',
18019   '  end;',
18020   'procedure Fly;',
18021   'var',
18022   '  w: TJSWindow;',
18023   '  e: TJSEventTarget;',
18024   'begin',
18025   '  w:=TJSWindow(e);',
18026   '  e:=TJSEventTarget(w);',
18027   'end;',
18028   'begin']);
18029   ConvertProgram;
18030   CheckSource('TestExternalClass_TypeCastDelphiUnrelated',
18031     LinesToStr([ // statements
18032     'this.Fly = function () {',
18033     '  var w = null;',
18034     '  var e = null;',
18035     '  w = e;',
18036     '  e = w;',
18037     '};',
18038     '']),
18039     LinesToStr([ // $mod.$main
18040     '']));
18041 end;
18042 
18043 procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
18044 begin
18045   StartProgram(false);
18046   Add('{$modeswitch externalclass}');
18047   Add('type');
18048   Add('  TJSString = class external name ''String''');
18049   Add('    class function fromCharCode() : string; varargs;');
18050   Add('  end;');
18051   Add('var');
18052   Add('  s: string;');
18053   Add('  sObj: TJSString;');
18054   Add('begin');
18055   Add('  s:=sObj.fromCharCode(65,66);');
18056   SetExpectedPasResolverError('External class instance cannot access static class function fromCharCode',
18057     nExternalClassInstanceCannotAccessStaticX);
18058   ConvertProgram;
18059 end;
18060 
18061 procedure TTestModule.TestExternalClass_BracketAccessor;
18062 begin
18063   StartProgram(false);
18064   Add([
18065   '{$modeswitch externalclass}',
18066   'type',
18067   '  TJSArray = class external name ''Array2''',
18068   '    function GetItems(Index: longint): jsvalue; external name ''[]'';',
18069   '    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
18070   '    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
18071   '  end;',
18072   'procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);',
18073   'begin end;',
18074   'var',
18075   '  Arr: tjsarray;',
18076   '  s: string;',
18077   '  i: longint;',
18078   '  v: jsvalue;',
18079   'begin',
18080   '  v:=arr[0];',
18081   '  v:=arr.items[1];',
18082   '  arr[2]:=s;',
18083   '  arr.items[3]:=s;',
18084   '  arr[4]:=i;',
18085   '  arr[5]:=arr[6];',
18086   '  arr.items[7]:=arr.items[8];',
18087   '  with arr do items[9]:=items[10];',
18088   '  doit(arr[7],arr[8],arr[9],arr[10]);',
18089   '  with arr do begin',
18090   '    v:=GetItems(14);',
18091   '    setitems(15,16);',
18092   '  end;',
18093   '  v:=test1.arr.items[17];',
18094   '  test1.arr.items[18]:=v;',
18095   '']);
18096   ConvertProgram;
18097   CheckSource('TestExternalClass_BracketAccessor',
18098     LinesToStr([ // statements
18099     'this.DoIt = function (vI, vJ, vK, vL) {',
18100     '};',
18101     'this.Arr = null;',
18102     'this.s = "";',
18103     'this.i = 0;',
18104     'this.v = undefined;',
18105     '']),
18106     LinesToStr([ // $mod.$main
18107     '$mod.v = $mod.Arr[0];',
18108     '$mod.v = $mod.Arr[1];',
18109     '$mod.Arr[2] = $mod.s;',
18110     '$mod.Arr[3] = $mod.s;',
18111     '$mod.Arr[4] = $mod.i;',
18112     '$mod.Arr[5] = $mod.Arr[6];',
18113     '$mod.Arr[7] = $mod.Arr[8];',
18114     'var $with = $mod.Arr;',
18115     '$with[9] = $with[10];',
18116     '$mod.DoIt($mod.Arr[7], $mod.Arr[8], {',
18117     '  a: 9,',
18118     '  p: $mod.Arr,',
18119     '  get: function () {',
18120     '      return this.p[this.a];',
18121     '    },',
18122     '  set: function (v) {',
18123     '      this.p[this.a] = v;',
18124     '    }',
18125     '}, {',
18126     '  a: 10,',
18127     '  p: $mod.Arr,',
18128     '  get: function () {',
18129     '      return this.p[this.a];',
18130     '    },',
18131     '  set: function (v) {',
18132     '      this.p[this.a] = v;',
18133     '    }',
18134     '});',
18135     'var $with1 = $mod.Arr;',
18136     '$mod.v = $with1[14];',
18137     '$with1[15] = 16;',
18138     '$mod.v = $mod.Arr[17];',
18139     '$mod.Arr[18] = $mod.v;',
18140     '']));
18141 end;
18142 
18143 procedure TTestModule.TestExternalClass_BracketAccessor_Call;
18144 begin
18145   StartProgram(false);
18146   Add([
18147   '{$modeswitch externalclass}',
18148   'type',
18149   '  TJSArray = class external name ''Array2''',
18150   '    function GetItems(Index: longint): jsvalue; external name ''[]'';',
18151   '    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
18152   '    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
18153   '  end;',
18154   '  TMyArr = class(TJSArray)',
18155   '    procedure DoIt;',
18156   '  end;',
18157   'procedure tmyarr.DoIt;',
18158   'begin',
18159   '  Items[1]:=Items[2];',
18160   '  SetItems(3,getItems(4));',
18161   'end;',
18162   'var',
18163   '  Arr: tmyarr;',
18164   '  s: string;',
18165   '  i: longint;',
18166   '  v: jsvalue;',
18167   'begin',
18168   '  v:=arr[0];',
18169   '  v:=arr.items[1];',
18170   '  arr[2]:=s;',
18171   '  arr.items[3]:=s;',
18172   '  arr[4]:=i;',
18173   '  arr[5]:=arr[6];',
18174   '  arr.items[7]:=arr.items[8];',
18175   '  with arr do items[9]:=items[10];',
18176   '  with arr do begin',
18177   '    v:=GetItems(14);',
18178   '    setitems(15,16);',
18179   '  end;',
18180   '']);
18181   ConvertProgram;
18182   CheckSource('TestExternalClass_BracketAccessor_Call',
18183     LinesToStr([ // statements
18184     'rtl.createClassExt($mod, "TMyArr", Array2, "", function () {',
18185     '  this.$init = function () {',
18186     '  };',
18187     '  this.$final = function () {',
18188     '  };',
18189     '  this.DoIt = function () {',
18190     '    this[1] = this[2];',
18191     '    this[3] = this[4];',
18192     '  };',
18193     '});',
18194     'this.Arr = null;',
18195     'this.s = "";',
18196     'this.i = 0;',
18197     'this.v = undefined;',
18198     '']),
18199     LinesToStr([ // $mod.$main
18200     '$mod.v = $mod.Arr[0];',
18201     '$mod.v = $mod.Arr[1];',
18202     '$mod.Arr[2] = $mod.s;',
18203     '$mod.Arr[3] = $mod.s;',
18204     '$mod.Arr[4] = $mod.i;',
18205     '$mod.Arr[5] = $mod.Arr[6];',
18206     '$mod.Arr[7] = $mod.Arr[8];',
18207     'var $with = $mod.Arr;',
18208     '$with[9] = $with[10];',
18209     'var $with1 = $mod.Arr;',
18210     '$mod.v = $with1[14];',
18211     '$with1[15] = 16;',
18212     '']));
18213 end;
18214 
18215 procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
18216 begin
18217   StartProgram(false);
18218   Add('{$modeswitch externalclass}');
18219   Add('type');
18220   Add('  TJSArray = class external name ''Array2''');
18221   Add('    function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
18222   Add('    procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
18223   Add('    property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
18224   Add('  end;');
18225   Add('begin');
18226   SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
18227     nBracketAccessorOfExternalClassMustHaveOneParameter);
18228   ConvertProgram;
18229 end;
18230 
18231 procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
18232 begin
18233   StartProgram(false);
18234   Add('{$modeswitch externalclass}');
18235   Add('type');
18236   Add('  TJSArray = class external name ''Array2''');
18237   Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
18238   Add('    property Items[Index: longint]: jsvalue read GetItems; default;');
18239   Add('  end;');
18240   Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
18241   Add('begin end;');
18242   Add('var');
18243   Add('  Arr: tjsarray;');
18244   Add('  v: jsvalue;');
18245   Add('begin');
18246   Add('  v:=arr[0];');
18247   Add('  v:=arr.items[1];');
18248   Add('  with arr do v:=items[2];');
18249   Add('  doit(arr[3],arr[4]);');
18250   ConvertProgram;
18251   CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
18252     LinesToStr([ // statements
18253     'this.DoIt = function (vI, vJ) {',
18254     '};',
18255     'this.Arr = null;',
18256     'this.v = undefined;',
18257     '']),
18258     LinesToStr([ // $mod.$main
18259     '$mod.v = $mod.Arr[0];',
18260     '$mod.v = $mod.Arr[1];',
18261     'var $with = $mod.Arr;',
18262     '$mod.v = $with[2];',
18263     '$mod.DoIt($mod.Arr[3], $mod.Arr[4]);',
18264     '']));
18265 end;
18266 
18267 procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
18268 begin
18269   StartProgram(false);
18270   Add('{$modeswitch externalclass}');
18271   Add('type');
18272   Add('  TJSArray = class external name ''Array2''');
18273   Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
18274   Add('    property Items[Index: longint]: jsvalue write SetItems; default;');
18275   Add('  end;');
18276   Add('var');
18277   Add('  Arr: tjsarray;');
18278   Add('  s: string;');
18279   Add('  i: longint;');
18280   Add('  v: jsvalue;');
18281   Add('begin');
18282   Add('  arr[2]:=s;');
18283   Add('  arr.items[3]:=s;');
18284   Add('  arr[4]:=i;');
18285   Add('  with arr do items[5]:=i;');
18286   ConvertProgram;
18287   CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
18288     LinesToStr([ // statements
18289     'this.Arr = null;',
18290     'this.s = "";',
18291     'this.i = 0;',
18292     'this.v = undefined;',
18293     '']),
18294     LinesToStr([ // $mod.$main
18295     '$mod.Arr[2] = $mod.s;',
18296     '$mod.Arr[3] = $mod.s;',
18297     '$mod.Arr[4] = $mod.i;',
18298     'var $with = $mod.Arr;',
18299     '$with[5] = $mod.i;',
18300     '']));
18301 end;
18302 
18303 procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
18304 begin
18305   StartProgram(false);
18306   Add('{$modeswitch externalclass}');
18307   Add('type');
18308   Add('  TJSArray = class external name ''Array2''');
18309   Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
18310   Add('    property Items[Index: longint]: jsvalue write SetItems; default;');
18311   Add('    procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
18312   Add('    property Numbers[Index: longint]: longint write SetNumbers;');
18313   Add('  end;');
18314   Add('var');
18315   Add('  Arr: tjsarray;');
18316   Add('  s: string;');
18317   Add('  i: longint;');
18318   Add('  v: jsvalue;');
18319   Add('begin');
18320   Add('  arr[2]:=s;');
18321   Add('  arr.items[3]:=s;');
18322   Add('  arr.numbers[4]:=i;');
18323   Add('  with arr do items[5]:=i;');
18324   Add('  with arr do numbers[6]:=i;');
18325   ConvertProgram;
18326   CheckSource('TestExternalClass_BracketAccessor_MultiType',
18327     LinesToStr([ // statements
18328     'this.Arr = null;',
18329     'this.s = "";',
18330     'this.i = 0;',
18331     'this.v = undefined;',
18332     '']),
18333     LinesToStr([ // $mod.$main
18334     '$mod.Arr[2] = $mod.s;',
18335     '$mod.Arr[3] = $mod.s;',
18336     '$mod.Arr[4] = $mod.i;',
18337     'var $with = $mod.Arr;',
18338     '$with[5] = $mod.i;',
18339     'var $with1 = $mod.Arr;',
18340     '$with1[6] = $mod.i;',
18341     '']));
18342 end;
18343 
18344 procedure TTestModule.TestExternalClass_BracketAccessor_Index;
18345 begin
18346   StartProgram(false);
18347   Add('{$modeswitch externalclass}');
18348   Add('type');
18349   Add('  TJSArray = class external name ''Array2''');
18350   Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
18351   Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
18352   Add('    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
18353   Add('  end;');
18354   Add('var');
18355   Add('  Arr: tjsarray;');
18356   Add('  i: longint;');
18357   Add('  IntArr: array of longint;');
18358   Add('  v: jsvalue;');
18359   Add('begin');
18360   Add('  v:=arr.items[i];');
18361   Add('  arr[longint(v)]:=arr.items[intarr[0]];');
18362   Add('  arr.items[intarr[1]]:=arr[IntArr[2]];');
18363   ConvertProgram;
18364   CheckSource('TestExternalClass_BracketAccessor_Index',
18365     LinesToStr([ // statements
18366     'this.Arr = null;',
18367     'this.i = 0;',
18368     'this.IntArr = [];',
18369     'this.v = undefined;',
18370     '']),
18371     LinesToStr([ // $mod.$main
18372     '$mod.v = $mod.Arr[$mod.i];',
18373     '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
18374     '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
18375     '']));
18376 end;
18377 
18378 procedure TTestModule.TestExternalClass_ForInJSObject;
18379 begin
18380   StartProgram(false);
18381   Add([
18382   '{$modeswitch externalclass}',
18383   'type',
18384   '  TJSObject = class external name ''Object''',
18385   '  end;',
18386   'var',
18387   '  o: TJSObject;',
18388   '  key: string;',
18389   'begin',
18390   '  for key in o do',
18391   '    if key=''abc'' then ;',
18392   '']);
18393   ConvertProgram;
18394   CheckSource('TestExternalClass_ForInJSObject',
18395     LinesToStr([ // statements
18396     'this.o = null;',
18397     'this.key = "";',
18398     '']),
18399     LinesToStr([ // $mod.$main
18400     'for ($mod.key in $mod.o) if ($mod.key === "abc") ;',
18401     '']));
18402 end;
18403 
18404 procedure TTestModule.TestExternalClass_ForInJSArray;
18405 begin
18406   StartProgram(false);
18407   Add([
18408   '{$modeswitch externalclass}',
18409   'type',
18410   '  TJSInt8Array = class external name ''Int8Array''',
18411   '  private',
18412   '    flength: NativeInt external name ''length'';',
18413   '    function getValue(Index: NativeInt): shortint; external name ''[]'';',
18414   '  public',
18415   '    property values[Index: NativeInt]: Shortint Read getValue; default;',
18416   '    property Length: NativeInt read flength;',
18417   '  end;',
18418   'var',
18419   '  a: TJSInt8Array;',
18420   '  value: shortint;',
18421   'begin',
18422   '  for value in a do',
18423   '    if value=3 then ;',
18424   '']);
18425   ConvertProgram;
18426   CheckSource('TestExternalClass_ForInJSArray',
18427     LinesToStr([ // statements
18428     'this.a = null;',
18429     'this.value = 0;',
18430     '']),
18431     LinesToStr([ // $mod.$main
18432     'for (var $in = $mod.a, $l = 0, $end = rtl.length($in) - 1; $l <= $end; $l++) {',
18433     '  $mod.value = $in[$l];',
18434     '  if ($mod.value === 3) ;',
18435     '};',
18436     '']));
18437 end;
18438 
18439 procedure TTestModule.TestExternalClass_IncompatibleArgDuplicateIdentifier;
18440 begin
18441   AddModuleWithIntfImplSrc('unit2.pas',
18442     LinesToStr([
18443     '{$modeswitch externalclass}',
18444     'type',
18445     '  TJSBufferSource = class external name ''BufferSource''',
18446     '  end;',
18447     'procedure DoIt(s: TJSBufferSource); external name ''DoIt'';',
18448     '']),
18449     '');
18450   AddModuleWithIntfImplSrc('unit3.pas',
18451     LinesToStr([
18452     '{$modeswitch externalclass}',
18453     'type',
18454     '  TJSBufferSource = class external name ''BufferSource''',
18455     '  end;',
18456     '']),
18457     '');
18458 
18459   StartUnit(true);
18460   Add([
18461   'interface',
18462   'uses unit2, unit3;',
18463   'procedure DoSome(s: TJSBufferSource);',
18464   'implementation',
18465   'procedure DoSome(s: TJSBufferSource);',
18466   'begin',
18467   '  DoIt(s);',
18468   'end;',
18469   '']);
18470   SetExpectedPasResolverError('Incompatible type arg no. 1: Got "unit3.TJSBufferSource", expected "unit2.TJSBufferSource"',
18471     nIncompatibleTypeArgNo);
18472   ConvertUnit;
18473 end;
18474 
18475 procedure TTestModule.TestClassInterface_Corba;
18476 begin
18477   StartProgram(false);
18478   Add([
18479   '{$interfaces corba}',
18480   'type',
18481   '  IUnknown = interface;',
18482   '  IUnknown = interface',
18483   '    [''{00000000-0000-0000-C000-000000000046}'']',
18484   '  end;',
18485   '  IInterface = IUnknown;',
18486   '  IBird = interface(IInterface)',
18487   '    function GetSize: longint;',
18488   '    procedure SetSize(i: longint);',
18489   '    property Size: longint read GetSize write SetSize;',
18490   '    procedure DoIt(i: longint);',
18491   '  end;',
18492   '  TObject = class',
18493   '  end;',
18494   '  TBird = class(TObject,IBird)',
18495   '    function GetSize: longint; virtual; abstract;',
18496   '    procedure SetSize(i: longint); virtual; abstract;',
18497   '    procedure DoIt(i: longint); virtual; abstract;',
18498   '  end;',
18499   'var',
18500   '  BirdIntf: IBird;',
18501   'begin',
18502   '  BirdIntf.Size:=BirdIntf.Size;',
18503   '']);
18504   ConvertProgram;
18505   CheckSource('TestClassInterface_Corba',
18506     LinesToStr([ // statements
18507     'rtl.createInterface($mod, "IUnknown", "{00000000-0000-0000-C000-000000000046}", [], null);',
18508     'rtl.createInterface($mod, "IBird", "{5BD1A53B-69BB-37EE-AF32-BEFB86D85B03}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
18509     'rtl.createClass($mod, "TObject", null, function () {',
18510     '  this.$init = function () {',
18511     '  };',
18512     '  this.$final = function () {',
18513     '  };',
18514     '});',
18515     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18516     '  rtl.addIntf(this, $mod.IBird);',
18517     '});',
18518     'this.BirdIntf = null;',
18519     '']),
18520     LinesToStr([ // $mod.$main
18521     '  $mod.BirdIntf.SetSize($mod.BirdIntf.GetSize());',
18522     '']));
18523 end;
18524 
18525 procedure TTestModule.TestClassInterface_ProcExternalFail;
18526 begin
18527   StartProgram(false);
18528   Add([
18529   '{$interfaces corba}',
18530   'type',
18531   '  IUnknown = interface',
18532   '    procedure DoIt; external name ''foo'';',
18533   '  end;',
18534   'begin']);
18535   SetExpectedParserError(
18536     'Fields are not allowed in interface at token "Identifier external" in file test1.pp at line 6 column 21',
18537     nParserNoFieldsAllowed);
18538   ConvertProgram;
18539 end;
18540 
18541 procedure TTestModule.TestClassInterface_Overloads;
18542 begin
18543   StartProgram(false);
18544   Add([
18545   '{$interfaces corba}',
18546   'type',
18547   '  integer = longint;',
18548   '  IUnknown = interface',
18549   '    procedure DoIt(i: integer);',
18550   '    procedure DoIt(s: string);',
18551   '  end;',
18552   '  IBird = interface(IUnknown)',
18553   '    procedure DoIt(b: boolean); overload;',
18554   '  end;',
18555   '  TObject = class',
18556   '  end;',
18557   '  TBird = class(TObject,IBird)',
18558   '    procedure DoIt(o: TObject);',
18559   '    procedure DoIt(s: string);',
18560   '    procedure DoIt(i: integer);',
18561   '    procedure DoIt(b: boolean);',
18562   '  end;',
18563   'procedure TBird.DoIt(o: TObject); begin end;',
18564   'procedure TBird.DoIt(s: string); begin end;',
18565   'procedure TBird.DoIt(i: integer); begin end;',
18566   'procedure TBird.DoIt(b: boolean); begin end;',
18567   'var',
18568   '  BirdIntf: IBird;',
18569   'begin',
18570   '  BirdIntf.DoIt(3);',
18571   '  BirdIntf.DoIt(''abc'');',
18572   '  BirdIntf.DoIt(true);',
18573   '']);
18574   ConvertProgram;
18575   CheckSource('TestClassInterface_Overloads',
18576     LinesToStr([ // statements
18577     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDC4-8A2AE2C59400}", ["DoIt", "DoIt$1"], null);',
18578     'rtl.createInterface($mod, "IBird", "{8285DD5E-EA3E-396E-AE88-000B86AABF05}", ["DoIt$2"], $mod.IUnknown);',
18579     'rtl.createClass($mod, "TObject", null, function () {',
18580     '  this.$init = function () {',
18581     '  };',
18582     '  this.$final = function () {',
18583     '  };',
18584     '});',
18585     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18586     '  this.DoIt = function (o) {',
18587     '  };',
18588     '  this.DoIt$1 = function (s) {',
18589     '  };',
18590     '  this.DoIt$2 = function (i) {',
18591     '  };',
18592     '  this.DoIt$3 = function (b) {',
18593     '  };',
18594     '  rtl.addIntf(this, $mod.IBird, {',
18595     '    DoIt$2: "DoIt$3",',
18596     '    DoIt: "DoIt$2"',
18597     '  });',
18598     '});',
18599     'this.BirdIntf = null;',
18600     '']),
18601     LinesToStr([ // $mod.$main
18602     '$mod.BirdIntf.DoIt(3);',
18603     '$mod.BirdIntf.DoIt$1("abc");',
18604     '$mod.BirdIntf.DoIt$2(true);',
18605     '']));
18606 end;
18607 
18608 procedure TTestModule.TestClassInterface_DuplicateGUIInIntfListFail;
18609 begin
18610   StartProgram(false);
18611   Add([
18612   '{$interfaces corba}',
18613   'type',
18614   '  IBird = interface',
18615   '    [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
18616   '  end;',
18617   '  IDog = interface',
18618   '    [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
18619   '  end;',
18620   '  TObject = class(IBird,IDog)',
18621   '  end;',
18622   'begin']);
18623   SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IDog and IBird',
18624     nDuplicateGUIDXInYZ);
18625   ConvertProgram;
18626 end;
18627 
18628 procedure TTestModule.TestClassInterface_DuplicateGUIInAncestorFail;
18629 begin
18630   StartProgram(false);
18631   Add([
18632   '{$interfaces corba}',
18633   'type',
18634   '  IAnimal = interface',
18635   '    [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
18636   '  end;',
18637   '  IBird = interface(IAnimal)',
18638   '  end;',
18639   '  IHawk = interface(IBird)',
18640   '    [''{4B3BA825-E0EC-4799-A19C-55F714A07959}'']',
18641   '  end;',
18642   'begin']);
18643   SetExpectedPasResolverError('Duplicate GUID {4B3BA825-E0EC-4799-A19C-55F714A07959} in IHawk and IAnimal',
18644     nDuplicateGUIDXInYZ);
18645   ConvertProgram;
18646 end;
18647 
18648 procedure TTestModule.TestClassInterface_AncestorImpl;
18649 begin
18650   StartProgram(false);
18651   Add([
18652   '{$interfaces corba}',
18653   'type',
18654   '  integer = longint;',
18655   '  IUnknown = interface',
18656   '    procedure DoIt(i: integer);',
18657   '  end;',
18658   '  IBird = interface',
18659   '    procedure Fly(i: integer);',
18660   '  end;',
18661   '  TObject = class(IUnknown)',
18662   '    procedure DoIt(i: integer);',
18663   '  end;',
18664   '  TBird = class(IBird)',
18665   '    procedure Fly(i: integer);',
18666   '  end;',
18667   'procedure TObject.DoIt(i: integer); begin end;',
18668   'procedure TBird.Fly(i: integer); begin end;',
18669   'begin',
18670   '']);
18671   ConvertProgram;
18672   CheckSource('TestClassInterface_AncestorIntf',
18673     LinesToStr([ // statements
18674     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDC4-8A2800000000}", ["DoIt"], null);',
18675     'rtl.createInterface($mod, "IBird", "{B92D5841-6264-3AE3-BF20-000000000000}", ["Fly"], null);',
18676     'rtl.createClass($mod, "TObject", null, function () {',
18677     '  this.$init = function () {',
18678     '  };',
18679     '  this.$final = function () {',
18680     '  };',
18681     '  this.DoIt = function (i) {',
18682     '  };',
18683     '  rtl.addIntf(this, $mod.IUnknown);',
18684     '});',
18685     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18686     '  this.Fly = function (i) {',
18687     '  };',
18688     '  rtl.addIntf(this, $mod.IBird);',
18689     '  rtl.addIntf(this, $mod.IUnknown);',
18690     '});',
18691     '']),
18692     LinesToStr([ // $mod.$main
18693     '']));
18694 end;
18695 
18696 procedure TTestModule.TestClassInterface_ImplReintroduce;
18697 begin
18698   StartProgram(false);
18699   Add([
18700   '{$interfaces corba}',
18701   'type',
18702   '  integer = longint;',
18703   '  IBird = interface',
18704   '    procedure DoIt(i: integer);',
18705   '  end;',
18706   '  TObject = class',
18707   '    procedure DoIt(i: integer);',
18708   '  end;',
18709   '  TBird = class(IBird)',
18710   '    procedure DoIt(i: integer); virtual; reintroduce;',
18711   '  end;',
18712   'procedure TObject.DoIt(i: integer); begin end;',
18713   'procedure TBird.DoIt(i: integer); begin end;',
18714   'begin',
18715   '']);
18716   ConvertProgram;
18717   CheckSource('TestClassInterface_ImplReintroduce',
18718     LinesToStr([ // statements
18719     'rtl.createInterface($mod, "IBird", "{B92D5841-6264-3AE2-8594-000000000000}", ["DoIt"], null);',
18720     'rtl.createClass($mod, "TObject", null, function () {',
18721     '  this.$init = function () {',
18722     '  };',
18723     '  this.$final = function () {',
18724     '  };',
18725     '  this.DoIt = function (i) {',
18726     '  };',
18727     '});',
18728     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18729     '  this.DoIt$1 = function (i) {',
18730     '  };',
18731     '  rtl.addIntf(this, $mod.IBird, {',
18732     '    DoIt: "DoIt$1"',
18733     '  });',
18734     '});',
18735     '']),
18736     LinesToStr([ // $mod.$main
18737     '']));
18738 end;
18739 
18740 procedure TTestModule.TestClassInterface_MethodResolution;
18741 begin
18742   StartProgram(false);
18743   Add([
18744   '{$interfaces corba}',
18745   'type',
18746   '  IUnknown = interface',
18747   '    procedure Walk(i: longint);',
18748   '  end;',
18749   '  IBird = interface(IUnknown)',
18750   '    procedure Walk(b: boolean); overload;',
18751   '    procedure Fly(s: string);',
18752   '  end;',
18753   '  TObject = class',
18754   '  end;',
18755   '  TBird = class(TObject,IBird)',
18756   '    procedure IBird.Fly = Move;',
18757   '    procedure IBird.Walk = Hop;',
18758   '    procedure Hop(i: longint);',
18759   '    procedure Move(s: string);',
18760   '    procedure Hop(b: boolean);',
18761   '  end;',
18762   'procedure TBird.Move(s: string); begin end;',
18763   'procedure TBird.Hop(i: longint); begin end;',
18764   'procedure TBird.Hop(b: boolean); begin end;',
18765   'var',
18766   '  BirdIntf: IBird;',
18767   'begin',
18768   '  BirdIntf.Walk(3);',
18769   '  BirdIntf.Walk(true);',
18770   '  BirdIntf.Fly(''abc'');',
18771   '']);
18772   ConvertProgram;
18773   CheckSource('TestClassInterface_MethodResolution',
18774     LinesToStr([ // statements
18775     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-BDD7-23D600000000}", ["Walk"], null);',
18776     'rtl.createInterface($mod, "IBird", "{CF8A4986-80F6-396E-AE88-000B86AAE208}", ["Walk$1", "Fly"], $mod.IUnknown);',
18777     'rtl.createClass($mod, "TObject", null, function () {',
18778     '  this.$init = function () {',
18779     '  };',
18780     '  this.$final = function () {',
18781     '  };',
18782     '});',
18783     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18784     '  this.Hop = function (i) {',
18785     '  };',
18786     '  this.Move = function (s) {',
18787     '  };',
18788     '  this.Hop$1 = function (b) {',
18789     '  };',
18790     '  rtl.addIntf(this, $mod.IBird, {',
18791     '    Walk$1: "Hop$1",',
18792     '    Fly: "Move",',
18793     '    Walk: "Hop"',
18794     '  });',
18795     '});',
18796     'this.BirdIntf = null;',
18797     '']),
18798     LinesToStr([ // $mod.$main
18799     '$mod.BirdIntf.Walk(3);',
18800     '$mod.BirdIntf.Walk$1(true);',
18801     '$mod.BirdIntf.Fly("abc");',
18802     '']));
18803 end;
18804 
18805 procedure TTestModule.TestClassInterface_AncestorMoreInterfaces;
18806 begin
18807   StartProgram(false);
18808   Add([
18809   '{$interfaces com}',
18810   'type',
18811   '  IUnknown = interface',
18812   '    function _AddRef: longint;',
18813   '    procedure Walk;',
18814   '  end;',
18815   '  IBird = interface end;',
18816   '  IDog = interface end;',
18817   '  TObject = class(IBird,IDog)',
18818   '    function _AddRef: longint; virtual; abstract;',
18819   '    procedure Walk; virtual; abstract;',
18820   '  end;',
18821   '  TBird = class(IUnknown)',
18822   '  end;',
18823   'begin',
18824   '']);
18825   ConvertProgram;
18826   CheckSource('TestClassInterface_COM_AncestorLess',
18827     LinesToStr([ // statements
18828     'rtl.createInterface($mod, "IUnknown", "{8F2D5841-758A-322B-BDDF-21CD521DD723}", ["_AddRef", "Walk"], null);',
18829     'rtl.createInterface($mod, "IBird", "{CCE11D4C-6504-3AEE-AE88-000B86AAE675}", [], $mod.IUnknown);',
18830     'rtl.createInterface($mod, "IDog", "{CCE11D4C-6504-3AEE-AE88-000B8E5FC675}", [], $mod.IUnknown);',
18831     'rtl.createClass($mod, "TObject", null, function () {',
18832     '  this.$init = function () {',
18833     '  };',
18834     '  this.$final = function () {',
18835     '  };',
18836     '  rtl.addIntf(this, $mod.IBird);',
18837     '  rtl.addIntf(this, $mod.IDog);',
18838     '});',
18839     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18840     '  rtl.addIntf(this, $mod.IUnknown);',
18841     '  rtl.addIntf(this, $mod.IBird);',
18842     '  rtl.addIntf(this, $mod.IDog);',
18843     '});',
18844     '']),
18845     LinesToStr([ // $mod.$main
18846     '']));
18847 end;
18848 
18849 procedure TTestModule.TestClassInterface_MethodOverride;
18850 begin
18851   StartProgram(false);
18852   Add([
18853   '{$interfaces corba}',
18854   'type',
18855   '  IUnknown = interface',
18856   '    [''{D6D98E5B-8A10-4FEC-856A-7BFC847FE74B}'']',
18857   '    procedure Go;',
18858   '  end;',
18859   '  TObject = class(IUnknown)',
18860   '    procedure Go; virtual; abstract;',
18861   '  end;',
18862   '  TBird = class',
18863   '    procedure Go; override;',
18864   '  end;',
18865   '  TCat = class(TObject)',
18866   '    procedure Go; override;',
18867   '  end;',
18868   '  TDog = class(TObject, IUnknown)',
18869   '    procedure Go; override;',
18870   '  end;',
18871   'procedure TBird.Go; begin end;',
18872   'procedure TCat.Go; begin end;',
18873   'procedure TDog.Go; begin end;',
18874   'begin',
18875   '']);
18876   ConvertProgram;
18877   CheckSource('TestClassInterface_MethodOverride',
18878     LinesToStr([ // statements
18879     'rtl.createInterface($mod, "IUnknown", "{D6D98E5B-8A10-4FEC-856A-7BFC847FE74B}", ["Go"], null);',
18880     'rtl.createClass($mod, "TObject", null, function () {',
18881     '  this.$init = function () {',
18882     '  };',
18883     '  this.$final = function () {',
18884     '  };',
18885     '  rtl.addIntf(this, $mod.IUnknown);',
18886     '});',
18887     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18888     '  this.Go = function () {',
18889     '  };',
18890     '  rtl.addIntf(this, $mod.IUnknown);',
18891     '});',
18892     'rtl.createClass($mod, "TCat", $mod.TObject, function () {',
18893     '  this.Go = function () {',
18894     '  };',
18895     '  rtl.addIntf(this, $mod.IUnknown);',
18896     '});',
18897     'rtl.createClass($mod, "TDog", $mod.TObject, function () {',
18898     '  this.Go = function () {',
18899     '  };',
18900     '  rtl.addIntf(this, $mod.IUnknown);',
18901     '});',
18902     '']),
18903     LinesToStr([ // $mod.$main
18904     '']));
18905 end;
18906 
18907 procedure TTestModule.TestClassInterface_Corba_Delegation;
18908 begin
18909   StartProgram(false);
18910   Add([
18911   '{$interfaces corba}',
18912   'type',
18913   '  IUnknown = interface',
18914   '  end;',
18915   '  IBird = interface(IUnknown)',
18916   '    procedure Fly(s: string);',
18917   '  end;',
18918   '  IEagle = interface(IBird)',
18919   '  end;',
18920   '  IDove = interface(IBird)',
18921   '  end;',
18922   '  ISwallow = interface(IBird)',
18923   '  end;',
18924   '  TObject = class',
18925   '  end;',
18926   '  TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
18927   '    procedure Fly(s: string); virtual; abstract;',
18928   '  end;',
18929   '  TBat = class(IBird,IEagle,IDove,ISwallow)',
18930   '    FBirdIntf: IBird;',
18931   '    property BirdIntf: IBird read FBirdIntf implements IBird;',
18932   '    function GetEagleIntf: IEagle; virtual; abstract;',
18933   '    property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
18934   '    FDoveObj: TBird;',
18935   '    property DoveObj: TBird read FDoveObj implements IDove;',
18936   '    function GetSwallowObj: TBird; virtual; abstract;',
18937   '    property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
18938   '  end;',
18939   'begin',
18940   '']);
18941   ConvertProgram;
18942   CheckSource('TestClassInterface_Delegation',
18943     LinesToStr([ // statements
18944     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
18945     'rtl.createInterface($mod, "IBird", "{478D080B-C0F6-396E-AE88-000B87785B07}", ["Fly"], $mod.IUnknown);',
18946     'rtl.createInterface($mod, "IEagle", "{489289DE-FDE2-34A6-8288-39119022B1B4}", [], $mod.IBird);',
18947     'rtl.createInterface($mod, "IDove", "{489289DE-FDE2-34A6-8288-39118EF16074}", [], $mod.IBird);',
18948     'rtl.createInterface($mod, "ISwallow", "{B89289DE-FDE2-34A6-8288-3911CBDCB359}", [], $mod.IBird);',
18949     'rtl.createClass($mod, "TObject", null, function () {',
18950     '  this.$init = function () {',
18951     '  };',
18952     '  this.$final = function () {',
18953     '  };',
18954     '});',
18955     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
18956     '  rtl.addIntf(this, $mod.IBird);',
18957     '  rtl.addIntf(this, $mod.IEagle);',
18958     '  rtl.addIntf(this, $mod.IDove);',
18959     '  rtl.addIntf(this, $mod.ISwallow);',
18960     '});',
18961     'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
18962     '  this.$init = function () {',
18963     '    $mod.TObject.$init.call(this);',
18964     '    this.FBirdIntf = null;',
18965     '    this.FDoveObj = null;',
18966     '  };',
18967     '  this.$final = function () {',
18968     '    this.FBirdIntf = undefined;',
18969     '    this.FDoveObj = undefined;',
18970     '    $mod.TObject.$final.call(this);',
18971     '  };',
18972     '  this.$intfmaps = {',
18973     '    "{478D080B-C0F6-396E-AE88-000B87785B07}": function () {',
18974     '        return this.FBirdIntf;',
18975     '      },',
18976     '    "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
18977     '        return this.GetEagleIntf();',
18978     '      },',
18979     '    "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
18980     '        return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
18981     '      },',
18982     '    "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
18983     '        return rtl.getIntfT(this.GetSwallowObj(), $mod.ISwallow);',
18984     '      }',
18985     '  };',
18986     '});',
18987     '']),
18988     LinesToStr([ // $mod.$main
18989     '']));
18990 end;
18991 
18992 procedure TTestModule.TestClassInterface_Corba_DelegationStatic;
18993 begin
18994   StartProgram(false);
18995   Add([
18996   '{$interfaces corba}',
18997   'type',
18998   '  IUnknown = interface',
18999   '  end;',
19000   '  IBird = interface(IUnknown)',
19001   '    procedure Fly(s: string);',
19002   '  end;',
19003   '  IEagle = interface(IBird)',
19004   '  end;',
19005   '  IDove = interface(IBird)',
19006   '  end;',
19007   '  ISwallow = interface(IBird)',
19008   '  end;',
19009   '  TObject = class',
19010   '  end;',
19011   '  TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
19012   '    procedure Fly(s: string); virtual; abstract;',
19013   '  end;',
19014   '  TBat = class(IBird,IEagle,IDove,ISwallow)',
19015   '  private',
19016   '    class var FBirdIntf: IBird;',
19017   '    class var FDoveObj: TBird;',
19018   '    class function GetEagleIntf: IEagle; virtual; abstract;',
19019   '    class function GetSwallowObj: TBird; virtual; abstract;',
19020   '  protected',
19021   '    class property BirdIntf: IBird read FBirdIntf implements IBird;',
19022   '    class property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
19023   '    class property DoveObj: TBird read FDoveObj implements IDove;',
19024   '    class property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
19025   '  end;',
19026   'begin',
19027   '']);
19028   ConvertProgram;
19029   CheckSource('TestClassInterface_DelegationStatic',
19030     LinesToStr([ // statements
19031     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
19032     'rtl.createInterface($mod, "IBird", "{478D080B-C0F6-396E-AE88-000B87785B07}", ["Fly"], $mod.IUnknown);',
19033     'rtl.createInterface($mod, "IEagle", "{489289DE-FDE2-34A6-8288-39119022B1B4}", [], $mod.IBird);',
19034     'rtl.createInterface($mod, "IDove", "{489289DE-FDE2-34A6-8288-39118EF16074}", [], $mod.IBird);',
19035     'rtl.createInterface($mod, "ISwallow", "{B89289DE-FDE2-34A6-8288-3911CBDCB359}", [], $mod.IBird);',
19036     'rtl.createClass($mod, "TObject", null, function () {',
19037     '  this.$init = function () {',
19038     '  };',
19039     '  this.$final = function () {',
19040     '  };',
19041     '});',
19042     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
19043     '  rtl.addIntf(this, $mod.IBird);',
19044     '  rtl.addIntf(this, $mod.IEagle);',
19045     '  rtl.addIntf(this, $mod.IDove);',
19046     '  rtl.addIntf(this, $mod.ISwallow);',
19047     '});',
19048     'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
19049     '  this.FBirdIntf = null;',
19050     '  this.FDoveObj = null;',
19051     '  this.$intfmaps = {',
19052     '    "{478D080B-C0F6-396E-AE88-000B87785B07}": function () {',
19053     '        return this.FBirdIntf;',
19054     '      },',
19055     '    "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
19056     '        return this.GetEagleIntf();',
19057     '      },',
19058     '    "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
19059     '        return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
19060     '      },',
19061     '    "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
19062     '        return rtl.getIntfT(this.GetSwallowObj(), $mod.ISwallow);',
19063     '      }',
19064     '  };',
19065     '});',
19066     '']),
19067     LinesToStr([ // $mod.$main
19068     '']));
19069 end;
19070 
19071 procedure TTestModule.TestClassInterface_Corba_Operators;
19072 begin
19073   StartProgram(false);
19074   Add([
19075   '{$interfaces corba}',
19076   'type',
19077   '  IUnknown = interface',
19078   '  end;',
19079   '  IBird = interface(IUnknown)',
19080   '    function GetItems(Index: longint): longint;',
19081   '    procedure SetItems(Index: longint; Value: longint);',
19082   '    property Items[Index: longint]: longint read GetItems write SetItems; default;',
19083   '  end;',
19084   '  TObject = class',
19085   '  end;',
19086   '  TBird = class(TObject,IBird)',
19087   '    function GetItems(Index: longint): longint; virtual; abstract;',
19088   '    procedure SetItems(Index: longint; Value: longint); virtual; abstract;',
19089   '  end;',
19090   'var',
19091   '  IntfVar: IBird = nil;',
19092   '  IntfVar2: IBird;',
19093   '  ObjVar: TBird;',
19094   '  v: JSValue;',
19095   'begin',
19096   '  IntfVar:=nil;',
19097   '  IntfVar[3]:=IntfVar[4];',
19098   '  if Assigned(IntfVar) then ;',
19099   '  IntfVar:=IntfVar2;',
19100   '  IntfVar:=ObjVar;',
19101   '  if IntfVar=IntfVar2 then ;',
19102   '  if IntfVar<>IntfVar2 then ;',
19103   '  if IntfVar is IBird then ;',
19104   '  if IntfVar is TBird then ;',
19105   '  if ObjVar is IBird then ;',
19106   '  IntfVar:=IntfVar2 as IBird;',
19107   '  ObjVar:=IntfVar2 as TBird;',
19108   '  IntfVar:=ObjVar as IBird;',
19109   '  IntfVar:=IBird(IntfVar2);',
19110   '  ObjVar:=TBird(IntfVar);',
19111   '  IntfVar:=IBird(ObjVar);',
19112   '  v:=IntfVar;',
19113   '  IntfVar:=IBird(v);',
19114   '  if v is IBird then ;',
19115   '  v:=JSValue(IntfVar);',
19116   '  v:=IBird;',
19117   '']);
19118   ConvertProgram;
19119   CheckSource('TestClassInterface_Corba_Operators',
19120     LinesToStr([ // statements
19121     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
19122     'rtl.createInterface($mod, "IBird", "{D53FED90-DE59-3202-B1AE-000B87785B08}", ["GetItems", "SetItems"], $mod.IUnknown);',
19123     'rtl.createClass($mod, "TObject", null, function () {',
19124     '  this.$init = function () {',
19125     '  };',
19126     '  this.$final = function () {',
19127     '  };',
19128     '});',
19129     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
19130     '  rtl.addIntf(this, $mod.IBird);',
19131     '});',
19132     'this.IntfVar = null;',
19133     'this.IntfVar2 = null;',
19134     'this.ObjVar = null;',
19135     'this.v = undefined;',
19136     '']),
19137     LinesToStr([ // $mod.$main
19138     '$mod.IntfVar = null;',
19139     '$mod.IntfVar.SetItems(3, $mod.IntfVar.GetItems(4));',
19140     'if ($mod.IntfVar != null) ;',
19141     '$mod.IntfVar = $mod.IntfVar2;',
19142     '$mod.IntfVar = rtl.getIntfT($mod.ObjVar,$mod.IBird);',
19143     'if ($mod.IntfVar === $mod.IntfVar2) ;',
19144     'if ($mod.IntfVar !== $mod.IntfVar2) ;',
19145     'if ($mod.IBird.isPrototypeOf($mod.IntfVar)) ;',
19146     'if (rtl.intfIsClass($mod.IntfVar, $mod.TBird)) ;',
19147     'if (rtl.getIntfT($mod.ObjVar, $mod.IBird) !== null) ;',
19148     '$mod.IntfVar = rtl.as($mod.IntfVar2, $mod.IBird);',
19149     '$mod.ObjVar = rtl.intfAsClass($mod.IntfVar2, $mod.TBird);',
19150     '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
19151     '$mod.IntfVar = $mod.IntfVar2;',
19152     '$mod.ObjVar = rtl.intfToClass($mod.IntfVar, $mod.TBird);',
19153     '$mod.IntfVar = rtl.getIntfT($mod.ObjVar, $mod.IBird);',
19154     '$mod.v = $mod.IntfVar;',
19155     '$mod.IntfVar = rtl.getObject($mod.v);',
19156     'if (rtl.isExt($mod.v, $mod.IBird, 1)) ;',
19157     '$mod.v = $mod.IntfVar;',
19158     '$mod.v = $mod.IBird;',
19159     '']));
19160 end;
19161 
19162 procedure TTestModule.TestClassInterface_Corba_Args;
19163 begin
19164   StartProgram(false);
19165   Add([
19166   '{$interfaces corba}',
19167   'type',
19168   '  IUnknown = interface',
19169   '  end;',
19170   '  IBird = interface(IUnknown)',
19171   '  end;',
19172   '  TObject = class',
19173   '  end;',
19174   '  TBird = class(TObject,IBird)',
19175   '  end;',
19176   'procedure DoIt(var u; i: IBird; const j: IBird);',
19177   'begin',
19178   '  DoIt(i,i,i);',
19179   'end;',
19180   'procedure Change(var i: IBird; out j: IBird);',
19181   'begin',
19182   '  DoIt(i,i,i);',
19183   '  Change(i,i);',
19184   'end;',
19185   'var',
19186   '  i: IBird;',
19187   '  o: TBird;',
19188   'begin',
19189   '  DoIt(i,i,i);',
19190   '  Change(i,i);',
19191   '  DoIt(o,o,o);',
19192   '']);
19193   ConvertProgram;
19194   CheckSource('TestClassInterface_Corba_Args',
19195     LinesToStr([ // statements
19196     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
19197     'rtl.createInterface($mod, "IBird", "{4B0D080B-C0F6-396E-AE88-000B87785074}", [], $mod.IUnknown);',
19198     'rtl.createClass($mod, "TObject", null, function () {',
19199     '  this.$init = function () {',
19200     '  };',
19201     '  this.$final = function () {',
19202     '  };',
19203     '});',
19204     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
19205     '  rtl.addIntf(this, $mod.IBird);',
19206     '});',
19207     'this.DoIt = function (u, i, j) {',
19208     '  $mod.DoIt({',
19209     '    get: function () {',
19210     '        return i;',
19211     '      },',
19212     '    set: function (v) {',
19213     '        i = v;',
19214     '      }',
19215     '  }, i, i);',
19216     '};',
19217     'this.Change = function (i, j) {',
19218     '  $mod.DoIt(i, i.get(), i.get());',
19219     '  $mod.Change(i, i);',
19220     '};',
19221     'this.i = null;',
19222     'this.o = null;',
19223     '']),
19224     LinesToStr([ // $mod.$main
19225     '$mod.DoIt({',
19226     '  p: $mod,',
19227     '  get: function () {',
19228     '      return this.p.i;',
19229     '    },',
19230     '  set: function (v) {',
19231     '      this.p.i = v;',
19232     '    }',
19233     '}, $mod.i, $mod.i);',
19234     '$mod.Change({',
19235     '  p: $mod,',
19236     '  get: function () {',
19237     '      return this.p.i;',
19238     '    },',
19239     '  set: function (v) {',
19240     '      this.p.i = v;',
19241     '    }',
19242     '}, {',
19243     '  p: $mod,',
19244     '  get: function () {',
19245     '      return this.p.i;',
19246     '    },',
19247     '  set: function (v) {',
19248     '      this.p.i = v;',
19249     '    }',
19250     '});',
19251     '$mod.DoIt({',
19252     '  p: $mod,',
19253     '  get: function () {',
19254     '      return this.p.o;',
19255     '    },',
19256     '  set: function (v) {',
19257     '      this.p.o = v;',
19258     '    }',
19259     '}, rtl.getIntfT($mod.o, $mod.IBird), rtl.getIntfT($mod.o, $mod.IBird));',
19260     '']));
19261 end;
19262 
19263 procedure TTestModule.TestClassInterface_Corba_ForIn;
19264 begin
19265   StartProgram(false);
19266   Add([
19267   '{$interfaces corba}',
19268   'type',
19269   '  IUnknown = interface end;',
19270   '  TObject = class',
19271   '    Id: longint;',
19272   '  end;',
19273   '  IEnumerator = interface(IUnknown)',
19274   '    function GetCurrent: TObject;',
19275   '    function MoveNext: Boolean;',
19276   '    property Current: TObject read GetCurrent;',
19277   '  end;',
19278   '  IEnumerable = interface(IUnknown)',
19279   '    function GetEnumerator: IEnumerator;',
19280   '  end;',
19281   'var',
19282   '  o: TObject;',
19283   '  i: IEnumerable;',
19284   'begin',
19285   '  for o in i do o.Id:=3;',
19286   '']);
19287   ConvertProgram;
19288   CheckSource('TestClassInterface_Corba_ForIn',
19289     LinesToStr([ // statements
19290     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
19291     'rtl.createClass($mod, "TObject", null, function () {',
19292     '  this.$init = function () {',
19293     '    this.Id = 0;',
19294     '  };',
19295     '  this.$final = function () {',
19296     '  };',
19297     '});',
19298     'rtl.createInterface($mod, "IEnumerator", "{95D7745D-ED61-3F13-BBE4-07708161999E}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
19299     'rtl.createInterface($mod, "IEnumerable", "{8CC9D45D-ED7D-3B73-96B6-290B931BB19E}", ["GetEnumerator"], $mod.IUnknown);',
19300     'this.o = null;',
19301     'this.i = null;',
19302     '']),
19303     LinesToStr([ // $mod.$main
19304     'var $in = $mod.i.GetEnumerator();',
19305     'while ($in.MoveNext()) {',
19306     '  $mod.o = $in.GetCurrent();',
19307     '  $mod.o.Id = 3;',
19308     '};',
19309     '']));
19310 end;
19311 
19312 procedure TTestModule.TestClassInterface_COM_AssignVar;
19313 begin
19314   StartProgram(false);
19315   Add([
19316   '{$interfaces com}',
19317   'type',
19318   '  IUnknown = interface',
19319   '    function _AddRef: longint;',
19320   '    function _Release: longint;',
19321   '  end;',
19322   '  TObject = class(IUnknown)',
19323   '    function _AddRef: longint; virtual; abstract;',
19324   '    function _Release: longint; virtual; abstract;',
19325   '  end;',
19326   'var',
19327   '  i: IUnknown;',
19328   'procedure DoGlobal(o: TObject);',
19329   'begin',
19330   '  i:=nil;',
19331   '  i:=o;',
19332   '  i:=i;',
19333   'end;',
19334   'procedure DoLocal(o: TObject);',
19335   'const k: IUnknown = nil;',
19336   'var j: IUnknown;',
19337   'begin',
19338   '  k:=o;',
19339   '  k:=i;',
19340   '  j:=o;',
19341   '  j:=i;',
19342   'end;',
19343   'var o: TObject;',
19344   'begin',
19345   '  i:=nil;',
19346   '  i:=o;',
19347   '']);
19348   ConvertProgram;
19349   CheckSource('TestClassInterface_COM_AssignVar',
19350     LinesToStr([ // statements
19351     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19352     'rtl.createClass($mod, "TObject", null, function () {',
19353     '  this.$init = function () {',
19354     '  };',
19355     '  this.$final = function () {',
19356     '  };',
19357     '  rtl.addIntf(this, $mod.IUnknown);',
19358     '});',
19359     'this.i = null;',
19360     'this.DoGlobal = function (o) {',
19361     '  rtl.setIntfP($mod, "i", null);',
19362     '  rtl.setIntfP($mod, "i", rtl.queryIntfT(o, $mod.IUnknown), true);',
19363     '  rtl.setIntfP($mod, "i", $mod.i);',
19364     '};',
19365     'var k = null;',
19366     'this.DoLocal = function (o) {',
19367     '  var j = null;',
19368     '  try{',
19369     '    k = rtl.setIntfL(k, rtl.queryIntfT(o, $mod.IUnknown), true);',
19370     '    k = rtl.setIntfL(k, $mod.i);',
19371     '    j = rtl.setIntfL(j, rtl.queryIntfT(o, $mod.IUnknown), true);',
19372     '    j = rtl.setIntfL(j, $mod.i);',
19373     '  }finally{',
19374     '    rtl._Release(j);',
19375     '  };',
19376     '};',
19377     'this.o = null;',
19378     '']),
19379     LinesToStr([ // $mod.$main
19380     'rtl.setIntfP($mod, "i", null);',
19381     'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.o, $mod.IUnknown), true);',
19382     '']));
19383 end;
19384 
19385 procedure TTestModule.TestClassInterface_COM_AssignArg;
19386 begin
19387   StartProgram(false);
19388   Add([
19389   '{$interfaces com}',
19390   'type',
19391   '  IUnknown = interface',
19392   '    function _AddRef: longint;',
19393   '    function _Release: longint;',
19394   '  end;',
19395   '  TObject = class(IUnknown)',
19396   '    function _AddRef: longint; virtual; abstract;',
19397   '    function _Release: longint; virtual; abstract;',
19398   '  end;',
19399   'procedure DoDefault(i, j: IUnknown);',
19400   'begin',
19401   '  i:=nil;',
19402   '  i:=j;',
19403   'end;',
19404   'begin',
19405   '']);
19406   ConvertProgram;
19407   CheckSource('TestClassInterface_COM_AssignArg',
19408     LinesToStr([ // statements
19409     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19410     'rtl.createClass($mod, "TObject", null, function () {',
19411     '  this.$init = function () {',
19412     '  };',
19413     '  this.$final = function () {',
19414     '  };',
19415     '  rtl.addIntf(this, $mod.IUnknown);',
19416     '});',
19417     'this.DoDefault = function (i, j) {',
19418     '  rtl._AddRef(i);',
19419     '  try {',
19420     '    i = rtl.setIntfL(i, null);',
19421     '    i = rtl.setIntfL(i, j);',
19422     '  } finally {',
19423     '    rtl._Release(i);',
19424     '  };',
19425     '};',
19426     '']),
19427     LinesToStr([ // $mod.$main
19428     '']));
19429 end;
19430 
19431 procedure TTestModule.TestClassInterface_COM_FunctionResult;
19432 begin
19433   StartProgram(false);
19434   Add([
19435   '{$interfaces com}',
19436   'type',
19437   '  IUnknown = interface',
19438   '    function _AddRef: longint;',
19439   '    function _Release: longint;',
19440   '  end;',
19441   '  TObject = class(IUnknown)',
19442   '    function _AddRef: longint; virtual; abstract;',
19443   '    function _Release: longint; virtual; abstract;',
19444   '  end;',
19445   'function DoDefault(i: IUnknown): IUnknown;',
19446   'begin',
19447   '  Result:=i;',
19448   '  if Result<>nil then exit;',
19449   'end;',
19450   'begin',
19451   '']);
19452   ConvertProgram;
19453   CheckSource('TestClassInterface_COM_FunctionResult',
19454     LinesToStr([ // statements
19455     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19456     'rtl.createClass($mod, "TObject", null, function () {',
19457     '  this.$init = function () {',
19458     '  };',
19459     '  this.$final = function () {',
19460     '  };',
19461     '  rtl.addIntf(this, $mod.IUnknown);',
19462     '});',
19463     'this.DoDefault = function (i) {',
19464     '  var Result = null;',
19465     '  var $ok = false;',
19466     '  try {',
19467     '    Result = rtl.setIntfL(Result, i);',
19468     '    if(Result !== null){',
19469     '      $ok = true;',
19470     '      return Result;',
19471     '    };',
19472     '    $ok = true;',
19473     '  } finally {',
19474     '    if(!$ok) rtl._Release(Result);',
19475     '  };',
19476     '  return Result;',
19477     '};',
19478     '']),
19479     LinesToStr([ // $mod.$main
19480     '']));
19481 end;
19482 
19483 procedure TTestModule.TestClassInterface_COM_InheritedFuncResult;
19484 begin
19485   StartProgram(false);
19486   Add([
19487   '{$interfaces com}',
19488   'type',
19489   '  IUnknown = interface',
19490   '    function _AddRef: longint;',
19491   '    function _Release: longint;',
19492   '  end;',
19493   '  TObject = class(IUnknown)',
19494   '    function _AddRef: longint; virtual; abstract;',
19495   '    function _Release: longint; virtual; abstract;',
19496   '    function GetIntf: IUnknown; virtual;',
19497   '  end;',
19498   '  TMouse = class',
19499   '    function GetIntf: IUnknown; override;',
19500   '  end;',
19501   'function TObject.GetIntf: IUnknown; begin end;',
19502   'function TMouse.GetIntf: IUnknown;',
19503   'var i: IUnknown;',
19504   'begin',
19505   '  inherited;',
19506   '  inherited GetIntf;',
19507   '  inherited GetIntf();',
19508   '  Result:=inherited GetIntf;',
19509   '  Result:=inherited GetIntf();',
19510   '  i:=inherited GetIntf;',
19511   '  i:=inherited GetIntf();',
19512   'end;',
19513   'begin',
19514   '']);
19515   ConvertProgram;
19516   CheckSource('TestClassInterface_COM_InheritedFuncResult',
19517     LinesToStr([ // statements
19518     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19519     'rtl.createClass($mod, "TObject", null, function () {',
19520     '  this.$init = function () {',
19521     '  };',
19522     '  this.$final = function () {',
19523     '  };',
19524     '  this.GetIntf = function () {',
19525     '    var Result = null;',
19526     '    return Result;',
19527     '  };',
19528     '  rtl.addIntf(this, $mod.IUnknown);',
19529     '});',
19530     'rtl.createClass($mod, "TMouse", $mod.TObject, function () {',
19531     '  this.GetIntf = function () {',
19532     '    var Result = null;',
19533     '    var i = null;',
19534     '    var $ir = rtl.createIntfRefs();',
19535     '    var $ok = false;',
19536     '    try {',
19537     '      $ir.ref(1, $mod.TObject.GetIntf.call(this));',
19538     '      $ir.ref(2, $mod.TObject.GetIntf.call(this));',
19539     '      $ir.ref(3, $mod.TObject.GetIntf.call(this));',
19540     '      Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
19541     '      Result = rtl.setIntfL(Result, $mod.TObject.GetIntf.call(this), true);',
19542     '      i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
19543     '      i = rtl.setIntfL(i, $mod.TObject.GetIntf.call(this), true);',
19544     '      $ok = true;',
19545     '    } finally {',
19546     '      $ir.free();',
19547     '      rtl._Release(i);',
19548     '      if (!$ok) rtl._Release(Result);',
19549     '    };',
19550     '    return Result;',
19551     '  };',
19552     '  rtl.addIntf(this, $mod.IUnknown);',
19553     '});',
19554     '']),
19555     LinesToStr([ // $mod.$main
19556     '']));
19557 end;
19558 
19559 procedure TTestModule.TestClassInterface_COM_IsAsTypeCasts;
19560 begin
19561   StartProgram(false);
19562   Add([
19563   '{$interfaces com}',
19564   'type',
19565   '  IUnknown = interface',
19566   '    function _AddRef: longint;',
19567   '    function _Release: longint;',
19568   '  end;',
19569   '  TObject = class(IUnknown)',
19570   '    function _AddRef: longint; virtual; abstract;',
19571   '    function _Release: longint; virtual; abstract;',
19572   '  end;',
19573   'procedure DoDefault(i, j: IUnknown; o: TObject);',
19574   'begin',
19575   '  if i is IUnknown then ;',
19576   '  if o is IUnknown then ;',
19577   '  if i is TObject then ;',
19578   '  i:=j as IUnknown;',
19579   '  i:=o as IUnknown;',
19580   '  o:=j as TObject;',
19581   '  i:=IUnknown(j);',
19582   '  i:=IUnknown(o);',
19583   '  o:=TObject(i);',
19584   'end;',
19585   'begin',
19586   '']);
19587   ConvertProgram;
19588   CheckSource('TestClassInterface_COM_IsAsTypeCasts',
19589     LinesToStr([ // statements
19590     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19591     'rtl.createClass($mod, "TObject", null, function () {',
19592     '  this.$init = function () {',
19593     '  };',
19594     '  this.$final = function () {',
19595     '  };',
19596     '  rtl.addIntf(this, $mod.IUnknown);',
19597     '});',
19598     'this.DoDefault = function (i, j, o) {',
19599     '  rtl._AddRef(i);',
19600     '  try {',
19601     '    if (rtl.intfIsIntfT(i, $mod.IUnknown)) ;',
19602     '    if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
19603     '    if (rtl.intfIsClass(i, $mod.TObject)) ;',
19604     '    i = rtl.setIntfL(i, rtl.intfAsIntfT(j, $mod.IUnknown));',
19605     '    i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
19606     '    o = rtl.intfAsClass(j, $mod.TObject);',
19607     '    i = rtl.setIntfL(i, j);',
19608     '    i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
19609     '    o = rtl.intfToClass(i, $mod.TObject);',
19610     '  } finally {',
19611     '    rtl._Release(i);',
19612     '  };',
19613     '};',
19614     '']),
19615     LinesToStr([ // $mod.$main
19616     '']));
19617 end;
19618 
19619 procedure TTestModule.TestClassInterface_COM_PassAsArg;
19620 begin
19621   StartProgram(false);
19622   Add([
19623   '{$interfaces com}',
19624   'type',
19625   '  IUnknown = interface',
19626   '    function _AddRef: longint;',
19627   '    function _Release: longint;',
19628   '  end;',
19629   '  TObject = class(IUnknown)',
19630   '    function _AddRef: longint; virtual; abstract;',
19631   '    function _Release: longint; virtual; abstract;',
19632   '  end;',
19633   'procedure DoIt(v: IUnknown; const j: IUnknown; var k: IUnknown; out l: IUnknown);',
19634   'var o: TObject;',
19635   'begin',
19636   '  DoIt(v,v,v,v);',
19637   '  DoIt(o,o,k,k);',
19638   'end;',
19639   'procedure DoSome;',
19640   'var v: IUnknown;',
19641   'begin',
19642   '  DoIt(v,v,v,v);',
19643   'end;',
19644   'var i: IUnknown;',
19645   'begin',
19646   '  DoIt(i,i,i,i);',
19647   '']);
19648   ConvertProgram;
19649   CheckSource('TestClassInterface_COM_PassAsArg',
19650     LinesToStr([ // statements
19651     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19652     'rtl.createClass($mod, "TObject", null, function () {',
19653     '  this.$init = function () {',
19654     '  };',
19655     '  this.$final = function () {',
19656     '  };',
19657     '  rtl.addIntf(this, $mod.IUnknown);',
19658     '});',
19659     'this.DoIt = function (v, j, k, l) {',
19660     '  var o = null;',
19661     '  var $ir = rtl.createIntfRefs();',
19662     '  rtl._AddRef(v);',
19663     '  try {',
19664     '    $mod.DoIt(v, v, {',
19665     '      get: function () {',
19666     '          return v;',
19667     '        },',
19668     '      set: function (w) {',
19669     '          v = rtl.setIntfL(v, w);',
19670     '        }',
19671     '    }, {',
19672     '      get: function () {',
19673     '          return v;',
19674     '        },',
19675     '      set: function (w) {',
19676     '          v = rtl.setIntfL(v, w);',
19677     '        }',
19678     '    });',
19679     '    $mod.DoIt($ir.ref(1, rtl.queryIntfT(o, $mod.IUnknown)), $ir.ref(2, rtl.queryIntfT(o, $mod.IUnknown)), k, k);',
19680     '  } finally {',
19681     '    $ir.free();',
19682     '    rtl._Release(v);',
19683     '  };',
19684     '};',
19685     'this.DoSome = function () {',
19686     '  var v = null;',
19687     '  try {',
19688     '    $mod.DoIt(v, v, {',
19689     '      get: function () {',
19690     '          return v;',
19691     '        },',
19692     '      set: function (w) {',
19693     '          v = rtl.setIntfL(v, w);',
19694     '        }',
19695     '    }, {',
19696     '      get: function () {',
19697     '          return v;',
19698     '        },',
19699     '      set: function (w) {',
19700     '          v = rtl.setIntfL(v, w);',
19701     '        }',
19702     '    });',
19703     '  } finally {',
19704     '    rtl._Release(v);',
19705     '  };',
19706     '};',
19707     'this.i = null;',
19708     '']),
19709     LinesToStr([ // $mod.$main
19710     '$mod.DoIt($mod.i, $mod.i, {',
19711     '  p: $mod,',
19712     '  get: function () {',
19713     '      return this.p.i;',
19714     '    },',
19715     '  set: function (v) {',
19716     '      rtl.setIntfP(this.p, "i", v);',
19717     '    }',
19718     '}, {',
19719     '  p: $mod,',
19720     '  get: function () {',
19721     '      return this.p.i;',
19722     '    },',
19723     '  set: function (v) {',
19724     '      rtl.setIntfP(this.p, "i", v);',
19725     '    }',
19726     '});',
19727     '']));
19728 end;
19729 
19730 procedure TTestModule.TestClassInterface_COM_PassToUntypedParam;
19731 begin
19732   StartProgram(false);
19733   Add([
19734   '{$interfaces com}',
19735   'type',
19736   '  IUnknown = interface',
19737   '    function _AddRef: longint;',
19738   '    function _Release: longint;',
19739   '  end;',
19740   '  TObject = class(IUnknown)',
19741   '    function _AddRef: longint; virtual; abstract;',
19742   '    function _Release: longint; virtual; abstract;',
19743   '  end;',
19744   'procedure DoIt(out i);',
19745   'begin end;',
19746   'procedure DoSome;',
19747   'var v: IUnknown;',
19748   'begin',
19749   '  DoIt(v);',
19750   'end;',
19751   'function GetIt: IUnknown;',
19752   'begin',
19753   '  DoIt(Result);',
19754   'end;',
19755   'var i: IUnknown;',
19756   'begin',
19757   '  DoIt(i);',
19758   '']);
19759   ConvertProgram;
19760   CheckSource('TestClassInterface_COM_PassToUntypedParam',
19761     LinesToStr([ // statements
19762     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19763     'rtl.createClass($mod, "TObject", null, function () {',
19764     '  this.$init = function () {',
19765     '  };',
19766     '  this.$final = function () {',
19767     '  };',
19768     '  rtl.addIntf(this, $mod.IUnknown);',
19769     '});',
19770     'this.DoIt = function (i) {',
19771     '};',
19772     'this.DoSome = function () {',
19773     '  var v = null;',
19774     '  try {',
19775     '    $mod.DoIt({',
19776     '      get: function () {',
19777     '          return v;',
19778     '        },',
19779     '      set: function (w) {',
19780     '          v = w;',
19781     '        }',
19782     '    });',
19783     '  } finally {',
19784     '    rtl._Release(v);',
19785     '  };',
19786     '};',
19787     'this.GetIt = function () {',
19788     '  var Result = null;',
19789     '  var $ok = false;',
19790     '  try {',
19791     '    $mod.DoIt({',
19792     '      get: function () {',
19793     '          return Result;',
19794     '        },',
19795     '      set: function (v) {',
19796     '          Result = v;',
19797     '        }',
19798     '    });',
19799     '    $ok = true;',
19800     '  } finally {',
19801     '    if (!$ok) rtl._Release(Result);',
19802     '  };',
19803     '  return Result;',
19804     '};',
19805     'this.i = null;',
19806     '']),
19807     LinesToStr([ // $mod.$main
19808     'try {',
19809     '  $mod.DoIt({',
19810     '    p: $mod,',
19811     '    get: function () {',
19812     '        return this.p.i;',
19813     '      },',
19814     '    set: function (v) {',
19815     '        this.p.i = v;',
19816     '      }',
19817     '  });',
19818     '} finally {',
19819     '  rtl._Release($mod.i);',
19820     '};',
19821     '']));
19822 end;
19823 
19824 procedure TTestModule.TestClassInterface_COM_FunctionInExpr;
19825 begin
19826   StartProgram(false);
19827   Add([
19828   '{$interfaces com}',
19829   'type',
19830   '  IUnknown = interface',
19831   '    function _AddRef: longint;',
19832   '    function _Release: longint;',
19833   '  end;',
19834   '  TObject = class(IUnknown)',
19835   '    function _AddRef: longint; virtual; abstract;',
19836   '    function _Release: longint; virtual; abstract;',
19837   '  end;',
19838   'function GetIt: IUnknown;',
19839   'begin',
19840   'end;',
19841   'procedure DoSome;',
19842   'var v: IUnknown;',
19843   '  i: longint;',
19844   'begin',
19845   '  v:=GetIt;',
19846   '  v:=GetIt();',
19847   '  GetIt()._AddRef;',
19848   '  i:=GetIt()._AddRef;',
19849   'end;',
19850   'var v: IUnknown;',
19851   '  i: longint;',
19852   'begin',
19853   '  v:=GetIt;',
19854   '  v:=GetIt();',
19855   '  GetIt()._AddRef;',
19856   '  i:=GetIt()._AddRef;',
19857   '']);
19858   ConvertProgram;
19859   CheckSource('TestClassInterface_COM_FunctionInExpr',
19860     LinesToStr([ // statements
19861     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19862     'rtl.createClass($mod, "TObject", null, function () {',
19863     '  this.$init = function () {',
19864     '  };',
19865     '  this.$final = function () {',
19866     '  };',
19867     '  rtl.addIntf(this, $mod.IUnknown);',
19868     '});',
19869     'this.GetIt = function () {',
19870     '  var Result = null;',
19871     '  return Result;',
19872     '};',
19873     'this.DoSome = function () {',
19874     '  var v = null;',
19875     '  var i = 0;',
19876     '  var $ir = rtl.createIntfRefs();',
19877     '  try {',
19878     '    v = rtl.setIntfL(v, $mod.GetIt(), true);',
19879     '    v = rtl.setIntfL(v, $mod.GetIt(), true);',
19880     '    $ir.ref(1, $mod.GetIt())._AddRef();',
19881     '    i = $ir.ref(2, $mod.GetIt())._AddRef();',
19882     '  } finally {',
19883     '    $ir.free();',
19884     '    rtl._Release(v);',
19885     '  };',
19886     '};',
19887     'this.v = null;',
19888     'this.i = 0;',
19889     '']),
19890     LinesToStr([ // $mod.$main
19891     'var $ir = rtl.createIntfRefs();',
19892     'try {',
19893     '  rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
19894     '  rtl.setIntfP($mod, "v", $mod.GetIt(), true);',
19895     '  $ir.ref(1, $mod.GetIt())._AddRef();',
19896     '  $mod.i = $ir.ref(2, $mod.GetIt())._AddRef();',
19897     '} finally {',
19898     '  $ir.free();',
19899     '};',
19900     '']));
19901 end;
19902 
19903 procedure TTestModule.TestClassInterface_COM_Property;
19904 begin
19905   StartProgram(false);
19906   Add([
19907   '{$interfaces com}',
19908   'type',
19909   '  IUnknown = interface',
19910   '    function _AddRef: longint;',
19911   '    function _Release: longint;',
19912   '  end;',
19913   '  TObject = class(IUnknown)',
19914   '    FAnt: IUnknown;',
19915   '    function _AddRef: longint; virtual; abstract;',
19916   '    function _Release: longint; virtual; abstract;',
19917   '    function GetBird: IUnknown; virtual; abstract;',
19918   '    procedure SetBird(Value: IUnknown); virtual; abstract;',
19919   '    function GetItems(Index: longint): IUnknown; virtual; abstract;',
19920   '    procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
19921   '    property Ant: IUnknown read FAnt write FAnt;',
19922   '    property Bird: IUnknown read GetBird write SetBird;',
19923   '    property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
19924   '  end;',
19925   'procedure DoIt;',
19926   'var',
19927   '  o: TObject;',
19928   '  v: IUnknown;',
19929   'begin',
19930   '  v:=o.Ant;',
19931   '  o.Ant:=v;',
19932   '  o.Ant:=o.Ant;',
19933   '  v:=o.Bird;',
19934   '  o.Bird:=v;',
19935   '  o.Bird:=o.Bird;',
19936   '  v:=o.Items[1];',
19937   '  o.Items[2]:=v;',
19938   '  o.Items[3]:=o.Items[4];',
19939   '  v:=o[5];',
19940   '  o[6]:=v;',
19941   '  o[7]:=o[8];',
19942   'end;',
19943   'begin',
19944   '']);
19945   ConvertProgram;
19946   CheckSource('TestClassInterface_COM_Property',
19947     LinesToStr([ // statements
19948     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
19949     'rtl.createClass($mod, "TObject", null, function () {',
19950     '  this.$init = function () {',
19951     '    this.FAnt = null;',
19952     '  };',
19953     '  this.$final = function () {',
19954     '    this.FAnt = undefined;',
19955     '  };',
19956     '  rtl.addIntf(this, $mod.IUnknown);',
19957     '});',
19958     'this.DoIt = function () {',
19959     '  var o = null;',
19960     '  var v = null;',
19961     '  var $ir = rtl.createIntfRefs();',
19962     '  try {',
19963     '    v = rtl.setIntfL(v, o.FAnt);',
19964     '    rtl.setIntfP(o, "FAnt", v);',
19965     '    rtl.setIntfP(o, "FAnt", o.FAnt);',
19966     '    v = rtl.setIntfL(v, o.GetBird(), true);',
19967     '    o.SetBird(v);',
19968     '    o.SetBird($ir.ref(1, o.GetBird()));',
19969     '    v = rtl.setIntfL(v, o.GetItems(1), true);',
19970     '    o.SetItems(2, v);',
19971     '    o.SetItems(3, $ir.ref(2, o.GetItems(4)));',
19972     '    v = rtl.setIntfL(v, o.GetItems(5), true);',
19973     '    o.SetItems(6, v);',
19974     '    o.SetItems(7, $ir.ref(3, o.GetItems(8)));',
19975     '  } finally {',
19976     '    $ir.free();',
19977     '    rtl._Release(v);',
19978     '  };',
19979     '};',
19980     '']),
19981     LinesToStr([ // $mod.$main
19982 
19983     '']));
19984 end;
19985 
19986 procedure TTestModule.TestClassInterface_COM_IntfProperty;
19987 begin
19988   StartProgram(false);
19989   Add([
19990   '{$interfaces com}',
19991   'type',
19992   '  IUnknown = interface',
19993   '    function _AddRef: longint;',
19994   '    function _Release: longint;',
19995   '    function GetBird: IUnknown;',
19996   '    procedure SetBird(Value: IUnknown);',
19997   '    function GetItems(Index: longint): IUnknown;',
19998   '    procedure SetItems(Index: longint; Value: IUnknown);',
19999   '    property Bird: IUnknown read GetBird write SetBird;',
20000   '    property Items[Index: longint]: IUnknown read GetItems write SetItems; default;',
20001   '  end;',
20002   '  TObject = class(IUnknown)',
20003   '    function _AddRef: longint; virtual; abstract;',
20004   '    function _Release: longint; virtual; abstract;',
20005   '    function GetBird: IUnknown; virtual; abstract;',
20006   '    procedure SetBird(Value: IUnknown); virtual; abstract;',
20007   '    function GetItems(Index: longint): IUnknown; virtual; abstract;',
20008   '    procedure SetItems(Index: longint; Value: IUnknown); virtual; abstract;',
20009   '  end;',
20010   'procedure DoIt;',
20011   'var',
20012   '  o: TObject;',
20013   '  v: IUnknown;',
20014   'begin',
20015   '  v:=v.Items[1];',
20016   '  v.Items[2]:=v;',
20017   '  v.Items[3]:=v.Items[4];',
20018   '  v:=v[5];',
20019   '  v[6]:=v;',
20020   '  v[7]:=v[8];',
20021   '  v[9].Bird.Bird:=v;',
20022   '  v:=v.Bird[10].Bird',
20023   'end;',
20024   'begin',
20025   '']);
20026   ConvertProgram;
20027   CheckSource('TestClassInterface_COM_IntfProperty',
20028     LinesToStr([ // statements
20029     'rtl.createInterface($mod, "IUnknown", "{385F5482-571B-338C-8130-4E97F330543B}", [',
20030     '  "_AddRef",',
20031     '  "_Release",',
20032     '  "GetBird",',
20033     '  "SetBird",',
20034     '  "GetItems",',
20035     '  "SetItems"',
20036     '], null);',
20037     'rtl.createClass($mod, "TObject", null, function () {',
20038     '  this.$init = function () {',
20039     '  };',
20040     '  this.$final = function () {',
20041     '  };',
20042     '  rtl.addIntf(this, $mod.IUnknown);',
20043     '});',
20044     'this.DoIt = function () {',
20045     '  var o = null;',
20046     '  var v = null;',
20047     '  var $ir = rtl.createIntfRefs();',
20048     '  try {',
20049     '    v = rtl.setIntfL(v, v.GetItems(1), true);',
20050     '    v.SetItems(2, v);',
20051     '    v.SetItems(3, $ir.ref(1, v.GetItems(4)));',
20052     '    v = rtl.setIntfL(v, v.GetItems(5), true);',
20053     '    v.SetItems(6, v);',
20054     '    v.SetItems(7, $ir.ref(2, v.GetItems(8)));',
20055     '    $ir.ref(4, $ir.ref(3, v.GetItems(9)).GetBird()).SetBird(v);',
20056     '    v = rtl.setIntfL(v, $ir.ref(6, $ir.ref(5, v.GetBird()).GetItems(10)).GetBird(), true);',
20057     '  } finally {',
20058     '    $ir.free();',
20059     '    rtl._Release(v);',
20060     '  };',
20061     '};',
20062     '']),
20063     LinesToStr([ // $mod.$main
20064 
20065     '']));
20066 end;
20067 
20068 procedure TTestModule.TestClassInterface_COM_Delegation;
20069 begin
20070   StartProgram(false);
20071   Add([
20072   '{$interfaces com}',
20073   'type',
20074   '  IUnknown = interface',
20075   '    function _AddRef: longint;',
20076   '    function _Release: longint;',
20077   '  end;',
20078   '  IBird = interface(IUnknown)',
20079   '    procedure Fly(s: string);',
20080   '  end;',
20081   '  IEagle = interface(IBird) end;',
20082   '  IDove = interface(IBird) end;',
20083   '  ISwallow = interface(IBird) end;',
20084   '  TObject = class',
20085   '  end;',
20086   '  TBird = class(TObject,IBird,IEagle,IDove,ISwallow)',
20087   '    function _AddRef: longint; virtual; abstract;',
20088   '    function _Release: longint; virtual; abstract;',
20089   '    procedure Fly(s: string); virtual; abstract;',
20090   '  end;',
20091   '  TBat = class(IBird,IEagle,IDove,ISwallow)',
20092   '    function _AddRef: longint; virtual; abstract;',
20093   '    function _Release: longint; virtual; abstract;',
20094   '    FBirdIntf: IBird;',
20095   '    property BirdIntf: IBird read FBirdIntf implements IBird;',
20096   '    function GetEagleIntf: IEagle; virtual; abstract;',
20097   '    property EagleIntf: IEagle read GetEagleIntf implements IEagle;',
20098   '    FDoveObj: TBird;',
20099   '    property DoveObj: TBird read FDoveObj implements IDove;',
20100   '    function GetSwallowObj: TBird; virtual; abstract;',
20101   '    property SwallowObj: TBird read GetSwallowObj implements ISwallow;',
20102   '  end;',
20103   'begin',
20104   '']);
20105   ConvertProgram;
20106   CheckSource('TestClassInterface_COM_Delegation',
20107     LinesToStr([ // statements
20108     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
20109     'rtl.createInterface($mod, "IBird", "{CC440C7F-7623-3DEE-AE88-000B86AAF108}", ["Fly"], $mod.IUnknown);',
20110     'rtl.createInterface($mod, "IEagle", "{4B6A41C9-B020-3D7C-B688-96D19022B1B4}", [], $mod.IBird);',
20111     'rtl.createInterface($mod, "IDove", "{4B6A41C9-B020-3D7C-B688-96D18EF16074}", [], $mod.IBird);',
20112     'rtl.createInterface($mod, "ISwallow", "{BB6A41C9-B020-3D7C-B688-96D1CBDCB359}", [], $mod.IBird);',
20113     'rtl.createClass($mod, "TObject", null, function () {',
20114     '  this.$init = function () {',
20115     '  };',
20116     '  this.$final = function () {',
20117     '  };',
20118     '});',
20119     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
20120     '  rtl.addIntf(this, $mod.IBird);',
20121     '  rtl.addIntf(this, $mod.IEagle);',
20122     '  rtl.addIntf(this, $mod.IDove);',
20123     '  rtl.addIntf(this, $mod.ISwallow);',
20124     '});',
20125     'rtl.createClass($mod, "TBat", $mod.TObject, function () {',
20126     '  this.$init = function () {',
20127     '    $mod.TObject.$init.call(this);',
20128     '    this.FBirdIntf = null;',
20129     '    this.FDoveObj = null;',
20130     '  };',
20131     '  this.$final = function () {',
20132     '    this.FBirdIntf = undefined;',
20133     '    this.FDoveObj = undefined;',
20134     '    $mod.TObject.$final.call(this);',
20135     '  };',
20136     '  this.$intfmaps = {',
20137     '    "{CC440C7F-7623-3DEE-AE88-000B86AAF108}": function () {',
20138     '        return rtl._AddRef(this.FBirdIntf);',
20139     '      },',
20140     '    "{4B6A41C9-B020-3D7C-B688-96D19022B1B4}": function () {',
20141     '        return this.GetEagleIntf();',
20142     '      },',
20143     '    "{4B6A41C9-B020-3D7C-B688-96D18EF16074}": function () {',
20144     '        return rtl.queryIntfT(this.FDoveObj, $mod.IDove);',
20145     '      },',
20146     '    "{BB6A41C9-B020-3D7C-B688-96D1CBDCB359}": function () {',
20147     '        return rtl.queryIntfT(this.GetSwallowObj(), $mod.ISwallow);',
20148     '      }',
20149     '  };',
20150     '});',
20151     '']),
20152     LinesToStr([ // $mod.$main
20153     '']));
20154 end;
20155 
20156 procedure TTestModule.TestClassInterface_COM_With;
20157 begin
20158   StartProgram(false);
20159   Add([
20160   '{$interfaces com}',
20161   'type',
20162   '  IUnknown = interface',
20163   '    function _AddRef: longint;',
20164   '    function _Release: longint;',
20165   '    function GetAnt: IUnknown;',
20166   '    property Ant: IUnknown read GetAnt;',
20167   '  end;',
20168   '  TObject = class(IUnknown)',
20169   '    function _AddRef: longint; virtual; abstract;',
20170   '    function _Release: longint; virtual; abstract;',
20171   '    function GetAnt: IUnknown; virtual; abstract;',
20172   '    property Ant: IUnknown read GetAnt;',
20173   '  end;',
20174   'procedure DoIt;',
20175   'var',
20176   '  i: IUnknown;',
20177   'begin',
20178   '  with i do ',
20179   '    GetAnt;',
20180   '  with i.Ant, Ant do ',
20181   '    GetAnt;',
20182   'end;',
20183   'begin',
20184   '']);
20185   ConvertProgram;
20186   CheckSource('TestClassInterface_COM_With',
20187     LinesToStr([ // statements
20188     'rtl.createInterface($mod, "IUnknown", "{D7ADB00D-C6B6-39FB-BDDF-21CD521DDFA9}", ["_AddRef", "_Release", "GetAnt"], null);',
20189     'rtl.createClass($mod, "TObject", null, function () {',
20190     '  this.$init = function () {',
20191     '  };',
20192     '  this.$final = function () {',
20193     '  };',
20194     '  rtl.addIntf(this, $mod.IUnknown);',
20195     '});',
20196     'this.DoIt = function () {',
20197     '  var i = null;',
20198     '  var $ir = rtl.createIntfRefs();',
20199     '  try {',
20200     '    $ir.ref(1, i.GetAnt());',
20201     '    var $with = $ir.ref(2, i.GetAnt());',
20202     '    var $with1 = $ir.ref(3, $with.GetAnt());',
20203     '    $ir.ref(4, $with1.GetAnt());',
20204     '  } finally {',
20205     '    $ir.free();',
20206     '  };',
20207     '};',
20208     '']),
20209     LinesToStr([ // $mod.$main
20210     '']));
20211 end;
20212 
20213 procedure TTestModule.TestClassInterface_COM_ForIn;
20214 begin
20215   StartProgram(false);
20216   Add([
20217   '{$interfaces com}',
20218   'type',
20219   '  IUnknown = interface end;',
20220   '  TObject = class',
20221   '    Id: longint;',
20222   '  end;',
20223   '  IEnumerator = interface(IUnknown)',
20224   '    function GetCurrent: TObject;',
20225   '    function MoveNext: Boolean;',
20226   '    property Current: TObject read GetCurrent;',
20227   '  end;',
20228   '  IEnumerable = interface(IUnknown)',
20229   '    function GetEnumerator: IEnumerator;',
20230   '  end;',
20231   'var',
20232   '  o: TObject;',
20233   '  i: IEnumerable;',
20234   'begin',
20235   '  for o in i do o.Id:=3;',
20236   '']);
20237   ConvertProgram;
20238   CheckSource('TestClassInterface_COM_ForIn',
20239     LinesToStr([ // statements
20240     'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
20241     'rtl.createClass($mod, "TObject", null, function () {',
20242     '  this.$init = function () {',
20243     '    this.Id = 0;',
20244     '  };',
20245     '  this.$final = function () {',
20246     '  };',
20247     '});',
20248     'rtl.createInterface($mod, "IEnumerator", "{95D7745D-ED61-3F13-BBE4-07708161999E}", ["GetCurrent", "MoveNext"], $mod.IUnknown);',
20249     'rtl.createInterface($mod, "IEnumerable", "{8CC9D45D-ED7D-3B73-96B6-290B931BB19E}", ["GetEnumerator"], $mod.IUnknown);',
20250     'this.o = null;',
20251     'this.i = null;',
20252     '']),
20253     LinesToStr([ // $mod.$main
20254     'var $in = $mod.i.GetEnumerator();',
20255     'try {',
20256     '  while ($in.MoveNext()) {',
20257     '    $mod.o = $in.GetCurrent();',
20258     '    $mod.o.Id = 3;',
20259     '  }',
20260     '} finally {',
20261     '  rtl._Release($in)',
20262     '};',
20263     '']));
20264 end;
20265 
20266 procedure TTestModule.TestClassInterface_COM_ArrayOfIntfFail;
20267 begin
20268   StartProgram(false);
20269   Add([
20270   '{$interfaces com}',
20271   'type',
20272   '  IUnknown = interface',
20273   '    function _AddRef: longint;',
20274   '    function _Release: longint;',
20275   '  end;',
20276   '  TObject = class',
20277   '  end;',
20278   '  TArrOfIntf = array of IUnknown;',
20279   'begin',
20280   '']);
20281   SetExpectedPasResolverError('Not supported: array of COM-interface',nNotSupportedX);
20282   ConvertProgram;
20283 end;
20284 
20285 procedure TTestModule.TestClassInterface_COM_RecordIntfFail;
20286 begin
20287   StartProgram(false);
20288   Add([
20289   '{$interfaces com}',
20290   'type',
20291   '  IUnknown = interface',
20292   '    function _AddRef: longint;',
20293   '    function _Release: longint;',
20294   '  end;',
20295   '  TRec = record',
20296   '    i: IUnknown;',
20297   '  end;',
20298   'begin',
20299   '']);
20300   SetExpectedPasResolverError('Not supported: COM-interface as record member',nNotSupportedX);
20301   ConvertProgram;
20302 end;
20303 
20304 procedure TTestModule.TestClassInterface_COM_UnitInitialization;
20305 begin
20306   StartUnit(false);
20307   Add([
20308   '{$interfaces com}',
20309   'interface',
20310   'implementation',
20311   'type',
20312   '  IUnknown = interface',
20313   '    function _AddRef: longint;',
20314   '  end;',
20315   '  TObject = class(IUnknown)',
20316   '    function _AddRef: longint;',
20317   '  end;',
20318   'function TObject._AddRef: longint; begin end;',
20319   'var i: IUnknown;',
20320   '  o: TObject;',
20321   'initialization',
20322   '  i:=nil;',
20323   '  i:=i;',
20324   '  i:=o;',
20325   '  if (o as IUnknown)=nil then ;',
20326   '']);
20327   ConvertUnit;
20328   CheckSource('TestClassInterface_COM_UnitInitialization',
20329     LinesToStr([ // statements
20330     'var $impl = $mod.$impl;',
20331     '']),
20332     LinesToStr([ // this.$init
20333     'var $ir = rtl.createIntfRefs();',
20334     'try {',
20335     '  rtl.setIntfP($impl, "i", null);',
20336     '  rtl.setIntfP($impl, "i", $impl.i);',
20337     '  rtl.setIntfP($impl, "i", rtl.queryIntfT($impl.o, $impl.IUnknown), true);',
20338     '  if ($ir.ref(1, rtl.queryIntfT($impl.o, $impl.IUnknown)) === null) ;',
20339     '} finally {',
20340     '  $ir.free();',
20341     '};',
20342     '']),
20343     LinesToStr([ // implementation
20344     'rtl.createInterface($impl, "IUnknown", "{B92D5841-758A-322B-BDDF-21CD52180000}", ["_AddRef"], null);',
20345     'rtl.createClass($impl, "TObject", null, function () {',
20346     '  this.$init = function () {',
20347     '  };',
20348     '  this.$final = function () {',
20349     '  };',
20350     '  this._AddRef = function () {',
20351     '    var Result = 0;',
20352     '    return Result;',
20353     '  };',
20354     '  rtl.addIntf(this, $impl.IUnknown);',
20355     '});',
20356     '$impl.i = null;',
20357     '$impl.o = null;',
20358     ''])
20359     );
20360 end;
20361 
20362 procedure TTestModule.TestClassInterface_GUID;
20363 begin
20364   StartProgram(false);
20365   Add([
20366   '{$interfaces corba}',
20367   'type',
20368   '  IUnknown = interface',
20369   '    [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
20370   '  end;',
20371   '  TObject = class end;',
20372   '  TGUID = record D1, D2, D3, D4: word; end;',
20373   '  TAliasGUID = TGUID;',
20374   '  TGUIDString = type string;',
20375   '  TAliasGUIDString = TGUIDString;',
20376   'procedure DoConstGUIDIt(const g: TAliasGUID); overload;',
20377   'begin end;',
20378   'procedure DoDefGUID(g: TAliasGUID); overload;',
20379   'begin end;',
20380   'procedure DoStr(const s: TAliasGUIDString); overload;',
20381   'begin end;',
20382   'var',
20383   '  i: IUnknown;',
20384   '  g: TAliasGUID = ''{d91c9af4-3C93-420F-A303-BF5BA82BFD23}'';',
20385   '  s: TAliasGUIDString;',
20386   'begin',
20387   '  DoConstGUIDIt(IUnknown);',
20388   '  DoDefGUID(IUnknown);',
20389   '  DoStr(IUnknown);',
20390   '  DoConstGUIDIt(i);',
20391   '  DoDefGUID(i);',
20392   '  DoStr(i);',
20393   '  DoConstGUIDIt(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
20394   '  DoDefGUID(''{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}'');',
20395   '  DoStr(g);',
20396   '  g:=i;',
20397   '  g:=IUnknown;',
20398   '  g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
20399   '  s:=i;',
20400   '  s:=IUnknown;',
20401   '  s:=g;',
20402   '  if g=i then ;',
20403   '  if i=g then ;',
20404   '  if g=IUnknown then ;',
20405   '  if IUnknown=g then ;',
20406   '  if s=i then ;',
20407   '  if i=s then ;',
20408   '  if s=IUnknown then ;',
20409   '  if IUnknown=s then ;',
20410   '  if s=g then ;',
20411   '  if g=s then ;',
20412   '']);
20413   ConvertProgram;
20414   CheckSource('TestClassInterface_GUID',
20415     LinesToStr([ // statements
20416     'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
20417     'rtl.createClass($mod, "TObject", null, function () {',
20418     '  this.$init = function () {',
20419     '  };',
20420     '  this.$final = function () {',
20421     '  };',
20422     '});',
20423     'rtl.recNewT($mod, "TGUID", function () {',
20424     '  this.D1 = 0;',
20425     '  this.D2 = 0;',
20426     '  this.D3 = 0;',
20427     '  this.D4 = 0;',
20428     '  this.$eq = function (b) {',
20429     '    return (this.D1 === b.D1) && (this.D2 === b.D2) && (this.D3 === b.D3) && (this.D4 === b.D4);',
20430     '  };',
20431     '  this.$assign = function (s) {',
20432     '    this.D1 = s.D1;',
20433     '    this.D2 = s.D2;',
20434     '    this.D3 = s.D3;',
20435     '    this.D4 = s.D4;',
20436     '    return this;',
20437     '  };',
20438     '});',
20439     'this.DoConstGUIDIt = function (g) {',
20440     '};',
20441     'this.DoDefGUID = function (g) {',
20442     '};',
20443     'this.DoStr = function (s) {',
20444     '};',
20445     'this.i = null;',
20446     'this.g = $mod.TGUID.$clone({',
20447     '  D1: 0xD91C9AF4,',
20448     '  D2: 0x3C93,',
20449     '  D3: 0x420F,',
20450     '  D4: [',
20451     '      0xA3,',
20452     '      0x03,',
20453     '      0xBF,',
20454     '      0x5B,',
20455     '      0xA8,',
20456     '      0x2B,',
20457     '      0xFD,',
20458     '      0x23',
20459     '    ]',
20460     '});',
20461     'this.s = "";',
20462     '']),
20463     LinesToStr([ // $mod.$main
20464     '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.IUnknown));',
20465     '$mod.DoDefGUID($mod.TGUID.$clone(rtl.getIntfGUIDR($mod.IUnknown)));',
20466     '$mod.DoStr($mod.IUnknown.$guid);',
20467     '$mod.DoConstGUIDIt(rtl.getIntfGUIDR($mod.i));',
20468     '$mod.DoDefGUID($mod.TGUID.$clone(rtl.getIntfGUIDR($mod.i)));',
20469     '$mod.DoStr($mod.i.$guid);',
20470     '$mod.DoConstGUIDIt(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
20471     '$mod.DoDefGUID(rtl.strToGUIDR("{D91C9AF4-3c93-420f-A303-BF5BA82BFD23}"));',
20472     '$mod.DoStr(rtl.guidrToStr($mod.g));',
20473     '$mod.g.$assign(rtl.getIntfGUIDR($mod.i));',
20474     '$mod.g.$assign(rtl.getIntfGUIDR($mod.IUnknown));',
20475     '$mod.g.$assign({',
20476     '  D1: 0xD91C9AF4,',
20477     '  D2: 0x3C93,',
20478     '  D3: 0x420F,',
20479     '  D4: [',
20480     '      0xA3,',
20481     '      0x03,',
20482     '      0xBF,',
20483     '      0x5B,',
20484     '      0xA8,',
20485     '      0x2B,',
20486     '      0xFD,',
20487     '      0x23',
20488     '    ]',
20489     '});',
20490     '$mod.s = $mod.i.$guid;',
20491     '$mod.s = $mod.IUnknown.$guid;',
20492     '$mod.s = rtl.guidrToStr($mod.g);',
20493     'if ($mod.g.$eq(rtl.getIntfGUIDR($mod.i))) ;',
20494     'if ($mod.g.$eq(rtl.getIntfGUIDR($mod.i))) ;',
20495     'if ($mod.g.$eq(rtl.getIntfGUIDR($mod.IUnknown))) ;',
20496     'if ($mod.g.$eq(rtl.getIntfGUIDR($mod.IUnknown))) ;',
20497     'if ($mod.s === $mod.i.$guid) ;',
20498     'if ($mod.i.$guid === $mod.s) ;',
20499     'if ($mod.s === $mod.IUnknown.$guid) ;',
20500     'if ($mod.IUnknown.$guid === $mod.s) ;',
20501     'if ($mod.g.$eq(rtl.createTGUID($mod.s))) ;',
20502     'if ($mod.g.$eq(rtl.createTGUID($mod.s))) ;',
20503     '']));
20504 end;
20505 
20506 procedure TTestModule.TestClassInterface_GUIDProperty;
20507 begin
20508   StartProgram(false);
20509   Add([
20510   '{$interfaces corba}',
20511   'type',
20512   '  IUnknown = interface',
20513   '    [''{f31db68f-3010-D355-4EBA-CDD4EF4A737C}'']',
20514   '  end;',
20515   '  TGUID = record D1, D2, D3, D4: word; end;',
20516   '  TAliasGUID = TGUID;',
20517   '  TGUIDString = type string;',
20518   '  TAliasGUIDString = TGUIDString;',
20519   '  TObject = class',
20520   '    function GetG: TAliasGUID; virtual; abstract;',
20521   '    procedure SetG(const Value: TAliasGUID); virtual; abstract;',
20522   '    function GetS: TAliasGUIDString; virtual; abstract;',
20523   '    procedure SetS(const Value: TAliasGUIDString); virtual; abstract;',
20524   '    property g: TAliasGUID read GetG write SetG;',
20525   '    property s: TAliasGUIDString read GetS write SetS;',
20526   '  end;',
20527   'var o: TObject;',
20528   'begin',
20529   '  o.g:=IUnknown;',
20530   '  o.g:=''{D91C9AF4-3C93-420F-A303-bf5ba82bfd23}'';',
20531   '  o.s:=IUnknown;',
20532   '  o.s:=o.g;',
20533   '']);
20534   ConvertProgram;
20535   CheckSource('TestClassInterface_GUIDProperty',
20536     LinesToStr([ // statements
20537     'rtl.createInterface($mod, "IUnknown", "{F31DB68F-3010-D355-4EBA-CDD4EF4A737C}", [], null);',
20538     'rtl.recNewT($mod, "TGUID", function () {',
20539     '  this.D1 = 0;',
20540     '  this.D2 = 0;',
20541     '  this.D3 = 0;',
20542     '  this.D4 = 0;',
20543     '  this.$eq = function (b) {',
20544     '    return (this.D1 === b.D1) && (this.D2 === b.D2) && (this.D3 === b.D3) && (this.D4 === b.D4);',
20545     '  };',
20546     '  this.$assign = function (s) {',
20547     '    this.D1 = s.D1;',
20548     '    this.D2 = s.D2;',
20549     '    this.D3 = s.D3;',
20550     '    this.D4 = s.D4;',
20551     '    return this;',
20552     '  };',
20553     '});',
20554     'rtl.createClass($mod, "TObject", null, function () {',
20555     '  this.$init = function () {',
20556     '  };',
20557     '  this.$final = function () {',
20558     '  };',
20559     '});',
20560     'this.o = null;',
20561     '']),
20562     LinesToStr([ // $mod.$main
20563     '$mod.o.SetG(rtl.getIntfGUIDR($mod.IUnknown));',
20564     '$mod.o.SetG({',
20565     '  D1: 0xD91C9AF4,',
20566     '  D2: 0x3C93,',
20567     '  D3: 0x420F,',
20568     '  D4: [',
20569     '      0xA3,',
20570     '      0x03,',
20571     '      0xBF,',
20572     '      0x5B,',
20573     '      0xA8,',
20574     '      0x2B,',
20575     '      0xFD,',
20576     '      0x23',
20577     '    ]',
20578     '});',
20579     '$mod.o.SetS($mod.IUnknown.$guid);',
20580     '$mod.o.SetS(rtl.guidrToStr($mod.o.GetG()));',
20581     '']));
20582 end;
20583 
20584 procedure TTestModule.TestClassHelper_ClassVar;
20585 begin
20586   StartProgram(false);
20587   Add([
20588   'type',
20589   '  TObject = class',
20590   '  end;',
20591   '  THelper = class helper for TObject',
20592   '    const',
20593   '      One = 1;',
20594   '      Two: word = 2;',
20595   '    class var',
20596   '      Glob: word;',
20597   '    function Foo(w: word): word;',
20598   '    class function Bar(w: word): word;',
20599   '  end;',
20600   'function THelper.foo(w: word): word;',
20601   'begin',
20602   '  Result:=w;',
20603   '  Two:=One+w;',
20604   '  Glob:=Glob;',
20605   '  Result:=Self.Glob;',
20606   '  Self.Glob:=Self.Glob;',
20607   '  with Self do Glob:=Glob;',
20608   'end;',
20609   'class function THelper.bar(w: word): word;',
20610   'begin',
20611   '  Result:=w;',
20612   '  Two:=One;',
20613   '  Glob:=Glob;',
20614   '  Self.Glob:=Self.Glob;',
20615   '  with Self do Glob:=Glob;',
20616   'end;',
20617   'var o: TObject;',
20618   'begin',
20619   '  tobject.two:=tobject.one;',
20620   '  tobject.Glob:=tobject.Glob;',
20621   '  with tobject do begin',
20622   '    two:=one;',
20623   '    Glob:=Glob;',
20624   '  end;',
20625   '  o.two:=o.one;',
20626   '  o.Glob:=o.Glob;',
20627   '  with o do begin',
20628   '    two:=one;',
20629   '    Glob:=Glob;',
20630   '  end;',
20631   '']);
20632   ConvertProgram;
20633   CheckSource('TestClassHelper_ClassVar',
20634     LinesToStr([ // statements
20635     'rtl.createClass($mod, "TObject", null, function () {',
20636     '  this.$init = function () {',
20637     '  };',
20638     '  this.$final = function () {',
20639     '  };',
20640     '});',
20641     'rtl.createHelper($mod, "THelper", null, function () {',
20642     '  this.One = 1;',
20643     '  this.Two = 2;',
20644     '  this.Glob = 0;',
20645     '  this.Foo = function (w) {',
20646     '    var Result = 0;',
20647     '    Result = w;',
20648     '    $mod.THelper.Two = 1 + w;',
20649     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20650     '    Result = $mod.THelper.Glob;',
20651     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20652     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20653     '    return Result;',
20654     '  };',
20655     '  this.Bar = function (w) {',
20656     '    var Result = 0;',
20657     '    Result = w;',
20658     '    $mod.THelper.Two = 1;',
20659     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20660     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20661     '    $mod.THelper.Glob = $mod.THelper.Glob;',
20662     '    return Result;',
20663     '  };',
20664     '});',
20665     'this.o = null;',
20666     '']),
20667     LinesToStr([ // $mod.$main
20668     '$mod.THelper.Two = 1;',
20669     '$mod.THelper.Glob = $mod.THelper.Glob;',
20670     'var $with = $mod.TObject;',
20671     '$mod.THelper.Two = 1;',
20672     '$mod.THelper.Glob = $mod.THelper.Glob;',
20673     '$mod.THelper.Two = 1;',
20674     '$mod.THelper.Glob = $mod.THelper.Glob;',
20675     'var $with1 = $mod.o;',
20676     '$mod.THelper.Two = 1;',
20677     '$mod.THelper.Glob = $mod.THelper.Glob;',
20678     '']));
20679 end;
20680 
20681 procedure TTestModule.TestClassHelper_Method_AccessInstanceFields;
20682 begin
20683   StartProgram(false);
20684   Add([
20685   'type',
20686   '  TObject = class',
20687   '    FSize: word;',
20688   '    property Size: word read FSize write FSize;',
20689   '  end;',
20690   '  THelper = class helper for TObject',
20691   '    function Foo(w: word = 1): word;',
20692   '  end;',
20693   'function THelper.foo(w: word): word;',
20694   'begin',
20695   '  Result:=Size;',
20696   '  Size:=Size+2;',
20697   '  Self.Size:=Self.Size+3;',
20698   '  FSize:=FSize+4;',
20699   '  Self.FSize:=Self.FSize+5;',
20700   '  with Self do begin',
20701   '    Size:=Size+6;',
20702   '    FSize:=FSize+7;',
20703   '    FSize:=FSize+8;',
20704   '  end;',
20705   'end;',
20706   'begin',
20707   '']);
20708   ConvertProgram;
20709   CheckSource('TestClassHelper_Method_AccessInstanceFields',
20710     LinesToStr([ // statements
20711     'rtl.createClass($mod, "TObject", null, function () {',
20712     '  this.$init = function () {',
20713     '    this.FSize = 0;',
20714     '  };',
20715     '  this.$final = function () {',
20716     '  };',
20717     '});',
20718     'rtl.createHelper($mod, "THelper", null, function () {',
20719     '  this.Foo = function (w) {',
20720     '    var Result = 0;',
20721     '    Result = this.FSize;',
20722     '    this.FSize = this.FSize + 2;',
20723     '    this.FSize = this.FSize + 3;',
20724     '    this.FSize = this.FSize + 4;',
20725     '    this.FSize = this.FSize + 5;',
20726     '    this.FSize = this.FSize + 6;',
20727     '    this.FSize = this.FSize + 7;',
20728     '    this.FSize = this.FSize + 8;',
20729     '    return Result;',
20730     '  };',
20731     '});',
20732     '']),
20733     LinesToStr([ // $mod.$main
20734     '']));
20735 end;
20736 
20737 procedure TTestModule.TestClassHelper_Method_Call;
20738 begin
20739   StartProgram(false);
20740   Add([
20741   'type',
20742   '  TObject = class',
20743   '    procedure Run(w: word = 10);',
20744   '  end;',
20745   '  THelper = class helper for TObject',
20746   '    function Foo(w: word = 1): word;',
20747   '  end;',
20748   'procedure TObject.Run(w: word);',
20749   'var o: TObject;',
20750   'begin',
20751   '  Foo;',
20752   '  Foo();',
20753   '  Foo(2);',
20754   '  Self.Foo;',
20755   '  Self.Foo();',
20756   '  Self.Foo(3);',
20757   '  with Self do begin',
20758   '    Foo;',
20759   '    Foo();',
20760   '    Foo(4);',
20761   '  end;',
20762   '  with o do Foo(5);',
20763   'end;',
20764   'function THelper.foo(w: word): word;',
20765   'begin',
20766   '  Run;',
20767   '  Run();',
20768   '  Run(11);',
20769   '  Foo;',
20770   '  Foo();',
20771   '  Foo(12);',
20772   '  Self.Foo;',
20773   '  Self.Foo();',
20774   '  Self.Foo(13);',
20775   '  with Self do begin',
20776   '    Foo;',
20777   '    Foo();',
20778   '    Foo(14);',
20779   '  end;',
20780   'end;',
20781   'var Obj: TObject;',
20782   'begin',
20783   '  obj.Foo;',
20784   '  obj.Foo();',
20785   '  obj.Foo(21);',
20786   '  with obj do begin',
20787   '    Foo;',
20788   '    Foo();',
20789   '    Foo(22);',
20790   '  end;',
20791   '']);
20792   ConvertProgram;
20793   CheckSource('TestClassHelper_Method_Call',
20794     LinesToStr([ // statements
20795     'rtl.createClass($mod, "TObject", null, function () {',
20796     '  this.$init = function () {',
20797     '  };',
20798     '  this.$final = function () {',
20799     '  };',
20800     '  this.Run = function (w) {',
20801     '    var o = null;',
20802     '    $mod.THelper.Foo.call(this, 1);',
20803     '    $mod.THelper.Foo.call(this, 1);',
20804     '    $mod.THelper.Foo.call(this, 2);',
20805     '    $mod.THelper.Foo.call(this, 1);',
20806     '    $mod.THelper.Foo.call(this, 1);',
20807     '    $mod.THelper.Foo.call(this, 3);',
20808     '    $mod.THelper.Foo.call(this, 1);',
20809     '    $mod.THelper.Foo.call(this, 1);',
20810     '    $mod.THelper.Foo.call(this, 4);',
20811     '    $mod.THelper.Foo.call(o, 5);',
20812     '  };',
20813     '});',
20814     'rtl.createHelper($mod, "THelper", null, function () {',
20815     '  this.Foo = function (w) {',
20816     '    var Result = 0;',
20817     '    this.Run(10);',
20818     '    this.Run(10);',
20819     '    this.Run(11);',
20820     '    $mod.THelper.Foo.call(this, 1);',
20821     '    $mod.THelper.Foo.call(this, 1);',
20822     '    $mod.THelper.Foo.call(this, 12);',
20823     '    $mod.THelper.Foo.call(this, 1);',
20824     '    $mod.THelper.Foo.call(this, 1);',
20825     '    $mod.THelper.Foo.call(this, 13);',
20826     '    $mod.THelper.Foo.call(this, 1);',
20827     '    $mod.THelper.Foo.call(this, 1);',
20828     '    $mod.THelper.Foo.call(this, 14);',
20829     '    return Result;',
20830     '  };',
20831     '});',
20832     'this.Obj = null;',
20833     '']),
20834     LinesToStr([ // $mod.$main
20835     '$mod.THelper.Foo.call($mod.Obj, 1);',
20836     '$mod.THelper.Foo.call($mod.Obj, 1);',
20837     '$mod.THelper.Foo.call($mod.Obj, 21);',
20838     'var $with = $mod.Obj;',
20839     '$mod.THelper.Foo.call($with, 1);',
20840     '$mod.THelper.Foo.call($with, 1);',
20841     '$mod.THelper.Foo.call($with, 22);',
20842     '']));
20843 end;
20844 
20845 procedure TTestModule.TestClassHelper_Method_Nested_Call;
20846 begin
20847   StartProgram(false);
20848   Add([
20849   'type',
20850   '  TObject = class',
20851   '    procedure Run(w: word = 10);',
20852   '  end;',
20853   '  THelper = class helper for TObject',
20854   '    function Foo(w: word = 1): word;',
20855   '  end;',
20856   'procedure TObject.Run(w: word);',
20857   '  procedure Sub(Self: TObject);',
20858   '  begin',
20859   '    Foo;',
20860   '    Foo();',
20861   '    Self.Foo;',
20862   '    Self.Foo();',
20863   '    with Self do begin',
20864   '      Foo;',
20865   '      Foo();',
20866   '    end;',
20867   '  end;',
20868   'begin',
20869   'end;',
20870   'function THelper.foo(w: word): word;',
20871   '  procedure Sub(Self: TObject);',
20872   '  begin',
20873   '    Run;',
20874   '    Run();',
20875   '    Foo;',
20876   '    Foo();',
20877   '    Self.Foo;',
20878   '    Self.Foo();',
20879   '    with Self do begin',
20880   '      Foo;',
20881   '      Foo();',
20882   '    end;',
20883   '  end;',
20884   'begin',
20885   'end;',
20886   'begin',
20887   '']);
20888   ConvertProgram;
20889   CheckSource('TestClassHelper_Method_Nested_Call',
20890     LinesToStr([ // statements
20891     'rtl.createClass($mod, "TObject", null, function () {',
20892     '  this.$init = function () {',
20893     '  };',
20894     '  this.$final = function () {',
20895     '  };',
20896     '  this.Run = function (w) {',
20897     '    var $Self = this;',
20898     '    function Sub(Self) {',
20899     '      $mod.THelper.Foo.call($Self, 1);',
20900     '      $mod.THelper.Foo.call($Self, 1);',
20901     '      $mod.THelper.Foo.call(Self, 1);',
20902     '      $mod.THelper.Foo.call(Self, 1);',
20903     '      $mod.THelper.Foo.call(Self, 1);',
20904     '      $mod.THelper.Foo.call(Self, 1);',
20905     '    };',
20906     '  };',
20907     '});',
20908     'rtl.createHelper($mod, "THelper", null, function () {',
20909     '  this.Foo = function (w) {',
20910     '    var $Self = this;',
20911     '    var Result = 0;',
20912     '    function Sub(Self) {',
20913     '      $Self.Run(10);',
20914     '      $Self.Run(10);',
20915     '      $mod.THelper.Foo.call($Self, 1);',
20916     '      $mod.THelper.Foo.call($Self, 1);',
20917     '      $mod.THelper.Foo.call(Self, 1);',
20918     '      $mod.THelper.Foo.call(Self, 1);',
20919     '      $mod.THelper.Foo.call(Self, 1);',
20920     '      $mod.THelper.Foo.call(Self, 1);',
20921     '    };',
20922     '    return Result;',
20923     '  };',
20924     '});',
20925     '']),
20926     LinesToStr([ // $mod.$main
20927     '']));
20928 end;
20929 
20930 procedure TTestModule.TestClassHelper_ClassMethod_Call;
20931 begin
20932   StartProgram(false);
20933   Add([
20934   'type',
20935   '  TObject = class',
20936   '    class procedure Run(w: word = 10);',
20937   '  end;',
20938   '  THelper = class helper for TObject',
20939   '    class function Foo(w: word = 1): word;',
20940   '  end;',
20941   'class procedure TObject.Run(w: word);',
20942   'begin',
20943   '  Foo;',
20944   '  Foo();',
20945   '  Self.Foo;',
20946   '  Self.Foo();',
20947   '  with Self do begin',
20948   '    Foo;',
20949   '    Foo();',
20950   '  end;',
20951   'end;',
20952   'class function THelper.foo(w: word): word;',
20953   'begin',
20954   '  Run;',
20955   '  Run();',
20956   '  Foo;',
20957   '  Foo();',
20958   '  Self.Foo;',
20959   '  Self.Foo();',
20960   '  with Self do begin',
20961   '    Foo;',
20962   '    Foo();',
20963   '  end;',
20964   'end;',
20965   'var',
20966   '  Obj: TObject;',
20967   'begin',
20968   '  obj.Foo;',
20969   '  obj.Foo();',
20970   '  with obj do begin',
20971   '    Foo;',
20972   '    Foo();',
20973   '  end;',
20974   '  tobject.Foo;',
20975   '  tobject.Foo();',
20976   '  with tobject do begin',
20977   '    Foo;',
20978   '    Foo();',
20979   '  end;',
20980   '']);
20981   ConvertProgram;
20982   CheckSource('TestClassHelper_ClassMethod_Call',
20983     LinesToStr([ // statements
20984     'rtl.createClass($mod, "TObject", null, function () {',
20985     '  this.$init = function () {',
20986     '  };',
20987     '  this.$final = function () {',
20988     '  };',
20989     '  this.Run = function (w) {',
20990     '    $mod.THelper.Foo.call(this, 1);',
20991     '    $mod.THelper.Foo.call(this, 1);',
20992     '    $mod.THelper.Foo.call(this, 1);',
20993     '    $mod.THelper.Foo.call(this, 1);',
20994     '    $mod.THelper.Foo.call(this, 1);',
20995     '    $mod.THelper.Foo.call(this, 1);',
20996     '  };',
20997     '});',
20998     'rtl.createHelper($mod, "THelper", null, function () {',
20999     '  this.Foo = function (w) {',
21000     '    var Result = 0;',
21001     '    this.Run(10);',
21002     '    this.Run(10);',
21003     '    $mod.THelper.Foo.call(this, 1);',
21004     '    $mod.THelper.Foo.call(this, 1);',
21005     '    $mod.THelper.Foo.call(this, 1);',
21006     '    $mod.THelper.Foo.call(this, 1);',
21007     '    $mod.THelper.Foo.call(this, 1);',
21008     '    $mod.THelper.Foo.call(this, 1);',
21009     '    return Result;',
21010     '  };',
21011     '});',
21012     'this.Obj = null;',
21013     '']),
21014     LinesToStr([ // $mod.$main
21015     '$mod.THelper.Foo.call($mod.Obj.$class, 1);',
21016     '$mod.THelper.Foo.call($mod.Obj.$class, 1);',
21017     'var $with = $mod.Obj;',
21018     '$mod.THelper.Foo.call($with.$class, 1);',
21019     '$mod.THelper.Foo.call($with.$class, 1);',
21020     '$mod.THelper.Foo.call($mod.TObject, 1);',
21021     '$mod.THelper.Foo.call($mod.TObject, 1);',
21022     'var $with1 = $mod.TObject;',
21023     '$mod.THelper.Foo.call($mod.TObject, 1);',
21024     '$mod.THelper.Foo.call($mod.TObject, 1);',
21025     '']));
21026 end;
21027 
21028 procedure TTestModule.TestClassHelper_ClassOf;
21029 begin
21030   StartProgram(false);
21031   Add([
21032   'type',
21033   '  TObject = class',
21034   '  end;',
21035   '  TClass = class of TObject;',
21036   '  THelper = class helper for TObject',
21037   '    class function Foo(w: word = 1): word;',
21038   '  end;',
21039   'class function THelper.foo(w: word): word;',
21040   'begin',
21041   'end;',
21042   'var',
21043   '  c: TClass;',
21044   'begin',
21045   '  c.Foo;',
21046   '  c.Foo();',
21047   '  with c do begin',
21048   '    Foo;',
21049   '    Foo();',
21050   '  end;',
21051   '']);
21052   ConvertProgram;
21053   CheckSource('TestClassHelper_ClassOf',
21054     LinesToStr([ // statements
21055     'rtl.createClass($mod, "TObject", null, function () {',
21056     '  this.$init = function () {',
21057     '  };',
21058     '  this.$final = function () {',
21059     '  };',
21060     '});',
21061     'rtl.createHelper($mod, "THelper", null, function () {',
21062     '  this.Foo = function (w) {',
21063     '    var Result = 0;',
21064     '    return Result;',
21065     '  };',
21066     '});',
21067     'this.c = null;',
21068     '']),
21069     LinesToStr([ // $mod.$main
21070     '$mod.THelper.Foo.call($mod.c, 1);',
21071     '$mod.THelper.Foo.call($mod.c, 1);',
21072     'var $with = $mod.c;',
21073     '$mod.THelper.Foo.call($with, 1);',
21074     '$mod.THelper.Foo.call($with, 1);',
21075     '']));
21076 end;
21077 
21078 procedure TTestModule.TestClassHelper_MethodRefObjFPC;
21079 begin
21080   StartProgram(false);
21081   Add([
21082   '{$mode objfpc}',
21083   'type',
21084   '  TObject = class',
21085   '    procedure DoIt;',
21086   '  end;',
21087   '  THelper = class helper for TObject',
21088   '    procedure Fly(w: word = 1);',
21089   '    class procedure Glide(w: word = 1);',
21090   '    class procedure Run(w: word = 1); static;',
21091   '  end;',
21092   '  TFly = procedure(w: word) of object;',
21093   '  TGlide = TFly;',
21094   '  TRun = procedure(w: word);',
21095   'var',
21096   '  f: TFly;',
21097   '  g: TGlide;',
21098   '  r: TRun;',
21099   'procedure TObject.DoIt;',
21100   'begin',
21101   '  f:=@fly;',
21102   '  g:=@glide;',
21103   '  r:=@run;',
21104   '  f:=@Self.fly;',
21105   '  g:=@Self.glide;',
21106   '  r:=@Self.run;',
21107   '  with self do begin',
21108   '    f:=@fly;',
21109   '    g:=@glide;',
21110   '    r:=@run;',
21111   '  end;',
21112   'end;',
21113   'procedure THelper.fly(w: word);',
21114   'begin',
21115   '  f:=@fly;',
21116   '  g:=@glide;',
21117   '  r:=@run;',
21118   'end;',
21119   'class procedure THelper.glide(w: word);',
21120   'begin',
21121   '  g:=@glide;',
21122   '  r:=@run;',
21123   'end;',
21124   'class procedure THelper.run(w: word);',
21125   'begin',
21126   '  g:=@glide;',
21127   '  r:=@run;',
21128   'end;',
21129   'var',
21130   '  Obj: TObject;',
21131   'begin',
21132   '  f:=@obj.fly;',
21133   '  g:=@obj.glide;',
21134   '  r:=@obj.run;',
21135   '  with obj do begin',
21136   '    f:=@fly;',
21137   '    g:=@glide;',
21138   '    r:=@run;',
21139   '  end;',
21140   '  g:=@tobject.glide;',
21141   '  r:=@tobject.run;',
21142   '  with tobject do begin',
21143   '    g:=@glide;',
21144   '    r:=@run;',
21145   '  end;',
21146   '']);
21147   ConvertProgram;
21148   CheckSource('TestClassHelper_MethodRefObjFPC',
21149     LinesToStr([ // statements
21150     'rtl.createClass($mod, "TObject", null, function () {',
21151     '  this.$init = function () {',
21152     '  };',
21153     '  this.$final = function () {',
21154     '  };',
21155     '  this.DoIt = function () {',
21156     '    $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
21157     '    $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
21158     '    $mod.r = $mod.THelper.Run;',
21159     '    $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
21160     '    $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
21161     '    $mod.r = $mod.THelper.Run;',
21162     '    $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
21163     '    $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
21164     '    $mod.r = $mod.THelper.Run;',
21165     '  };',
21166     '});',
21167     'rtl.createHelper($mod, "THelper", null, function () {',
21168     '  this.Fly = function (w) {',
21169     '    $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
21170     '    $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
21171     '    $mod.r = $mod.THelper.Run;',
21172     '  };',
21173     '  this.Glide = function (w) {',
21174     '    $mod.g = rtl.createCallback(this, $mod.THelper.Glide);',
21175     '    $mod.r = $mod.THelper.Run;',
21176     '  };',
21177     '  this.Run = function (w) {',
21178     '    $mod.g = rtl.createCallback($mod.THelper, $mod.THelper.Glide);',
21179     '    $mod.r = $mod.THelper.Run;',
21180     '  };',
21181     '});',
21182     'this.f = null;',
21183     'this.g = null;',
21184     'this.r = null;',
21185     'this.Obj = null;',
21186     '']),
21187     LinesToStr([ // $mod.$main
21188     '$mod.f = rtl.createCallback($mod.Obj, $mod.THelper.Fly);',
21189     '$mod.g = rtl.createCallback($mod.Obj.$class, $mod.THelper.Glide);',
21190     '$mod.r = $mod.THelper.Run;',
21191     'var $with = $mod.Obj;',
21192     '$mod.f = rtl.createCallback($with, $mod.THelper.Fly);',
21193     '$mod.g = rtl.createCallback($with.$class, $mod.THelper.Glide);',
21194     '$mod.r = $mod.THelper.Run;',
21195     '$mod.g = rtl.createCallback($mod.TObject, $mod.THelper.Glide);',
21196     '$mod.r = $mod.THelper.Run;',
21197     'var $with1 = $mod.TObject;',
21198     '$mod.g = rtl.createCallback($with1, $mod.THelper.Glide);',
21199     '$mod.r = $mod.THelper.Run;',
21200     '']));
21201 end;
21202 
21203 procedure TTestModule.TestClassHelper_Constructor;
21204 begin
21205   StartProgram(false);
21206   Add([
21207   'type',
21208   '  TObject = class',
21209   '    constructor Create;',
21210   '  end;',
21211   '  TClass = class of TObject;',
21212   '  THelper = class helper for TObject',
21213   '    constructor NewHlp(w: word);',
21214   '  end;',
21215   'var',
21216   '  obj: TObject;',
21217   '  c: TClass;',
21218   'constructor TObject.Create;',
21219   'begin',
21220   '  NewHlp(2);', // normal call
21221   '  tobject.NewHlp(3);', // new instance
21222   '  c.newhlp(4);', // new instance
21223   'end;',
21224   'constructor THelper.NewHlp(w: word);',
21225   'begin',
21226   '  create;', // normal call
21227   '  tobject.create;', // new instance
21228   '  NewHlp(2);', // normal call
21229   '  tobject.NewHlp(3);', // new instance
21230   '  c.newhlp(4);', // new instance
21231   'end;',
21232   'begin',
21233   '  obj.newhlp(2);', // normal call
21234   '  with Obj do newhlp(12);', // normal call
21235   '  tobject.newhlp(3);', // new instance
21236   '  with tobject do newhlp(13);', // new instance
21237   '  c.newhlp(4);', // new instance
21238   '  with c do newhlp(14);', // new instance
21239   '']);
21240   ConvertProgram;
21241   CheckSource('TestClassHelper_Constructor',
21242     LinesToStr([ // statements
21243     'rtl.createClass($mod, "TObject", null, function () {',
21244     '  this.$init = function () {',
21245     '  };',
21246     '  this.$final = function () {',
21247     '  };',
21248     '  this.Create = function () {',
21249     '    $mod.THelper.NewHlp.call(this, 2);',
21250     '    $mod.TObject.$create($mod.THelper.NewHlp, [3]);',
21251     '    $mod.c.$create($mod.THelper.NewHlp, [4]);',
21252     '    return this;',
21253     '  };',
21254     '});',
21255     'rtl.createHelper($mod, "THelper", null, function () {',
21256     '  this.NewHlp = function (w) {',
21257     '    this.Create();',
21258     '    $mod.TObject.$create("Create");',
21259     '    $mod.THelper.NewHlp.call(this, 2);',
21260     '    $mod.TObject.$create($mod.THelper.NewHlp, [3]);',
21261     '    $mod.c.$create($mod.THelper.NewHlp, [4]);',
21262     '    return this;',
21263     '  };',
21264     '});',
21265     'this.obj = null;',
21266     'this.c = null;',
21267     '']),
21268     LinesToStr([ // $mod.$main
21269     '$mod.THelper.NewHlp.call($mod.obj, 2);',
21270     'var $with = $mod.obj;',
21271     '$mod.THelper.NewHlp.call($with, 12);',
21272     '$mod.TObject.$create($mod.THelper.NewHlp, [3]);',
21273     'var $with1 = $mod.TObject;',
21274     '$with1.$create($mod.THelper.NewHlp, [13]);',
21275     '$mod.c.$create($mod.THelper.NewHlp, [4]);',
21276     'var $with2 = $mod.c;',
21277     '$with2.$create($mod.THelper.NewHlp, [14]);',
21278     '']));
21279 end;
21280 
21281 procedure TTestModule.TestClassHelper_InheritedObjFPC;
21282 begin
21283   StartProgram(false);
21284   Add([
21285   'type',
21286   '  TObject = class',
21287   '    procedure Fly;',
21288   '  end;',
21289   '  TObjHelper = class helper for TObject',
21290   '    procedure Fly;',
21291   '  end;',
21292   '  TBird = class',
21293   '    procedure Fly;',
21294   '  end;',
21295   '  TBirdHelper = class helper for TBird',
21296   '    procedure Fly;',
21297   '    procedure Walk(w: word);',
21298   '  end;',
21299   '  TEagleHelper = class helper(TBirdHelper) for TBird',
21300   '    procedure Fly;',
21301   '    procedure Walk(w: word);',
21302   '  end;',
21303   'procedure Tobject.fly;',
21304   'begin',
21305   '  inherited;', // ignore
21306   'end;',
21307   'procedure Tobjhelper.fly;',
21308   'begin',
21309   '  {@TObject_Fly}inherited;',
21310   '  inherited {@TObject_Fly}Fly;',
21311   'end;',
21312   'procedure Tbird.fly;',
21313   'begin',
21314   '  {@TObjHelper_Fly}inherited;',
21315   '  inherited {@TObjHelper_Fly}Fly;',
21316   'end;',
21317   'procedure Tbirdhelper.fly;',
21318   'begin',
21319   '  {@TBird_Fly}inherited;',
21320   '  inherited {@TBird_Fly}Fly;',
21321   'end;',
21322   'procedure Tbirdhelper.walk(w: word);',
21323   'begin',
21324   'end;',
21325   'procedure teagleHelper.fly;',
21326   'begin',
21327   '  {@TBird_Fly}inherited;',
21328   '  inherited {@TBird_Fly}Fly;',
21329   'end;',
21330   'procedure teagleHelper.walk(w: word);',
21331   'begin',
21332   '  {@TBirdHelper_Walk}inherited;',
21333   '  inherited {@TBirdHelper_Walk}Walk(3);',
21334   'end;',
21335   'begin',
21336   '']);
21337   ConvertProgram;
21338   CheckSource('TestClassHelper_InheritedObjFPC',
21339     LinesToStr([ // statements
21340     'rtl.createClass($mod, "TObject", null, function () {',
21341     '  this.$init = function () {',
21342     '  };',
21343     '  this.$final = function () {',
21344     '  };',
21345     '  this.Fly = function () {',
21346     '  };',
21347     '});',
21348     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21349     '  this.Fly = function () {',
21350     '    $mod.TObject.Fly.call(this);',
21351     '    $mod.TObject.Fly.call(this);',
21352     '  };',
21353     '});',
21354     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
21355     '  this.Fly$1 = function () {',
21356     '    $mod.TObjHelper.Fly.call(this);',
21357     '    $mod.TObjHelper.Fly.call(this);',
21358     '  };',
21359     '});',
21360     'rtl.createHelper($mod, "TBirdHelper", null, function () {',
21361     '  this.Fly = function () {',
21362     '    $mod.TBird.Fly$1.call(this);',
21363     '    $mod.TBird.Fly$1.call(this);',
21364     '  };',
21365     '  this.Walk = function (w) {',
21366     '  };',
21367     '});',
21368     'rtl.createHelper($mod, "TEagleHelper", $mod.TBirdHelper, function () {',
21369     '  this.Fly$1 = function () {',
21370     '    $mod.TBird.Fly$1.call(this);',
21371     '    $mod.TBird.Fly$1.call(this);',
21372     '  };',
21373     '  this.Walk$1 = function (w) {',
21374     '    $mod.TBirdHelper.Walk.apply(this, arguments);',
21375     '    $mod.TBirdHelper.Walk.call(this, 3);',
21376     '  };',
21377     '});',
21378     '']),
21379     LinesToStr([ // $mod.$main
21380     '']));
21381 end;
21382 
21383 procedure TTestModule.TestClassHelper_Property;
21384 begin
21385   StartProgram(false);
21386   Add([
21387   'type',
21388   '  TObject = class',
21389   '    FSize: word;',
21390   '    function GetSpeed: word;',
21391   '    procedure SetSpeed(Value: word);',
21392   '  end;',
21393   '  TObjHelper = class helper for TObject',
21394   '    function GetLeft: word;',
21395   '    procedure SetLeft(Value: word);',
21396   '    property Size: word read FSize write FSize;',
21397   '    property Speed: word read GetSpeed write SetSpeed;',
21398   '    property Left: word read GetLeft write SetLeft;',
21399   '  end;',
21400   '  TBird = class',
21401   '    property NotRight: word read GetLeft write SetLeft;',
21402   '    procedure DoIt;',
21403   '  end;',
21404   'var',
21405   '  b: TBird;',
21406   'function Tobject.GetSpeed: word;',
21407   'begin',
21408   '  Size:=Size+11;',
21409   '  Speed:=Speed+12;',
21410   '  Result:=Left+13;',
21411   '  Left:=13;',
21412   '  Left:=Left+13;',
21413   '  Self.Size:=Self.Size+21;',
21414   '  Self.Speed:=Self.Speed+22;',
21415   '  Self.Left:=Self.Left+23;',
21416   '  with Self do begin',
21417   '    Size:=Size+31;',
21418   '    Speed:=Speed+32;',
21419   '    Left:=Left+33;',
21420   '  end;',
21421   'end;',
21422   'procedure Tobject.SetSpeed(Value: word);',
21423   'begin',
21424   'end;',
21425   'function TObjHelper.GetLeft: word;',
21426   'begin',
21427   '  Size:=Size+11;',
21428   '  Speed:=Speed+12;',
21429   '  Left:=Left+13;',
21430   '  Self.Size:=Self.Size+21;',
21431   '  Self.Speed:=Self.Speed+22;',
21432   '  Self.Left:=Self.Left+23;',
21433   '  with Self do begin',
21434   '    Size:=Size+31;',
21435   '    Speed:=Speed+32;',
21436   '    Left:=Left+33;',
21437   '  end;',
21438   'end;',
21439   'procedure TObjHelper.SetLeft(Value: word);',
21440   'begin',
21441   'end;',
21442   'procedure TBird.DoIt;',
21443   'begin',
21444   '  NotRight:=NotRight+11;',
21445   '  Self.NotRight:=Self.NotRight+21;',
21446   '  with Self do begin',
21447   '    NotRight:=NotRight+31;',
21448   '  end;',
21449   'end;',
21450   'begin',
21451   '  b.Size:=b.Size+11;',
21452   '  b.Speed:=b.Speed+12;',
21453   '  b.Left:=b.Left+13;',
21454   '  b.NotRight:=b.NotRight+14;',
21455   '  with b do begin',
21456   '    Size:=Size+31;',
21457   '    Speed:=Speed+32;',
21458   '    Left:=Left+33;',
21459   '    NotRight:=NotRight+34;',
21460   '  end;',
21461   '']);
21462   ConvertProgram;
21463   CheckSource('TestClassHelper_Property',
21464     LinesToStr([ // statements
21465     'rtl.createClass($mod, "TObject", null, function () {',
21466     '  this.$init = function () {',
21467     '    this.FSize = 0;',
21468     '  };',
21469     '  this.$final = function () {',
21470     '  };',
21471     '  this.GetSpeed = function () {',
21472     '    var Result = 0;',
21473     '    this.FSize = this.FSize + 11;',
21474     '    this.SetSpeed(this.GetSpeed() + 12);',
21475     '    Result = $mod.TObjHelper.GetLeft.call(this) + 13;',
21476     '    $mod.TObjHelper.SetLeft.call(this, 13);',
21477     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 13);',
21478     '    this.FSize = this.FSize + 21;',
21479     '    this.SetSpeed(this.GetSpeed() + 22);',
21480     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 23);',
21481     '    this.FSize = this.FSize + 31;',
21482     '    this.SetSpeed(this.GetSpeed() + 32);',
21483     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 33);',
21484     '    return Result;',
21485     '  };',
21486     '  this.SetSpeed = function (Value) {',
21487     '  };',
21488     '});',
21489     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21490     '  this.GetLeft = function () {',
21491     '    var Result = 0;',
21492     '    this.FSize = this.FSize + 11;',
21493     '    this.SetSpeed(this.GetSpeed() + 12);',
21494     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 13);',
21495     '    this.FSize = this.FSize + 21;',
21496     '    this.SetSpeed(this.GetSpeed() + 22);',
21497     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 23);',
21498     '    this.FSize = this.FSize + 31;',
21499     '    this.SetSpeed(this.GetSpeed() + 32);',
21500     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 33);',
21501     '    return Result;',
21502     '  };',
21503     '  this.SetLeft = function (Value) {',
21504     '  };',
21505     '});',
21506     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
21507     '  this.DoIt = function () {',
21508     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 11);',
21509     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 21);',
21510     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 31);',
21511     '  };',
21512     '});',
21513     'this.b = null;',
21514     '']),
21515     LinesToStr([ // $mod.$main
21516     '$mod.b.FSize = $mod.b.FSize + 11;',
21517     '$mod.b.SetSpeed($mod.b.GetSpeed() + 12);',
21518     '$mod.TObjHelper.SetLeft.call($mod.b, $mod.TObjHelper.GetLeft.call($mod.b) + 13);',
21519     '$mod.TObjHelper.SetLeft.call($mod.b, $mod.TObjHelper.GetLeft.call($mod.b) + 14);',
21520     'var $with = $mod.b;',
21521     '$with.FSize = $with.FSize + 31;',
21522     '$with.SetSpeed($with.GetSpeed() + 32);',
21523     '$mod.TObjHelper.SetLeft.call($with, $mod.TObjHelper.GetLeft.call($with) + 33);',
21524     '$mod.TObjHelper.SetLeft.call($with, $mod.TObjHelper.GetLeft.call($with) + 34);',
21525     '']));
21526 end;
21527 
21528 procedure TTestModule.TestClassHelper_Property_Array;
21529 begin
21530   StartProgram(false);
21531   Add([
21532   'type',
21533   '  TObject = class',
21534   '    function GetSpeed(Index: boolean): word;',
21535   '    procedure SetSpeed(Index: boolean; Value: word);',
21536   '  end;',
21537   '  TObjHelper = class helper for TObject',
21538   '    function GetSize(Index: boolean): word;',
21539   '    procedure SetSize(Index: boolean; Value: word);',
21540   '    property Size[Index: boolean]: word read GetSize write SetSize;',
21541   '    property Speed[Index: boolean]: word read GetSpeed write SetSpeed;',
21542   '  end;',
21543   '  TBird = class',
21544   '    property Items[Index: boolean]: word read GetSize write SetSize;',
21545   '    procedure DoIt;',
21546   '  end;',
21547   'var',
21548   '  b: TBird;',
21549   'function Tobject.GetSpeed(Index: boolean): word;',
21550   'begin',
21551   '  Result:=Size[false];',
21552   '  Size[true]:=Size[false]+11;',
21553   '  Speed[true]:=Speed[false]+12;',
21554   '  Self.Size[true]:=Self.Size[false]+21;',
21555   '  Self.Speed[true]:=Self.Speed[false]+22;',
21556   '  with Self do begin',
21557   '    Size[true]:=Size[false]+31;',
21558   '    Speed[true]:=Speed[false]+32;',
21559   '  end;',
21560   'end;',
21561   'procedure Tobject.SetSpeed(Index: boolean; Value: word);',
21562   'begin',
21563   'end;',
21564   'function TObjHelper.GetSize(Index: boolean): word;',
21565   'begin',
21566   '  Size[true]:=Size[false]+11;',
21567   '  Speed[true]:=Speed[false]+12;',
21568   '  Self.Size[true]:=Self.Size[false]+21;',
21569   '  Self.Speed[true]:=Self.Speed[false]+22;',
21570   '  with Self do begin',
21571   '    Size[true]:=Size[false]+31;',
21572   '    Speed[true]:=Speed[false]+32;',
21573   '  end;',
21574   'end;',
21575   'procedure TObjHelper.SetSize(Index: boolean; Value: word);',
21576   'begin',
21577   'end;',
21578   'procedure TBird.DoIt;',
21579   'begin',
21580   '  Items[true]:=Items[false]+11;',
21581   '  Self.Items[true]:=Self.Items[false]+21;',
21582   '  with Self do Items[true]:=Items[false]+31;',
21583   'end;',
21584   'begin',
21585   '  b.Size[true]:=b.Size[false]+11;',
21586   '  b.Speed[true]:=b.Speed[false]+12;',
21587   '  b.Items[true]:=b.Items[false]+13;',
21588   '  with b do begin',
21589   '    Size[true]:=Size[false]+21;',
21590   '    Speed[true]:=Speed[false]+22;',
21591   '    Items[true]:=Items[false]+23;',
21592   '  end;',
21593   '']);
21594   ConvertProgram;
21595   CheckSource('TestClassHelper_Property_Array',
21596     LinesToStr([ // statements
21597     'rtl.createClass($mod, "TObject", null, function () {',
21598     '  this.$init = function () {',
21599     '  };',
21600     '  this.$final = function () {',
21601     '  };',
21602     '  this.GetSpeed = function (Index) {',
21603     '    var Result = 0;',
21604     '    Result = $mod.TObjHelper.GetSize.call(this, false);',
21605     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
21606     '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
21607     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
21608     '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
21609     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
21610     '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
21611     '    return Result;',
21612     '  };',
21613     '  this.SetSpeed = function (Index, Value) {',
21614     '  };',
21615     '});',
21616     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21617     '  this.GetSize = function (Index) {',
21618     '    var Result = 0;',
21619     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
21620     '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
21621     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
21622     '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
21623     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
21624     '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
21625     '    return Result;',
21626     '  };',
21627     '  this.SetSize = function (Index, Value) {',
21628     '  };',
21629     '});',
21630     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
21631     '  this.DoIt = function () {',
21632     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
21633     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
21634     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
21635     '  };',
21636     '});',
21637     'this.b = null;',
21638     '']),
21639     LinesToStr([ // $mod.$main
21640     '$mod.TObjHelper.SetSize.call($mod.b, true, $mod.TObjHelper.GetSize.call($mod.b, false) + 11);',
21641     '$mod.b.SetSpeed(true, $mod.b.GetSpeed(false) + 12);',
21642     '$mod.TObjHelper.SetSize.call($mod.b, true, $mod.TObjHelper.GetSize.call($mod.b, false) + 13);',
21643     'var $with = $mod.b;',
21644     '$mod.TObjHelper.SetSize.call($with, true, $mod.TObjHelper.GetSize.call($with, false) + 21);',
21645     '$with.SetSpeed(true, $with.GetSpeed(false) + 22);',
21646     '$mod.TObjHelper.SetSize.call($with, true, $mod.TObjHelper.GetSize.call($with, false) + 23);',
21647     '']));
21648 end;
21649 
21650 procedure TTestModule.TestClassHelper_Property_Array_Default;
21651 begin
21652   StartProgram(false);
21653   Add([
21654   'type',
21655   '  TObject = class',
21656   '    function GetSpeed(Index: boolean): word;',
21657   '    procedure SetSpeed(Index: boolean; Value: word);',
21658   '  end;',
21659   '  TObjHelper = class helper for TObject',
21660   '    property Speed[Index: boolean]: word read GetSpeed write SetSpeed; default;',
21661   '  end;',
21662   '  TBird = class',
21663   '  end;',
21664   '  TBirdHelper = class helper for TBird',
21665   '    function GetSize(Index: word): boolean;',
21666   '    procedure SetSize(Index: word; Value: boolean);',
21667   '    property Size[Index: word]: boolean read GetSize write SetSize; default;',
21668   '  end;',
21669   'function Tobject.GetSpeed(Index: boolean): word;',
21670   'begin',
21671   '  Self[true]:=Self[false]+1;',
21672   'end;',
21673   'procedure Tobject.SetSpeed(Index: boolean; Value: word);',
21674   'begin',
21675   'end;',
21676   'function TBirdHelper.GetSize(Index: word): boolean;',
21677   'begin',
21678   '  Self[1]:=not Self[2];',
21679   'end;',
21680   'procedure TBirdHelper.SetSize(Index: word; Value: boolean);',
21681   'begin',
21682   'end;',
21683   'var',
21684   '  o: TObject;',
21685   '  b: TBird;',
21686   'begin',
21687   '  o[true]:=o[false]+1;',
21688   '  b[3]:=not b[4];',
21689   '']);
21690   ConvertProgram;
21691   CheckSource('TestClassHelper_Property_Array_Default',
21692     LinesToStr([ // statements
21693     'rtl.createClass($mod, "TObject", null, function () {',
21694     '  this.$init = function () {',
21695     '  };',
21696     '  this.$final = function () {',
21697     '  };',
21698     '  this.GetSpeed = function (Index) {',
21699     '    var Result = 0;',
21700     '    this.SetSpeed(true, this.GetSpeed(false) + 1);',
21701     '    return Result;',
21702     '  };',
21703     '  this.SetSpeed = function (Index, Value) {',
21704     '  };',
21705     '});',
21706     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21707     '});',
21708     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
21709     '});',
21710     'rtl.createHelper($mod, "TBirdHelper", null, function () {',
21711     '  this.GetSize = function (Index) {',
21712     '    var Result = false;',
21713     '    $mod.TBirdHelper.SetSize.call(this, 1, !$mod.TBirdHelper.GetSize.call(this, 2));',
21714     '    return Result;',
21715     '  };',
21716     '  this.SetSize = function (Index, Value) {',
21717     '  };',
21718     '});',
21719     'this.o = null;',
21720     'this.b = null;',
21721     '']),
21722     LinesToStr([ // $mod.$main
21723     '$mod.o.SetSpeed(true, $mod.o.GetSpeed(false) + 1);',
21724     '$mod.TBirdHelper.SetSize.call($mod.b, 3, !$mod.TBirdHelper.GetSize.call($mod.b, 4));',
21725     '']));
21726 end;
21727 
21728 procedure TTestModule.TestClassHelper_Property_Array_DefaultDefault;
21729 begin
21730   StartProgram(false);
21731   Add([
21732   'type',
21733   '  TObject = class',
21734   '  end;',
21735   '  TObjHelper = class helper for TObject',
21736   '    function GetItems(Index: word): TObject;',
21737   '    procedure SetItems(Index: word; Value: TObject);',
21738   '    property Items[Index: word]: TObject read GetItems write SetItems; default;',
21739   '  end;',
21740   'function Tobjhelper.GetItems(Index: word): TObject;',
21741   'begin',
21742   '  Self[1][2]:=Self[3][4];',
21743   'end;',
21744   'procedure Tobjhelper.SetItems(Index: word; Value: TObject);',
21745   'begin',
21746   'end;',
21747   'var',
21748   '  o: TObject;',
21749   'begin',
21750   '  o[1][2]:=o[3][4];',
21751   '']);
21752   ConvertProgram;
21753   CheckSource('TestClassHelper_Property_Array_DefaultDefault',
21754     LinesToStr([ // statements
21755     'rtl.createClass($mod, "TObject", null, function () {',
21756     '  this.$init = function () {',
21757     '  };',
21758     '  this.$final = function () {',
21759     '  };',
21760     '});',
21761     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21762     '  this.GetItems = function (Index) {',
21763     '    var Result = null;',
21764     '    $mod.TObjHelper.SetItems.call($mod.TObjHelper.GetItems.call(this, 1), 2, $mod.TObjHelper.GetItems.call($mod.TObjHelper.GetItems.call(this, 3), 4));',
21765     '    return Result;',
21766     '  };',
21767     '  this.SetItems = function (Index, Value) {',
21768     '  };',
21769     '});',
21770     'this.o = null;',
21771     '']),
21772     LinesToStr([ // $mod.$main
21773     '$mod.TObjHelper.SetItems.call($mod.TObjHelper.GetItems.call($mod.o, 1), 2, $mod.TObjHelper.GetItems.call($mod.TObjHelper.GetItems.call($mod.o, 3), 4));',
21774     '']));
21775 end;
21776 
21777 procedure TTestModule.TestClassHelper_ClassProperty;
21778 begin
21779   StartProgram(false);
21780   Add([
21781   'type',
21782   '  TObject = class',
21783   '    class var FSize: word;',
21784   '    class function GetSpeed: word;',
21785   '    class procedure SetSpeed(Value: word); virtual; abstract;',
21786   '  end;',
21787   '  TObjHelper = class helper for TObject',
21788   '    class function GetLeft: word;',
21789   '    class procedure SetLeft(Value: word);',
21790   '    class property Size: word read FSize write FSize;',
21791   '    class property Speed: word read GetSpeed write SetSpeed;',
21792   '    class property Left: word read GetLeft write SetLeft;',
21793   '  end;',
21794   '  TBird = class',
21795   '    class property NotRight: word read GetLeft write SetLeft;',
21796   '    class procedure DoIt;',
21797   '  end;',
21798   '  TBirdClass = class of TBird;',
21799   'class function Tobject.GetSpeed: word;',
21800   'begin',
21801   '  Size:=Size+11;',
21802   '  Speed:=Speed+12;',
21803   '  Left:=Left+13;',
21804   '  Self.Size:=Self.Size+21;',
21805   '  Self.Speed:=Self.Speed+22;',
21806   '  Self.Left:=Self.Left+23;',
21807   '  with Self do begin',
21808   '    Size:=Size+31;',
21809   '    Speed:=Speed+32;',
21810   '    Left:=Left+33;',
21811   '  end;',
21812   'end;',
21813   'class function TObjHelper.GetLeft: word;',
21814   'begin',
21815   '  Size:=Size+11;',
21816   '  Speed:=Speed+12;',
21817   '  Left:=Left+13;',
21818   '  Self.Size:=Self.Size+21;',
21819   '  Self.Speed:=Self.Speed+22;',
21820   '  Self.Left:=Self.Left+23;',
21821   '  with Self do begin',
21822   '    Size:=Size+31;',
21823   '    Speed:=Speed+32;',
21824   '    Left:=Left+33;',
21825   '  end;',
21826   'end;',
21827   'class procedure TObjHelper.SetLeft(Value: word);',
21828   'begin',
21829   'end;',
21830   'class procedure TBird.DoIt;',
21831   'begin',
21832   '  NotRight:=NotRight+11;',
21833   '  Self.NotRight:=Self.NotRight+21;',
21834   '  with Self do NotRight:=NotRight+31;',
21835   'end;',
21836   'var',
21837   '  b: TBird;',
21838   '  c: TBirdClass;',
21839   'begin',
21840   '  b.Size:=b.Size+11;',
21841   '  b.Speed:=b.Speed+12;',
21842   '  b.Left:=b.Left+13;',
21843   '  b.NotRight:=b.NotRight+14;',
21844   '  with b do begin',
21845   '    Size:=Size+31;',
21846   '    Speed:=Speed+32;',
21847   '    Left:=Left+33;',
21848   '    NotRight:=NotRight+34;',
21849   '  end;',
21850   '  c.Size:=c.Size+11;',
21851   '  c.Speed:=c.Speed+12;',
21852   '  c.Left:=c.Left+13;',
21853   '  c.NotRight:=c.NotRight+14;',
21854   '  with c do begin',
21855   '    Size:=Size+31;',
21856   '    Speed:=Speed+32;',
21857   '    Left:=Left+33;',
21858   '    NotRight:=NotRight+34;',
21859   '  end;',
21860   '  tbird.Size:=tbird.Size+11;',
21861   '  tbird.Speed:=tbird.Speed+12;',
21862   '  tbird.Left:=tbird.Left+13;',
21863   '  tbird.NotRight:=tbird.NotRight+14;',
21864   '  with tbird do begin',
21865   '    Size:=Size+31;',
21866   '    Speed:=Speed+32;',
21867   '    Left:=Left+33;',
21868   '    NotRight:=NotRight+34;',
21869   '  end;',
21870   '']);
21871   ConvertProgram;
21872   CheckSource('TestClassHelper_ClassProperty',
21873     LinesToStr([ // statements
21874     'rtl.createClass($mod, "TObject", null, function () {',
21875     '  this.FSize = 0;',
21876     '  this.$init = function () {',
21877     '  };',
21878     '  this.$final = function () {',
21879     '  };',
21880     '  this.GetSpeed = function () {',
21881     '    var Result = 0;',
21882     '    $mod.TObject.FSize = this.FSize + 11;',
21883     '    this.SetSpeed(this.GetSpeed() + 12);',
21884     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 13);',
21885     '    $mod.TObject.FSize = this.FSize + 21;',
21886     '    this.SetSpeed(this.GetSpeed() + 22);',
21887     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 23);',
21888     '    $mod.TObject.FSize = this.FSize + 31;',
21889     '    this.SetSpeed(this.GetSpeed() + 32);',
21890     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 33);',
21891     '    return Result;',
21892     '  };',
21893     '});',
21894     'rtl.createHelper($mod, "TObjHelper", null, function () {',
21895     '  this.GetLeft = function () {',
21896     '    var Result = 0;',
21897     '    $mod.TObject.FSize = this.FSize + 11;',
21898     '    this.SetSpeed(this.GetSpeed() + 12);',
21899     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 13);',
21900     '    $mod.TObject.FSize = this.FSize + 21;',
21901     '    this.SetSpeed(this.GetSpeed() + 22);',
21902     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 23);',
21903     '    $mod.TObject.FSize = this.FSize + 31;',
21904     '    this.SetSpeed(this.GetSpeed() + 32);',
21905     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 33);',
21906     '    return Result;',
21907     '  };',
21908     '  this.SetLeft = function (Value) {',
21909     '  };',
21910     '});',
21911     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
21912     '  this.DoIt = function () {',
21913     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 11);',
21914     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 21);',
21915     '    $mod.TObjHelper.SetLeft.call(this, $mod.TObjHelper.GetLeft.call(this) + 31);',
21916     '  };',
21917     '});',
21918     'this.b = null;',
21919     'this.c = null;',
21920     '']),
21921     LinesToStr([ // $mod.$main
21922     '$mod.TObject.FSize = $mod.b.FSize + 11;',
21923     '$mod.b.$class.SetSpeed($mod.b.$class.GetSpeed() + 12);',
21924     '$mod.TObjHelper.SetLeft.call($mod.b.$class, $mod.TObjHelper.GetLeft.call($mod.b.$class) + 13);',
21925     '$mod.TObjHelper.SetLeft.call($mod.b.$class, $mod.TObjHelper.GetLeft.call($mod.b.$class) + 14);',
21926     'var $with = $mod.b;',
21927     '$mod.TObject.FSize = $with.FSize + 31;',
21928     '$with.$class.SetSpeed($with.$class.GetSpeed() + 32);',
21929     '$mod.TObjHelper.SetLeft.call($with.$class, $mod.TObjHelper.GetLeft.call($with.$class) + 33);',
21930     '$mod.TObjHelper.SetLeft.call($with.$class, $mod.TObjHelper.GetLeft.call($with.$class) + 34);',
21931     '$mod.TObject.FSize = $mod.c.FSize + 11;',
21932     '$mod.c.SetSpeed($mod.c.GetSpeed() + 12);',
21933     '$mod.TObjHelper.SetLeft.call($mod.c, $mod.TObjHelper.GetLeft.call($mod.c) + 13);',
21934     '$mod.TObjHelper.SetLeft.call($mod.c, $mod.TObjHelper.GetLeft.call($mod.c) + 14);',
21935     'var $with1 = $mod.c;',
21936     '$mod.TObject.FSize = $with1.FSize + 31;',
21937     '$with1.SetSpeed($with1.GetSpeed() + 32);',
21938     '$mod.TObjHelper.SetLeft.call($with1, $mod.TObjHelper.GetLeft.call($with1) + 33);',
21939     '$mod.TObjHelper.SetLeft.call($with1, $mod.TObjHelper.GetLeft.call($with1) + 34);',
21940     '$mod.TObject.FSize = $mod.TBird.FSize + 11;',
21941     '$mod.TBird.SetSpeed($mod.TBird.GetSpeed() + 12);',
21942     '$mod.TObjHelper.SetLeft.call($mod.TBird, $mod.TObjHelper.GetLeft.call($mod.TBird) + 13);',
21943     '$mod.TObjHelper.SetLeft.call($mod.TBird, $mod.TObjHelper.GetLeft.call($mod.TBird) + 14);',
21944     'var $with2 = $mod.TBird;',
21945     '$mod.TObject.FSize = $with2.FSize + 31;',
21946     '$with2.SetSpeed($with2.GetSpeed() + 32);',
21947     '$mod.TObjHelper.SetLeft.call($mod.TBird, $mod.TObjHelper.GetLeft.call($mod.TBird) + 33);',
21948     '$mod.TObjHelper.SetLeft.call($mod.TBird, $mod.TObjHelper.GetLeft.call($mod.TBird) + 34);',
21949     '']));
21950 end;
21951 
21952 procedure TTestModule.TestClassHelper_ClassPropertyStatic;
21953 begin
21954   StartProgram(false);
21955   Add([
21956   'type',
21957   '  TObject = class',
21958   '    class function GetSpeed: word; static;',
21959   '    class procedure SetSpeed(Value: word); static;',
21960   '  end;',
21961   '  TObjHelper = class helper for TObject',
21962   '    class function GetLeft: word; static;',
21963   '    class procedure SetLeft(Value: word); static;',
21964   '    class property Speed: word read GetSpeed write SetSpeed;',
21965   '    class property Left: word read GetLeft write SetLeft;',
21966   '  end;',
21967   '  TBird = class',
21968   '    class property NotRight: word read GetLeft write SetLeft;',
21969   '    class procedure DoIt; static;',
21970   '    class procedure DoSome;',
21971   '  end;',
21972   '  TBirdClass = class of TBird;',
21973   'class function Tobject.GetSpeed: word;',
21974   'begin',
21975   '  Speed:=Speed+12;',
21976   '  Left:=Left+13;',
21977   'end;',
21978   'class procedure TObject.SetSpeed(Value: word);',
21979   'begin',
21980   'end;',
21981   'class function TObjHelper.GetLeft: word;',
21982   'begin',
21983   '  Speed:=Speed+12;',
21984   '  Left:=Left+13;',
21985   'end;',
21986   'class procedure TObjHelper.SetLeft(Value: word);',
21987   'begin',
21988   'end;',
21989   'class procedure TBird.DoIt;',
21990   'begin',
21991   '  NotRight:=NotRight+11;',
21992   'end;',
21993   'class procedure TBird.DoSome;',
21994   'begin',
21995   '  Speed:=Speed+12;',
21996   '  Left:=Left+13;',
21997   '  Self.Speed:=Self.Speed+22;',
21998   '  Self.Left:=Self.Left+23;',
21999   '  with Self do begin',
22000   '    Speed:=Speed+32;',
22001   '    Left:=Left+33;',
22002   '  end;',
22003   '  NotRight:=NotRight+11;',
22004   '  Self.NotRight:=Self.NotRight+21;',
22005   '  with Self do NotRight:=NotRight+31;',
22006   'end;',
22007   'var',
22008   '  b: TBird;',
22009   '  c: TBirdClass;',
22010   'begin',
22011   '  b.Speed:=b.Speed+12;',
22012   '  b.Left:=b.Left+13;',
22013   '  b.NotRight:=b.NotRight+14;',
22014   '  with b do begin',
22015   '    Speed:=Speed+32;',
22016   '    Left:=Left+33;',
22017   '    NotRight:=NotRight+34;',
22018   '  end;',
22019   '  c.Speed:=c.Speed+12;',
22020   '  c.Left:=c.Left+13;',
22021   '  c.NotRight:=c.NotRight+14;',
22022   '  with c do begin',
22023   '    Speed:=Speed+32;',
22024   '    Left:=Left+33;',
22025   '    NotRight:=NotRight+34;',
22026   '  end;',
22027   '  tbird.Speed:=tbird.Speed+12;',
22028   '  tbird.Left:=tbird.Left+13;',
22029   '  tbird.NotRight:=tbird.NotRight+14;',
22030   '  with tbird do begin',
22031   '    Speed:=Speed+32;',
22032   '    Left:=Left+33;',
22033   '    NotRight:=NotRight+34;',
22034   '  end;',
22035   '']);
22036   ConvertProgram;
22037   CheckSource('TestClassHelper_ClassPropertyStatic',
22038     LinesToStr([ // statements
22039     'rtl.createClass($mod, "TObject", null, function () {',
22040     '  this.$init = function () {',
22041     '  };',
22042     '  this.$final = function () {',
22043     '  };',
22044     '  this.GetSpeed = function () {',
22045     '    var Result = 0;',
22046     '    $mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
22047     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22048     '    return Result;',
22049     '  };',
22050     '  this.SetSpeed = function (Value) {',
22051     '  };',
22052     '});',
22053     'rtl.createHelper($mod, "TObjHelper", null, function () {',
22054     '  this.GetLeft = function () {',
22055     '    var Result = 0;',
22056     '    $mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
22057     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22058     '    return Result;',
22059     '  };',
22060     '  this.SetLeft = function (Value) {',
22061     '  };',
22062     '});',
22063     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
22064     '  this.DoIt = function () {',
22065     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 11);',
22066     '  };',
22067     '  this.DoSome = function () {',
22068     '    this.SetSpeed(this.GetSpeed() + 12);',
22069     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22070     '    this.SetSpeed(this.GetSpeed() + 22);',
22071     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 23);',
22072     '    this.SetSpeed(this.GetSpeed() + 32);',
22073     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
22074     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 11);',
22075     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 21);',
22076     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 31);',
22077     '  };',
22078     '});',
22079     'this.b = null;',
22080     'this.c = null;',
22081     '']),
22082     LinesToStr([ // $mod.$main
22083     '$mod.b.SetSpeed($mod.b.GetSpeed() + 12);',
22084     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22085     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
22086     'var $with = $mod.b;',
22087     '$with.SetSpeed($with.GetSpeed() + 32);',
22088     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
22089     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
22090     '$mod.c.SetSpeed($mod.c.GetSpeed() + 12);',
22091     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22092     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
22093     'var $with1 = $mod.c;',
22094     '$with1.SetSpeed($with1.GetSpeed() + 32);',
22095     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
22096     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
22097     '$mod.TBird.SetSpeed($mod.TBird.GetSpeed() + 12);',
22098     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
22099     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 14);',
22100     'var $with2 = $mod.TBird;',
22101     '$with2.SetSpeed($with2.GetSpeed() + 32);',
22102     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 33);',
22103     '$mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 34);',
22104     '']));
22105 end;
22106 
22107 procedure TTestModule.TestClassHelper_ClassProperty_Array;
22108 begin
22109   StartProgram(false);
22110   Add([
22111   'type',
22112   '  TObject = class',
22113   '    class function GetSpeed(Index: boolean): word;',
22114   '    class procedure SetSpeed(Index: boolean; Value: word); virtual; abstract;',
22115   '  end;',
22116   '  TObjHelper = class helper for TObject',
22117   '    class function GetSize(Index: boolean): word;',
22118   '    class procedure SetSize(Index: boolean; Value: word);',
22119   '    class property Size[Index: boolean]: word read GetSize write SetSize;',
22120   '    class property Speed[Index: boolean]: word read GetSpeed write SetSpeed;',
22121   '  end;',
22122   '  TBird = class',
22123   '    class property Items[Index: boolean]: word read GetSize write SetSize;',
22124   '    class procedure DoIt;',
22125   '  end;',
22126   '  TBirdClass = class of TBird;',
22127   'class function Tobject.GetSpeed(Index: boolean): word;',
22128   'begin',
22129   '  Size[true]:=Size[false]+11;',
22130   '  Speed[true]:=Speed[false]+12;',
22131   '  Self.Size[true]:=Self.Size[false]+21;',
22132   '  Self.Speed[true]:=Self.Speed[false]+22;',
22133   '  with Self do begin',
22134   '    Size[true]:=Size[false]+31;',
22135   '    Speed[true]:=Speed[false]+32;',
22136   '  end;',
22137   'end;',
22138   'class function TObjHelper.GetSize(Index: boolean): word;',
22139   'begin',
22140   '  Size[true]:=Size[false]+11;',
22141   '  Speed[true]:=Speed[false]+12;',
22142   '  Self.Size[true]:=Self.Size[false]+21;',
22143   '  Self.Speed[true]:=Self.Speed[false]+22;',
22144   '  with Self do begin',
22145   '    Size[true]:=Size[false]+31;',
22146   '    Speed[true]:=Speed[false]+32;',
22147   '  end;',
22148   'end;',
22149   'class procedure TObjHelper.SetSize(Index: boolean; Value: word);',
22150   'begin',
22151   'end;',
22152   'class procedure TBird.DoIt;',
22153   'begin',
22154   '  Items[true]:=Items[false]+11;',
22155   '  Self.Items[true]:=Self.Items[false]+21;',
22156   '  with Self do Items[true]:=Items[false]+31;',
22157   'end;',
22158   'var',
22159   '  b: TBird;',
22160   '  c: TBirdClass;',
22161   'begin',
22162   '  b.Size[true]:=b.Size[false]+11;',
22163   '  b.Speed[true]:=b.Speed[false]+12;',
22164   '  b.Items[true]:=b.Items[false]+13;',
22165   '  with b do begin',
22166   '    Size[true]:=Size[false]+21;',
22167   '    Speed[true]:=Speed[false]+22;',
22168   '    Items[true]:=Items[false]+23;',
22169   '  end;',
22170   '  c.Size[true]:=c.Size[false]+11;',
22171   '  c.Speed[true]:=c.Speed[false]+12;',
22172   '  c.Items[true]:=c.Items[false]+13;',
22173   '  with c do begin',
22174   '    Size[true]:=Size[false]+21;',
22175   '    Speed[true]:=Speed[false]+22;',
22176   '    Items[true]:=Items[false]+23;',
22177   '  end;',
22178   '  TBird.Size[true]:=TBird.Size[false]+11;',
22179   '  TBird.Speed[true]:=TBird.Speed[false]+12;',
22180   '  TBird.Items[true]:=TBird.Items[false]+13;',
22181   '  with TBird do begin',
22182   '    Size[true]:=Size[false]+21;',
22183   '    Speed[true]:=Speed[false]+22;',
22184   '    Items[true]:=Items[false]+23;',
22185   '  end;',
22186   '']);
22187   ConvertProgram;
22188   CheckSource('TestClassHelper_ClassProperty_Array',
22189     LinesToStr([ // statements
22190     'rtl.createClass($mod, "TObject", null, function () {',
22191     '  this.$init = function () {',
22192     '  };',
22193     '  this.$final = function () {',
22194     '  };',
22195     '  this.GetSpeed = function (Index) {',
22196     '    var Result = 0;',
22197     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
22198     '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
22199     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
22200     '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
22201     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
22202     '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
22203     '    return Result;',
22204     '  };',
22205     '});',
22206     'rtl.createHelper($mod, "TObjHelper", null, function () {',
22207     '  this.GetSize = function (Index) {',
22208     '    var Result = 0;',
22209     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
22210     '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
22211     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
22212     '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
22213     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
22214     '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
22215     '    return Result;',
22216     '  };',
22217     '  this.SetSize = function (Index, Value) {',
22218     '  };',
22219     '});',
22220     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
22221     '  this.DoIt = function () {',
22222     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 11);',
22223     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 21);',
22224     '    $mod.TObjHelper.SetSize.call(this, true, $mod.TObjHelper.GetSize.call(this, false) + 31);',
22225     '  };',
22226     '});',
22227     'this.b = null;',
22228     'this.c = null;',
22229     '']),
22230     LinesToStr([ // $mod.$main
22231     '$mod.TObjHelper.SetSize.call($mod.b.$class, true, $mod.TObjHelper.GetSize.call($mod.b.$class, false) + 11);',
22232     '$mod.b.$class.SetSpeed(true, $mod.b.$class.GetSpeed(false) + 12);',
22233     '$mod.TObjHelper.SetSize.call($mod.b.$class, true, $mod.TObjHelper.GetSize.call($mod.b.$class, false) + 13);',
22234     'var $with = $mod.b;',
22235     '$mod.TObjHelper.SetSize.call($with.$class, true, $mod.TObjHelper.GetSize.call($with.$class, false) + 21);',
22236     '$with.$class.SetSpeed(true, $with.$class.GetSpeed(false) + 22);',
22237     '$mod.TObjHelper.SetSize.call($with.$class, true, $mod.TObjHelper.GetSize.call($with.$class, false) + 23);',
22238     '$mod.TObjHelper.SetSize.call($mod.c, true, $mod.TObjHelper.GetSize.call($mod.c, false) + 11);',
22239     '$mod.c.SetSpeed(true, $mod.c.GetSpeed(false) + 12);',
22240     '$mod.TObjHelper.SetSize.call($mod.c, true, $mod.TObjHelper.GetSize.call($mod.c, false) + 13);',
22241     'var $with1 = $mod.c;',
22242     '$mod.TObjHelper.SetSize.call($with1, true, $mod.TObjHelper.GetSize.call($with1, false) + 21);',
22243     '$with1.SetSpeed(true, $with1.GetSpeed(false) + 22);',
22244     '$mod.TObjHelper.SetSize.call($with1, true, $mod.TObjHelper.GetSize.call($with1, false) + 23);',
22245     '$mod.TObjHelper.SetSize.call($mod.TBird, true, $mod.TObjHelper.GetSize.call($mod.TBird, false) + 11);',
22246     '$mod.TBird.SetSpeed(true, $mod.TBird.GetSpeed(false) + 12);',
22247     '$mod.TObjHelper.SetSize.call($mod.TBird, true, $mod.TObjHelper.GetSize.call($mod.TBird, false) + 13);',
22248     'var $with2 = $mod.TBird;',
22249     '$mod.TObjHelper.SetSize.call($mod.TBird, true, $mod.TObjHelper.GetSize.call($mod.TBird, false) + 21);',
22250     '$with2.SetSpeed(true, $with2.GetSpeed(false) + 22);',
22251     '$mod.TObjHelper.SetSize.call($mod.TBird, true, $mod.TObjHelper.GetSize.call($mod.TBird, false) + 23);',
22252     '']));
22253 end;
22254 
22255 procedure TTestModule.TestClassHelper_ForIn;
22256 begin
22257   StartProgram(false);
22258   Add([
22259   'type',
22260   '  TObject = class end;',
22261   '  TItem = TObject;',
22262   '  TEnumerator = class',
22263   '    FCurrent: TItem;',
22264   '    property Current: TItem read FCurrent;',
22265   '    function MoveNext: boolean;',
22266   '  end;',
22267   '  TBird = class',
22268   '  end;',
22269   '  TBirdHelper = class helper for TBird',
22270   '    function GetEnumerator: TEnumerator;',
22271   '  end;',
22272   'function TEnumerator.MoveNext: boolean;',
22273   'begin',
22274   'end;',
22275   'function TBirdHelper.GetEnumerator: TEnumerator;',
22276   'begin',
22277   'end;',
22278   'var',
22279   '  b: TBird;',
22280   '  i, i2: TItem;',
22281   'begin',
22282   '  for i in b do i2:=i;']);
22283   ConvertProgram;
22284   CheckSource('TestClassHelper_ForIn',
22285     LinesToStr([ // statements
22286     'rtl.createClass($mod, "TObject", null, function () {',
22287     '  this.$init = function () {',
22288     '  };',
22289     '  this.$final = function () {',
22290     '  };',
22291     '});',
22292     'rtl.createClass($mod, "TEnumerator", $mod.TObject, function () {',
22293     '  this.$init = function () {',
22294     '    $mod.TObject.$init.call(this);',
22295     '    this.FCurrent = null;',
22296     '  };',
22297     '  this.$final = function () {',
22298     '    this.FCurrent = undefined;',
22299     '    $mod.TObject.$final.call(this);',
22300     '  };',
22301     '  this.MoveNext = function () {',
22302     '    var Result = false;',
22303     '    return Result;',
22304     '  };',
22305     '});',
22306     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
22307     '});',
22308     'rtl.createHelper($mod, "TBirdHelper", null, function () {',
22309     '  this.GetEnumerator = function () {',
22310     '    var Result = null;',
22311     '    return Result;',
22312     '  };',
22313     '});',
22314     'this.b = null;',
22315     'this.i = null;',
22316     'this.i2 = null;'
22317     ]),
22318     LinesToStr([ // $mod.$main
22319     'var $in = $mod.TBirdHelper.GetEnumerator.call($mod.b);',
22320     'try {',
22321     '  while ($in.MoveNext()){',
22322     '    $mod.i = $in.FCurrent;',
22323     '    $mod.i2 = $mod.i;',
22324     '  }',
22325     '} finally {',
22326     '  $in = rtl.freeLoc($in)',
22327     '};',
22328     '']));
22329 end;
22330 
22331 procedure TTestModule.TestClassHelper_PassProperty;
22332 begin
22333   StartProgram(false);
22334   Add([
22335   'type',
22336   '  TObject = class',
22337   '    FField: TObject;',
22338   '    property Field: TObject read FField write FField;',
22339   '  end;',
22340   '  THelper = class helper for TObject',
22341   '    procedure Fly;',
22342   '    class procedure Run;',
22343   '    class procedure Jump; static;',
22344   '  end;',
22345   'procedure THelper.Fly;',
22346   'begin',
22347   '  Field.Fly;',
22348   '  Field.Run;',
22349   '  Field.Jump;',
22350   '  with Field do begin',
22351   '    Fly;',
22352   '    Run;',
22353   '    Jump;',
22354   '  end;',
22355   'end;',
22356   'class procedure THelper.Run;',
22357   'begin',
22358   'end;',
22359   'class procedure THelper.Jump;',
22360   'begin',
22361   'end;',
22362   'var',
22363   '  b: TObject;',
22364   'begin',
22365   '  b.Field.Fly;',
22366   '  b.Field.Run;',
22367   '  b.Field.Jump;',
22368   '  with b do begin',
22369   '    Field.Run;',
22370   '    Field.Fly;',
22371   '    Field.Jump;',
22372   '  end;',
22373   '  with b.Field do begin',
22374   '    Run;',
22375   '    Fly;',
22376   '    Jump;',
22377   '  end;',
22378   '']);
22379   ConvertProgram;
22380   CheckSource('TestClassHelper_PassProperty',
22381     LinesToStr([ // statements
22382     'rtl.createClass($mod, "TObject", null, function () {',
22383     '  this.$init = function () {',
22384     '    this.FField = null;',
22385     '  };',
22386     '  this.$final = function () {',
22387     '    this.FField = undefined;',
22388     '  };',
22389     '});',
22390     'rtl.createHelper($mod, "THelper", null, function () {',
22391     '  this.Fly = function () {',
22392     '    $mod.THelper.Fly.call(this.FField);',
22393     '    $mod.THelper.Run.call(this.FField.$class);',
22394     '    $mod.THelper.Jump();',
22395     '    var $with = this.FField;',
22396     '    $mod.THelper.Fly.call($with);',
22397     '    $mod.THelper.Run.call($with.$class);',
22398     '    $mod.THelper.Jump();',
22399     '  };',
22400     '  this.Run = function () {',
22401     '  };',
22402     '  this.Jump = function () {',
22403     '  };',
22404     '});',
22405     'this.b = null;',
22406     '']),
22407     LinesToStr([ // $mod.$main
22408     '$mod.THelper.Fly.call($mod.b.FField);',
22409     '$mod.THelper.Run.call($mod.b.FField.$class);',
22410     '$mod.THelper.Jump();',
22411     'var $with = $mod.b;',
22412     '$mod.THelper.Run.call($with.FField.$class);',
22413     '$mod.THelper.Fly.call($with.FField);',
22414     '$mod.THelper.Jump();',
22415     'var $with1 = $mod.b.FField;',
22416     '$mod.THelper.Run.call($with1.$class);',
22417     '$mod.THelper.Fly.call($with1);',
22418     '$mod.THelper.Jump();',
22419     '']));
22420 end;
22421 
22422 procedure TTestModule.TestExtClassHelper_ClassVar;
22423 begin
22424   StartProgram(false);
22425   Add([
22426   '{$modeswitch externalclass}',
22427   'type',
22428   '  TExtA = class external name ''ExtObj''',
22429   '  end;',
22430   '  THelper = class helper for TExtA',
22431   '    const',
22432   '      One = 1;',
22433   '      Two: word = 2;',
22434   '    class var',
22435   '      Glob: word;',
22436   '    function Foo(w: word): word;',
22437   '    class function Bar(w: word): word; static;',
22438   '  end;',
22439   'function THelper.foo(w: word): word;',
22440   'begin',
22441   '  Result:=w;',
22442   '  Two:=One+w;',
22443   '  Glob:=Glob;',
22444   '  Result:=Self.Glob;',
22445   '  Self.Glob:=Self.Glob;',
22446   '  with Self do Glob:=Glob;',
22447   'end;',
22448   'class function THelper.bar(w: word): word;',
22449   'begin',
22450   '  Result:=w;',
22451   '  Two:=One;',
22452   '  Glob:=Glob;',
22453   'end;',
22454   'var o: TExtA;',
22455   'begin',
22456   '  texta.two:=texta.one;',
22457   '  texta.Glob:=texta.Glob;',
22458   '  with texta do begin',
22459   '    two:=one;',
22460   '    Glob:=Glob;',
22461   '  end;',
22462   '  o.two:=o.one;',
22463   '  o.Glob:=o.Glob;',
22464   '  with o do begin',
22465   '    two:=one;',
22466   '    Glob:=Glob;',
22467   '  end;',
22468   '']);
22469   ConvertProgram;
22470   CheckSource('TestExtClassHelper_ClassVar',
22471     LinesToStr([ // statements
22472     'rtl.createHelper($mod, "THelper", null, function () {',
22473     '  this.One = 1;',
22474     '  this.Two = 2;',
22475     '  this.Glob = 0;',
22476     '  this.Foo = function (w) {',
22477     '    var Result = 0;',
22478     '    Result = w;',
22479     '    $mod.THelper.Two = 1 + w;',
22480     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22481     '    Result = $mod.THelper.Glob;',
22482     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22483     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22484     '    return Result;',
22485     '  };',
22486     '  this.Bar = function (w) {',
22487     '    var Result = 0;',
22488     '    Result = w;',
22489     '    $mod.THelper.Two = 1;',
22490     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22491     '    return Result;',
22492     '  };',
22493     '});',
22494     'this.o = null;',
22495     '']),
22496     LinesToStr([ // $mod.$main
22497     '$mod.THelper.Two = 1;',
22498     '$mod.THelper.Glob = $mod.THelper.Glob;',
22499     '$mod.THelper.Two = 1;',
22500     '$mod.THelper.Glob = $mod.THelper.Glob;',
22501     '$mod.THelper.Two = 1;',
22502     '$mod.THelper.Glob = $mod.THelper.Glob;',
22503     'var $with = $mod.o;',
22504     '$mod.THelper.Two = 1;',
22505     '$mod.THelper.Glob = $mod.THelper.Glob;',
22506     '']));
22507 end;
22508 
22509 procedure TTestModule.TestExtClassHelper_Method_Call;
22510 begin
22511   StartProgram(false);
22512   Add([
22513   '{$modeswitch externalclass}',
22514   'type',
22515   '  TFly = function(w: word): word of object;',
22516   '  TExtA = class external name ''ExtObj''',
22517   '    procedure Run(w: word = 10);',
22518   '  end;',
22519   '  THelper = class helper for TExtA',
22520   '    function Foo(w: word = 1): word;',
22521   '    function Fly(w: word = 2): word; external name ''Fly'';',
22522   '  end;',
22523   'var p: TFly;',
22524   'function THelper.foo(w: word): word;',
22525   'begin',
22526   '  Run;',
22527   '  Run();',
22528   '  Run(11);',
22529   '  Foo;',
22530   '  Foo();',
22531   '  Foo(12);',
22532   '  Self.Foo;',
22533   '  Self.Foo();',
22534   '  Self.Foo(13);',
22535   '  Fly;',
22536   '  Fly();',
22537   '  with Self do begin',
22538   '    Foo;',
22539   '    Foo();',
22540   '    Foo(14);',
22541   '    Fly;',
22542   '    Fly();',
22543   '  end;',
22544   '  p:=@Fly;',
22545   'end;',
22546   'var Obj: TExtA;',
22547   'begin',
22548   '  obj.Foo;',
22549   '  obj.Foo();',
22550   '  obj.Foo(21);',
22551   '  obj.Fly;',
22552   '  obj.Fly();',
22553   '  with obj do begin',
22554   '    Foo;',
22555   '    Foo();',
22556   '    Foo(22);',
22557   '    Fly;',
22558   '    Fly();',
22559   '  end;',
22560   '  p:=@obj.Fly;',
22561   '']);
22562   ConvertProgram;
22563   CheckSource('TestExtClassHelper_Method_Call',
22564     LinesToStr([ // statements
22565     'rtl.createHelper($mod, "THelper", null, function () {',
22566     '  this.Foo = function (w) {',
22567     '    var Result = 0;',
22568     '    this.Run(10);',
22569     '    this.Run(10);',
22570     '    this.Run(11);',
22571     '    $mod.THelper.Foo.call(this, 1);',
22572     '    $mod.THelper.Foo.call(this, 1);',
22573     '    $mod.THelper.Foo.call(this, 12);',
22574     '    $mod.THelper.Foo.call(this, 1);',
22575     '    $mod.THelper.Foo.call(this, 1);',
22576     '    $mod.THelper.Foo.call(this, 13);',
22577     '    this.Fly(2);',
22578     '    this.Fly(2);',
22579     '    $mod.THelper.Foo.call(this, 1);',
22580     '    $mod.THelper.Foo.call(this, 1);',
22581     '    $mod.THelper.Foo.call(this, 14);',
22582     '    this.Fly(2);',
22583     '    this.Fly(2);',
22584     '    $mod.p = rtl.createCallback(this, "Fly");',
22585     '    return Result;',
22586     '  };',
22587     '});',
22588     'this.p = null;',
22589     'this.Obj = null;',
22590     '']),
22591     LinesToStr([ // $mod.$main
22592     '$mod.THelper.Foo.call($mod.Obj, 1);',
22593     '$mod.THelper.Foo.call($mod.Obj, 1);',
22594     '$mod.THelper.Foo.call($mod.Obj, 21);',
22595     '$mod.Obj.Fly(2);',
22596     '$mod.Obj.Fly(2);',
22597     'var $with = $mod.Obj;',
22598     '$mod.THelper.Foo.call($with, 1);',
22599     '$mod.THelper.Foo.call($with, 1);',
22600     '$mod.THelper.Foo.call($with, 22);',
22601     '$with.Fly(2);',
22602     '$with.Fly(2);',
22603     '$mod.p = rtl.createCallback($mod.Obj, "Fly");',
22604     '']));
22605 end;
22606 
22607 procedure TTestModule.TestExtClassHelper_ClassMethod_MissingStatic;
22608 begin
22609   StartProgram(false);
22610   Add([
22611   '{$modeswitch externalclass}',
22612   'type',
22613   '  TExtA = class external name ''ExtObj''',
22614   '    procedure Run(w: word = 10);',
22615   '  end;',
22616   '  THelper = class helper for TExtA',
22617   '    class procedure Fly;',
22618   '  end;',
22619   'class procedure THelper.Fly;',
22620   'begin end;',
22621   'begin',
22622   '']);
22623   SetExpectedPasResolverError(sHelperClassMethodForExtClassMustBeStatic,
22624                               nHelperClassMethodForExtClassMustBeStatic);
22625   ConvertProgram;
22626 end;
22627 
22628 procedure TTestModule.TestRecordHelper_ClassVar;
22629 begin
22630   StartProgram(false);
22631   Add([
22632   'type',
22633   '  TRec = record',
22634   '  end;',
22635   '  THelper = record helper for TRec',
22636   '    const',
22637   '      One = 1;',
22638   '      Two: word = 2;',
22639   '    class var',
22640   '      Glob: word;',
22641   '    function Foo(w: word): word;',
22642   '    class function Bar(w: word): word; static;',
22643   '  end;',
22644   'function THelper.foo(w: word): word;',
22645   'begin',
22646   '  Result:=w;',
22647   '  Two:=One+w;',
22648   '  Glob:=Glob;',
22649   '  Result:=Self.Glob;',
22650   '  Self.Glob:=Self.Glob;',
22651   '  with Self do Glob:=Glob;',
22652   '  Self:=Self;',
22653   'end;',
22654   'class function THelper.bar(w: word): word;',
22655   'begin',
22656   '  Result:=w;',
22657   '  Two:=One;',
22658   '  Glob:=Glob;',
22659   'end;',
22660   'var r: TRec;',
22661   'begin',
22662   '  trec.two:=trec.one;',
22663   '  trec.Glob:=trec.Glob;',
22664   '  with trec do begin',
22665   '    two:=one;',
22666   '    Glob:=Glob;',
22667   '  end;',
22668   '  r.two:=r.one;',
22669   '  r.Glob:=r.Glob;',
22670   '  with r do begin',
22671   '    two:=one;',
22672   '    Glob:=Glob;',
22673   '  end;',
22674   '']);
22675   ConvertProgram;
22676   CheckSource('TestRecordHelper_ClassVar',
22677     LinesToStr([ // statements
22678     'rtl.recNewT($mod, "TRec", function () {',
22679     '  this.$eq = function (b) {',
22680     '    return true;',
22681     '  };',
22682     '  this.$assign = function (s) {',
22683     '    return this;',
22684     '  };',
22685     '});',
22686     'rtl.createHelper($mod, "THelper", null, function () {',
22687     '  this.One = 1;',
22688     '  this.Two = 2;',
22689     '  this.Glob = 0;',
22690     '  this.Foo = function (w) {',
22691     '    var Result = 0;',
22692     '    Result = w;',
22693     '    $mod.THelper.Two = 1 + w;',
22694     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22695     '    Result = $mod.THelper.Glob;',
22696     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22697     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22698     '    this.$assign(this);',
22699     '    return Result;',
22700     '  };',
22701     '  this.Bar = function (w) {',
22702     '    var Result = 0;',
22703     '    Result = w;',
22704     '    $mod.THelper.Two = 1;',
22705     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22706     '    return Result;',
22707     '  };',
22708     '});',
22709     'this.r = $mod.TRec.$new();',
22710     '']),
22711     LinesToStr([ // $mod.$main
22712     '$mod.THelper.Two = 1;',
22713     '$mod.THelper.Glob = $mod.THelper.Glob;',
22714     'var $with = $mod.TRec;',
22715     '$mod.THelper.Two = 1;',
22716     '$mod.THelper.Glob = $mod.THelper.Glob;',
22717     '$mod.THelper.Two = 1;',
22718     '$mod.THelper.Glob = $mod.THelper.Glob;',
22719     'var $with1 = $mod.r;',
22720     '$mod.THelper.Two = 1;',
22721     '$mod.THelper.Glob = $mod.THelper.Glob;',
22722     '']));
22723 end;
22724 
22725 procedure TTestModule.TestRecordHelper_Method_Call;
22726 begin
22727   StartProgram(false);
22728   Add([
22729   '{$modeswitch AdvancedRecords}',
22730   'type',
22731   '  TRec = record',
22732   '    procedure Run(w: word = 10);',
22733   '  end;',
22734   '  THelper = record helper for TRec',
22735   '    function Foo(w: word = 1): word;',
22736   '  end;',
22737   'procedure TRec.Run(w: word);',
22738   'begin',
22739   '  Foo;',
22740   '  Foo();',
22741   '  Foo(2);',
22742   '  Self.Foo;',
22743   '  Self.Foo();',
22744   '  Self.Foo(3);',
22745   '  with Self do begin',
22746   '    Foo;',
22747   '    Foo();',
22748   '    Foo(4);',
22749   '  end;',
22750   'end;',
22751   'function THelper.foo(w: word): word;',
22752   'begin',
22753   '  Run;',
22754   '  Run();',
22755   '  Run(11);',
22756   '  Foo;',
22757   '  Foo();',
22758   '  Foo(12);',
22759   '  Self.Foo;',
22760   '  Self.Foo();',
22761   '  Self.Foo(13);',
22762   '  with Self do begin',
22763   '    Foo;',
22764   '    Foo();',
22765   '    Foo(14);',
22766   '  end;',
22767   'end;',
22768   'var Rec: TRec;',
22769   'begin',
22770   '  Rec.Foo;',
22771   '  Rec.Foo();',
22772   '  Rec.Foo(21);',
22773   '  with Rec do begin',
22774   '    Foo;',
22775   '    Foo();',
22776   '    Foo(22);',
22777   '  end;',
22778   '']);
22779   ConvertProgram;
22780   CheckSource('TestRecordHelper_Method_Call',
22781     LinesToStr([ // statements
22782     'rtl.recNewT($mod, "TRec", function () {',
22783     '  this.$eq = function (b) {',
22784     '    return true;',
22785     '  };',
22786     '  this.$assign = function (s) {',
22787     '    return this;',
22788     '  };',
22789     '  this.Run = function (w) {',
22790     '    $mod.THelper.Foo.call(this, 1);',
22791     '    $mod.THelper.Foo.call(this, 1);',
22792     '    $mod.THelper.Foo.call(this, 2);',
22793     '    $mod.THelper.Foo.call(this, 1);',
22794     '    $mod.THelper.Foo.call(this, 1);',
22795     '    $mod.THelper.Foo.call(this, 3);',
22796     '    $mod.THelper.Foo.call(this, 1);',
22797     '    $mod.THelper.Foo.call(this, 1);',
22798     '    $mod.THelper.Foo.call(this, 4);',
22799     '  };',
22800     '});',
22801     'rtl.createHelper($mod, "THelper", null, function () {',
22802     '  this.Foo = function (w) {',
22803     '    var Result = 0;',
22804     '    this.Run(10);',
22805     '    this.Run(10);',
22806     '    this.Run(11);',
22807     '    $mod.THelper.Foo.call(this, 1);',
22808     '    $mod.THelper.Foo.call(this, 1);',
22809     '    $mod.THelper.Foo.call(this, 12);',
22810     '    $mod.THelper.Foo.call(this, 1);',
22811     '    $mod.THelper.Foo.call(this, 1);',
22812     '    $mod.THelper.Foo.call(this, 13);',
22813     '    $mod.THelper.Foo.call(this, 1);',
22814     '    $mod.THelper.Foo.call(this, 1);',
22815     '    $mod.THelper.Foo.call(this, 14);',
22816     '    return Result;',
22817     '  };',
22818     '});',
22819     'this.Rec = $mod.TRec.$new();',
22820     '']),
22821     LinesToStr([ // $mod.$main
22822     '$mod.THelper.Foo.call($mod.Rec, 1);',
22823     '$mod.THelper.Foo.call($mod.Rec, 1);',
22824     '$mod.THelper.Foo.call($mod.Rec, 21);',
22825     'var $with = $mod.Rec;',
22826     '$mod.THelper.Foo.call($with, 1);',
22827     '$mod.THelper.Foo.call($with, 1);',
22828     '$mod.THelper.Foo.call($with, 22);',
22829     '']));
22830 end;
22831 
22832 procedure TTestModule.TestRecordHelper_Constructor;
22833 begin
22834   StartProgram(false);
22835   Add([
22836   '{$modeswitch AdvancedRecords}',
22837   'type',
22838   '  TRec = record',
22839   '    constructor Create(w: word);',
22840   '  end;',
22841   '  THelper = record helper for TRec',
22842   '    constructor NewHlp(w: word);',
22843   '  end;',
22844   'var',
22845   '  Rec: TRec;',
22846   'constructor TRec.Create(w: word);',
22847   'begin',
22848   '  NewHlp(2);', // normal call
22849   '  trec.NewHlp(3);', // new instance
22850   'end;',
22851   'constructor THelper.NewHlp(w: word);',
22852   'begin',
22853   '  create(2);', // normal call
22854   '  trec.create(3);', // new instance
22855   '  NewHlp(4);', // normal call
22856   '  trec.NewHlp(5);', // new instance
22857   'end;',
22858   'begin',
22859   '  rec.newhlp(2);', // normal call
22860   '  with rec do newhlp(12);', // normal call
22861   '  trec.newhlp(3);', // new instance
22862   '  with trec do newhlp(13);', // new instance
22863   '']);
22864   ConvertProgram;
22865   CheckSource('TestRecordHelper_Constructor',
22866     LinesToStr([ // statements
22867     'rtl.recNewT($mod, "TRec", function () {',
22868     '  this.$eq = function (b) {',
22869     '    return true;',
22870     '  };',
22871     '  this.$assign = function (s) {',
22872     '    return this;',
22873     '  };',
22874     '  this.Create = function (w) {',
22875     '    $mod.THelper.NewHlp.call(this, 2);',
22876     '    $mod.THelper.$new("NewHlp", [3]);',
22877     '    return this;',
22878     '  };',
22879     '}, true);',
22880     'rtl.createHelper($mod, "THelper", null, function () {',
22881     '  this.NewHlp = function (w) {',
22882     '    this.Create(2);',
22883     '    $mod.TRec.$new().Create(3);',
22884     '    $mod.THelper.NewHlp.call(this, 4);',
22885     '    $mod.THelper.$new("NewHlp", [5]);',
22886     '    return this;',
22887     '  };',
22888     '  this.$new = function (fn, args) {',
22889     '    return this[fn].apply($mod.TRec.$new(), args);',
22890     '  };',
22891     '});',
22892     'this.Rec = $mod.TRec.$new();',
22893     '']),
22894     LinesToStr([ // $mod.$main
22895     '$mod.THelper.NewHlp.call($mod.Rec, 2);',
22896     'var $with = $mod.Rec;',
22897     '$mod.THelper.NewHlp.call($with, 12);',
22898     '$mod.THelper.$new("NewHlp", [3]);',
22899     'var $with1 = $mod.TRec;',
22900     '$mod.THelper.$new("NewHlp", [13]);',
22901     '']));
22902 end;
22903 
22904 procedure TTestModule.TestTypeHelper_ClassVar;
22905 begin
22906   StartProgram(false);
22907   Add([
22908   '{$modeswitch typehelpers}',
22909   'type',
22910   '  THelper = type helper for byte',
22911   '    const',
22912   '      One = 1;',
22913   '      Two: word = 2;',
22914   '    class var',
22915   '      Glob: word;',
22916   '    function Foo(w: word): word;',
22917   '    class function Bar(w: word): word; static;',
22918   '  end;',
22919   'function THelper.foo(w: word): word;',
22920   'begin',
22921   '  Result:=w;',
22922   '  Two:=One+w;',
22923   '  Glob:=Glob;',
22924   '  Result:=Self.Glob;',
22925   '  Self.Glob:=Self.Glob;',
22926   '  with Self do Glob:=Glob;',
22927   'end;',
22928   'class function THelper.bar(w: word): word;',
22929   'begin',
22930   '  Result:=w;',
22931   '  Two:=One;',
22932   '  Glob:=Glob;',
22933   'end;',
22934   'var b: byte;',
22935   'begin',
22936   '  byte.two:=byte.one;',
22937   '  byte.Glob:=byte.Glob;',
22938   '  with byte do begin',
22939   '    two:=one;',
22940   '    Glob:=Glob;',
22941   '  end;',
22942   '  b.two:=b.one;',
22943   '  b.Glob:=b.Glob;',
22944   '  with b do begin',
22945   '    two:=one;',
22946   '    Glob:=Glob;',
22947   '  end;',
22948   '']);
22949   ConvertProgram;
22950   CheckSource('TestTypeHelper_ClassVar',
22951     LinesToStr([ // statements
22952     'rtl.createHelper($mod, "THelper", null, function () {',
22953     '  this.One = 1;',
22954     '  this.Two = 2;',
22955     '  this.Glob = 0;',
22956     '  this.Foo = function (w) {',
22957     '    var Result = 0;',
22958     '    Result = w;',
22959     '    $mod.THelper.Two = 1 + w;',
22960     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22961     '    Result = $mod.THelper.Glob;',
22962     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22963     '    var $with = this.get();',
22964     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22965     '    return Result;',
22966     '  };',
22967     '  this.Bar = function (w) {',
22968     '    var Result = 0;',
22969     '    Result = w;',
22970     '    $mod.THelper.Two = 1;',
22971     '    $mod.THelper.Glob = $mod.THelper.Glob;',
22972     '    return Result;',
22973     '  };',
22974     '});',
22975     'this.b = 0;',
22976     '']),
22977     LinesToStr([ // $mod.$main
22978     '$mod.THelper.Two = 1;',
22979     '$mod.THelper.Glob = $mod.THelper.Glob;',
22980     '$mod.THelper.Two = 1;',
22981     '$mod.THelper.Glob = $mod.THelper.Glob;',
22982     '$mod.THelper.Two = 1;',
22983     '$mod.THelper.Glob = $mod.THelper.Glob;',
22984     'var $with = $mod.b;',
22985     '$mod.THelper.Two = 1;',
22986     '$mod.THelper.Glob = $mod.THelper.Glob;',
22987     '']));
22988 end;
22989 
22990 procedure TTestModule.TestTypeHelper_PassResultElement;
22991 begin
22992   StartProgram(false);
22993   Add([
22994   '{$modeswitch typehelpers}',
22995   'type',
22996   '  THelper = type helper for word',
22997   '    procedure DoIt(e: byte = 123);',
22998   '    class procedure DoSome(e: byte = 456); static;',
22999   '  end;',
23000   'procedure THelper.DoIt(e: byte);',
23001   'begin',
23002   'end;',
23003   'class procedure THelper.DoSome(e: byte);',
23004   'begin',
23005   'end;',
23006   'function Foo(w: word): word;',
23007   'begin',
23008   '  Result.DoIt;',
23009   '  Result.DoIt();',
23010   '  Result.DoSome;',
23011   '  Result.DoSome();',
23012   '  with Result do begin',
23013   '    DoIt;',
23014   '    DoIt();',
23015   '    DoSome;',
23016   '    DoSome();',
23017   '  end;',
23018   'end;',
23019   'begin',
23020   '']);
23021   ConvertProgram;
23022   CheckSource('TestTypeHelper_PassResultElement',
23023     LinesToStr([ // statements
23024     'rtl.createHelper($mod, "THelper", null, function () {',
23025     '  this.DoIt = function (e) {',
23026     '  };',
23027     '  this.DoSome = function (e) {',
23028     '  };',
23029     '});',
23030     'this.Foo = function (w) {',
23031     '  var Result = 0;',
23032     '  $mod.THelper.DoIt.call({',
23033     '    get: function () {',
23034     '        return Result;',
23035     '      },',
23036     '    set: function (v) {',
23037     '        Result = v;',
23038     '      }',
23039     '  }, 123);',
23040     '  $mod.THelper.DoIt.call({',
23041     '    get: function () {',
23042     '        return Result;',
23043     '      },',
23044     '    set: function (v) {',
23045     '        Result = v;',
23046     '      }',
23047     '  }, 123);',
23048     '  $mod.THelper.DoSome(456);',
23049     '  $mod.THelper.DoSome(456);',
23050     '  $mod.THelper.DoIt.call({',
23051     '    get: function () {',
23052     '        return Result;',
23053     '      },',
23054     '    set: function (v) {',
23055     '        Result = v;',
23056     '      }',
23057     '  }, 123);',
23058     '  $mod.THelper.DoIt.call({',
23059     '    get: function () {',
23060     '        return Result;',
23061     '      },',
23062     '    set: function (v) {',
23063     '        Result = v;',
23064     '      }',
23065     '  }, 123);',
23066     '  $mod.THelper.DoSome(456);',
23067     '  $mod.THelper.DoSome(456);',
23068     '  return Result;',
23069     '};',
23070     '']),
23071     LinesToStr([ // $mod.$main
23072     '']));
23073 end;
23074 
23075 procedure TTestModule.TestTypeHelper_PassArgs;
23076 begin
23077   StartProgram(false);
23078   Add([
23079   '{$modeswitch typehelpers}',
23080   'type',
23081   '  THelper = type helper for word',
23082   '    procedure DoIt(e: byte = 123);',
23083   '  end;',
23084   'procedure THelper.DoIt(e: byte);',
23085   'begin',
23086   'end;',
23087   'procedure FooDefault(a: word);',
23088   'begin',
23089   '  a.DoIt;',
23090   '  with a do DoIt;',
23091   'end;',
23092   'procedure FooConst(const a: word);',
23093   'begin',
23094   '  a.DoIt;',
23095   '  with a do DoIt;',
23096   'end;',
23097   'procedure FooVar(var a: word);',
23098   'begin',
23099   '  a.DoIt;',
23100   '  with a do DoIt;',
23101   'end;',
23102   'begin',
23103   '']);
23104   ConvertProgram;
23105   CheckSource('TestTypeHelper_PassArgs',
23106     LinesToStr([ // statements
23107     'rtl.createHelper($mod, "THelper", null, function () {',
23108     '  this.DoIt = function (e) {',
23109     '  };',
23110     '});',
23111     'this.FooDefault = function (a) {',
23112     '  $mod.THelper.DoIt.call({',
23113     '    get: function () {',
23114     '        return a;',
23115     '      },',
23116     '    set: function (v) {',
23117     '        a = v;',
23118     '      }',
23119     '  }, 123);',
23120     '  $mod.THelper.DoIt.call({',
23121     '    get: function () {',
23122     '        return a;',
23123     '      },',
23124     '    set: function (v) {',
23125     '        a = v;',
23126     '      }',
23127     '  }, 123);',
23128     '};',
23129     'this.FooConst = function (a) {',
23130     '  $mod.THelper.DoIt.call({',
23131     '    get: function () {',
23132     '        return a;',
23133     '      },',
23134     '    set: function (v) {',
23135     '        rtl.raiseE("EPropReadOnly");',
23136     '      }',
23137     '  }, 123);',
23138     '  $mod.THelper.DoIt.call({',
23139     '    get: function () {',
23140     '        return a;',
23141     '      },',
23142     '    set: function () {',
23143     '        rtl.raiseE("EPropReadOnly");',
23144     '      }',
23145     '  }, 123);',
23146     '};',
23147     'this.FooVar = function (a) {',
23148     '  $mod.THelper.DoIt.call(a, 123);',
23149     '  var $with = a.get();',
23150     '  $mod.THelper.DoIt.call(a, 123);',
23151     '};',
23152     '']),
23153     LinesToStr([ // $mod.$main
23154     '']));
23155 end;
23156 
23157 procedure TTestModule.TestTypeHelper_PassVarConst;
23158 begin
23159   StartProgram(false);
23160   Add([
23161   '{$modeswitch typehelpers}',
23162   'type',
23163   '  THelper = type helper for word',
23164   '    procedure DoIt(e: byte = 123);',
23165   '  end;',
23166   'procedure THelper.DoIt(e: byte);',
23167   'begin',
23168   'end;',
23169   'var a: word;',
23170   'const c: word = 2;',
23171   '{$writeableconst off}',
23172   'const r: word = 3;',
23173   'begin',
23174   '  a.DoIt;',
23175   '  with a do DoIt;',
23176   '  c.DoIt;',
23177   '  with c do DoIt;',
23178   '  r.DoIt;',
23179   '  with r do DoIt;',
23180   '']);
23181   ConvertProgram;
23182   CheckSource('TestTypeHelper_PassVarConst',
23183     LinesToStr([ // statements
23184     'rtl.createHelper($mod, "THelper", null, function () {',
23185     '  this.DoIt = function (e) {',
23186     '  };',
23187     '});',
23188     'this.a = 0;',
23189     'this.c = 2;',
23190     'this.r = 3;',
23191     '']),
23192     LinesToStr([ // $mod.$main
23193     '$mod.THelper.DoIt.call({',
23194     '  p: $mod,',
23195     '  get: function () {',
23196     '      return this.p.a;',
23197     '    },',
23198     '  set: function (v) {',
23199     '      this.p.a = v;',
23200     '    }',
23201     '}, 123);',
23202     'var $with = $mod.a;',
23203     '$mod.THelper.DoIt.call({',
23204     '  get: function () {',
23205     '      return $with;',
23206     '    },',
23207     '  set: function (v) {',
23208     '      $with = v;',
23209     '    }',
23210     '}, 123);',
23211     '$mod.THelper.DoIt.call({',
23212     '  p: $mod,',
23213     '  get: function () {',
23214     '      return this.p.c;',
23215     '    },',
23216     '  set: function (v) {',
23217     '      this.p.c = v;',
23218     '    }',
23219     '}, 123);',
23220     'var $with1 = $mod.c;',
23221     '$mod.THelper.DoIt.call({',
23222     '  get: function () {',
23223     '      return $with1;',
23224     '    },',
23225     '  set: function (v) {',
23226     '      $with1 = v;',
23227     '    }',
23228     '}, 123);',
23229     '$mod.THelper.DoIt.call({',
23230     '  get: function () {',
23231     '      return 3;',
23232     '    },',
23233     '  set: function (v) {',
23234     '      rtl.raiseE("EPropReadOnly");',
23235     '    }',
23236     '}, 123);',
23237     'var $with2 = 3;',
23238     '  $mod.THelper.DoIt.call({',
23239     '    get: function () {',
23240     '        return $with2;',
23241     '      },',
23242     '    set: function () {',
23243     '        rtl.raiseE("EPropReadOnly");',
23244     '      }',
23245     '  }, 123);',
23246     '']));
23247 end;
23248 
23249 procedure TTestModule.TestTypeHelper_PassFuncResult;
23250 begin
23251   StartProgram(false);
23252   Add([
23253   '{$modeswitch typehelpers}',
23254   'type',
23255   '  THelper = type helper for word',
23256   '    procedure DoIt(e: byte = 123);',
23257   '  end;',
23258   'procedure THelper.DoIt(e: byte);',
23259   'begin',
23260   'end;',
23261   'function Foo(b: byte = 1): word;',
23262   'begin',
23263   'end;',
23264   'begin',
23265   '  Foo.DoIt;',
23266   '  Foo().DoIt;',
23267   '  with Foo do DoIt;',
23268   '  with Foo() do DoIt;',
23269   '']);
23270   ConvertProgram;
23271   CheckSource('TestTypeHelper_PassFuncResult',
23272     LinesToStr([ // statements
23273     'rtl.createHelper($mod, "THelper", null, function () {',
23274     '  this.DoIt = function (e) {',
23275     '  };',
23276     '});',
23277     'this.Foo = function (b) {',
23278     '  var Result = 0;',
23279     '  return Result;',
23280     '};',
23281     '']),
23282     LinesToStr([ // $mod.$main
23283     '$mod.THelper.DoIt.call({',
23284     '  a: $mod.Foo(1),',
23285     '  get: function () {',
23286     '      return this.a;',
23287     '    },',
23288     '  set: function (v) {',
23289     '      this.a = v;',
23290     '    }',
23291     '}, 123);',
23292     '$mod.THelper.DoIt.call({',
23293     '  a: $mod.Foo(1),',
23294     '  get: function () {',
23295     '      return this.a;',
23296     '    },',
23297     '  set: function (v) {',
23298     '      this.a = v;',
23299     '    }',
23300     '}, 123);',
23301     'var $with = $mod.Foo(1);',
23302     '$mod.THelper.DoIt.call({',
23303     '  get: function () {',
23304     '      return $with;',
23305     '    },',
23306     '  set: function (v) {',
23307     '      $with = v;',
23308     '    }',
23309     '}, 123);',
23310     'var $with1 = $mod.Foo(1);',
23311     '$mod.THelper.DoIt.call({',
23312     '  get: function () {',
23313     '      return $with1;',
23314     '    },',
23315     '  set: function (v) {',
23316     '      $with1 = v;',
23317     '    }',
23318     '}, 123);',
23319     '']));
23320 end;
23321 
23322 procedure TTestModule.TestTypeHelper_PassPropertyField;
23323 begin
23324   StartProgram(false);
23325   Add([
23326   '{$modeswitch typehelpers}',
23327   'type',
23328   '  TObject = class',
23329   '    FField: word;',
23330   '    procedure SetField(Value: word);',
23331   '    property Field: word read FField write SetField;',
23332   '  end;',
23333   '  THelper = type helper for word',
23334   '    procedure Fly;',
23335   '    class procedure Run; static;',
23336   '  end;',
23337   'procedure TObject.SetField(Value: word);',
23338   'begin',
23339   '  Field.Fly;',
23340   '  Field.Run;',
23341   '  Self.Field.Fly;',
23342   '  Self.Field.Run;',
23343   '  with Self do begin',
23344   '    Field.Fly;',
23345   '    Field.Run;',
23346   '  end;',
23347   '  with Self.Field do begin',
23348   '    Fly;',
23349   '    Run;',
23350   '  end;',
23351   'end;',
23352   'procedure THelper.Fly;',
23353   'begin',
23354   'end;',
23355   'class procedure THelper.Run;',
23356   'begin',
23357   'end;',
23358   'var',
23359   '  o: TObject;',
23360   'begin',
23361   '  o.Field.Fly;',
23362   '  o.Field.Run;',
23363   '  with o do begin',
23364   '    Field.Fly;',
23365   '    Field.Run;',
23366   '  end;',
23367   '  with o.Field do begin',
23368   '    Fly;',
23369   '    Run;',
23370   '  end;',
23371   '']);
23372   ConvertProgram;
23373   CheckSource('TestTypeHelper_PassPropertyField',
23374     LinesToStr([ // statements
23375     'rtl.createClass($mod, "TObject", null, function () {',
23376     '  this.$init = function () {',
23377     '    this.FField = 0;',
23378     '  };',
23379     '  this.$final = function () {',
23380     '  };',
23381     '  this.SetField = function (Value) {',
23382     '    $mod.THelper.Fly.call({',
23383     '      p: this,',
23384     '      get: function () {',
23385     '          return this.p.FField;',
23386     '        },',
23387     '      set: function (v) {',
23388     '          this.p.FField = v;',
23389     '        }',
23390     '    });',
23391     '    $mod.THelper.Run();',
23392     '    $mod.THelper.Fly.call({',
23393     '      p: this,',
23394     '      get: function () {',
23395     '          return this.p.FField;',
23396     '        },',
23397     '      set: function (v) {',
23398     '          this.p.FField = v;',
23399     '        }',
23400     '    });',
23401     '    $mod.THelper.Run();',
23402     '    $mod.THelper.Fly.call({',
23403     '      p: this,',
23404     '      get: function () {',
23405     '          return this.p.FField;',
23406     '        },',
23407     '      set: function (v) {',
23408     '          this.p.FField = v;',
23409     '        }',
23410     '    });',
23411     '    $mod.THelper.Run();',
23412     '    var $with = this.FField;',
23413     '    $mod.THelper.Fly.call({',
23414     '      get: function () {',
23415     '          return $with;',
23416     '        },',
23417     '      set: function (v) {',
23418     '          $with = v;',
23419     '        }',
23420     '    });',
23421     '    $mod.THelper.Run();',
23422     '  };',
23423     '});',
23424     'rtl.createHelper($mod, "THelper", null, function () {',
23425     '  this.Fly = function () {',
23426     '  };',
23427     '  this.Run = function () {',
23428     '  };',
23429     '});',
23430     'this.o = null;',
23431     '']),
23432     LinesToStr([ // $mod.$main
23433     '$mod.THelper.Fly.call({',
23434     '  p: $mod.o,',
23435     '  get: function () {',
23436     '      return this.p.FField;',
23437     '    },',
23438     '  set: function (v) {',
23439     '      this.p.FField = v;',
23440     '    }',
23441     '});',
23442     '$mod.THelper.Run();',
23443     'var $with = $mod.o;',
23444     '$mod.THelper.Fly.call({',
23445     '  p: $with,',
23446     '  get: function () {',
23447     '      return this.p.FField;',
23448     '    },',
23449     '  set: function (v) {',
23450     '      this.p.FField = v;',
23451     '    }',
23452     '});',
23453     '$mod.THelper.Run();',
23454     'var $with1 = $mod.o.FField;',
23455     '$mod.THelper.Fly.call({',
23456     '  get: function () {',
23457     '      return $with1;',
23458     '    },',
23459     '  set: function (v) {',
23460     '      $with1 = v;',
23461     '    }',
23462     '});',
23463     '$mod.THelper.Run();',
23464     '']));
23465 end;
23466 
23467 procedure TTestModule.TestTypeHelper_PassPropertyGetter;
23468 begin
23469   StartProgram(false);
23470   Add([
23471   '{$modeswitch typehelpers}',
23472   'type',
23473   '  TObject = class',
23474   '    FField: word;',
23475   '    function GetField: word;',
23476   '    property Field: word read GetField write FField;',
23477   '  end;',
23478   '  THelper = type helper for word',
23479   '    procedure Fly;',
23480   '    class procedure Run; static;',
23481   '  end;',
23482   'function TObject.GetField: word;',
23483   'begin',
23484   '  Field.Fly;',
23485   '  Field.Run;',
23486   '  Self.Field.Fly;',
23487   '  Self.Field.Run;',
23488   '  with Self do begin',
23489   '    Field.Fly;',
23490   '    Field.Run;',
23491   '  end;',
23492   '  with Self.Field do begin',
23493   '    Fly;',
23494   '    Run;',
23495   '  end;',
23496   'end;',
23497   'procedure THelper.Fly;',
23498   'begin',
23499   'end;',
23500   'class procedure THelper.Run;',
23501   'begin',
23502   'end;',
23503   'var',
23504   '  o: TObject;',
23505   'begin',
23506   '  o.Field.Fly;',
23507   '  o.Field.Run;',
23508   '  with o do begin',
23509   '    Field.Fly;',
23510   '    Field.Run;',
23511   '  end;',
23512   '  with o.Field do begin',
23513   '    Fly;',
23514   '    Run;',
23515   '  end;',
23516   '']);
23517   ConvertProgram;
23518   CheckSource('TestTypeHelper_PassPropertyGetter',
23519     LinesToStr([ // statements
23520     'rtl.createClass($mod, "TObject", null, function () {',
23521     '  this.$init = function () {',
23522     '    this.FField = 0;',
23523     '  };',
23524     '  this.$final = function () {',
23525     '  };',
23526     '  this.GetField = function () {',
23527     '    var Result = 0;',
23528     '    $mod.THelper.Fly.call({',
23529     '      p: this.GetField(),',
23530     '      get: function () {',
23531     '          return this.p;',
23532     '        },',
23533     '      set: function (v) {',
23534     '          this.p = v;',
23535     '        }',
23536     '    });',
23537     '    $mod.THelper.Run();',
23538     '    $mod.THelper.Fly.call({',
23539     '      p: this.GetField(),',
23540     '      get: function () {',
23541     '          return this.p;',
23542     '        },',
23543     '      set: function (v) {',
23544     '          this.p = v;',
23545     '        }',
23546     '    });',
23547     '    $mod.THelper.Run();',
23548     '    $mod.THelper.Fly.call({',
23549     '      p: this.GetField(),',
23550     '      get: function () {',
23551     '          return this.p;',
23552     '        },',
23553     '      set: function (v) {',
23554     '          this.p = v;',
23555     '        }',
23556     '    });',
23557     '    $mod.THelper.Run();',
23558     '    var $with = this.GetField();',
23559     '    $mod.THelper.Fly.call({',
23560     '      get: function () {',
23561     '          return $with;',
23562     '        },',
23563     '      set: function (v) {',
23564     '          $with = v;',
23565     '        }',
23566     '    });',
23567     '    $mod.THelper.Run();',
23568     '    return Result;',
23569     '  };',
23570     '});',
23571     'rtl.createHelper($mod, "THelper", null, function () {',
23572     '  this.Fly = function () {',
23573     '  };',
23574     '  this.Run = function () {',
23575     '  };',
23576     '});',
23577     'this.o = null;',
23578     '']),
23579     LinesToStr([ // $mod.$main
23580     '$mod.THelper.Fly.call({',
23581     '  p: $mod.o.GetField(),',
23582     '  get: function () {',
23583     '      return this.p;',
23584     '    },',
23585     '  set: function (v) {',
23586     '      this.p = v;',
23587     '    }',
23588     '});',
23589     '$mod.THelper.Run();',
23590     'var $with = $mod.o;',
23591     '$mod.THelper.Fly.call({',
23592     '  p: $with.GetField(),',
23593     '  get: function () {',
23594     '      return this.p;',
23595     '    },',
23596     '  set: function (v) {',
23597     '      this.p = v;',
23598     '    }',
23599     '});',
23600     '$mod.THelper.Run();',
23601     'var $with1 = $mod.o.GetField();',
23602     '$mod.THelper.Fly.call({',
23603     '  get: function () {',
23604     '      return $with1;',
23605     '    },',
23606     '  set: function (v) {',
23607     '      $with1 = v;',
23608     '    }',
23609     '});',
23610     '$mod.THelper.Run();',
23611     '']));
23612 end;
23613 
23614 procedure TTestModule.TestTypeHelper_PassClassPropertyField;
23615 begin
23616   StartProgram(false);
23617   Add([
23618   '{$modeswitch typehelpers}',
23619   'type',
23620   '  TObject = class',
23621   '    class var FField: word;',
23622   '    class procedure SetField(Value: word);',
23623   '    class property Field: word read FField write SetField;',
23624   '  end;',
23625   '  THelper = type helper for word',
23626   '    procedure Fly(n: byte);',
23627   '  end;',
23628   'class procedure TObject.SetField(Value: word);',
23629   'begin',
23630   '  Field.Fly(1);',
23631   '  Self.Field.Fly(2);',
23632   '  with Self do Field.Fly(3);',
23633   '  with Self.Field do Fly(4);',
23634   '  TObject.Field.Fly(5);',
23635   '  with TObject do Field.Fly(6);',
23636   '  with TObject.Field do Fly(7);',
23637   'end;',
23638   'procedure THelper.Fly(n: byte);',
23639   'begin',
23640   'end;',
23641   'var',
23642   '  o: TObject;',
23643   'begin',
23644   '  o.Field.Fly(11);',
23645   '  with o do Field.Fly(12);',
23646   '  with o.Field do Fly(13);',
23647   '  TObject.Field.Fly(14);',
23648   '  with TObject do Field.Fly(15);',
23649   '  with TObject.Field do Fly(16);',
23650   '']);
23651   ConvertProgram;
23652   CheckSource('TestTypeHelper_PassClassPropertyField',
23653     LinesToStr([ // statements
23654     'rtl.createClass($mod, "TObject", null, function () {',
23655     '  this.FField = 0;',
23656     '  this.$init = function () {',
23657     '  };',
23658     '  this.$final = function () {',
23659     '  };',
23660     '  this.SetField = function (Value) {',
23661     '    $mod.THelper.Fly.call({',
23662     '      p: this,',
23663     '      get: function () {',
23664     '          return this.p.FField;',
23665     '        },',
23666     '      set: function (v) {',
23667     '          $mod.TObject.FField = v;',
23668     '        }',
23669     '    }, 1);',
23670     '    $mod.THelper.Fly.call({',
23671     '      p: this,',
23672     '      get: function () {',
23673     '          return this.p.FField;',
23674     '        },',
23675     '      set: function (v) {',
23676     '          $mod.TObject.FField = v;',
23677     '        }',
23678     '    }, 2);',
23679     '    $mod.THelper.Fly.call({',
23680     '      p: this,',
23681     '      get: function () {',
23682     '          return this.p.FField;',
23683     '        },',
23684     '      set: function (v) {',
23685     '          $mod.TObject.FField = v;',
23686     '        }',
23687     '    }, 3);',
23688     '    var $with = this.FField;',
23689     '    $mod.THelper.Fly.call({',
23690     '      get: function () {',
23691     '          return $with;',
23692     '        },',
23693     '      set: function (v) {',
23694     '          $with = v;',
23695     '        }',
23696     '    }, 4);',
23697     '    $mod.THelper.Fly.call({',
23698     '      p: $mod.TObject,',
23699     '      get: function () {',
23700     '          return this.p.FField;',
23701     '        },',
23702     '      set: function (v) {',
23703     '          $mod.TObject.FField = v;',
23704     '        }',
23705     '    }, 5);',
23706     '    var $with1 = $mod.TObject;',
23707     '    $mod.THelper.Fly.call({',
23708     '      p: $with1,',
23709     '      get: function () {',
23710     '          return this.p.FField;',
23711     '        },',
23712     '      set: function (v) {',
23713     '          $mod.TObject.FField = v;',
23714     '        }',
23715     '    }, 6);',
23716     '    var $with2 = $mod.TObject.FField;',
23717     '    $mod.THelper.Fly.call({',
23718     '      get: function () {',
23719     '          return $with2;',
23720     '        },',
23721     '      set: function (v) {',
23722     '          $with2 = v;',
23723     '        }',
23724     '    }, 7);',
23725     '  };',
23726     '});',
23727     'rtl.createHelper($mod, "THelper", null, function () {',
23728     '  this.Fly = function (n) {',
23729     '  };',
23730     '});',
23731     'this.o = null;',
23732     '']),
23733     LinesToStr([ // $mod.$main
23734     '$mod.THelper.Fly.call({',
23735     '  p: $mod.o,',
23736     '  get: function () {',
23737     '      return this.p.FField;',
23738     '    },',
23739     '  set: function (v) {',
23740     '      $mod.TObject.FField = v;',
23741     '    }',
23742     '}, 11);',
23743     'var $with = $mod.o;',
23744     '$mod.THelper.Fly.call({',
23745     '  p: $with,',
23746     '  get: function () {',
23747     '      return this.p.FField;',
23748     '    },',
23749     '  set: function (v) {',
23750     '      $mod.TObject.FField = v;',
23751     '    }',
23752     '}, 12);',
23753     'var $with1 = $mod.o.FField;',
23754     '$mod.THelper.Fly.call({',
23755     '  get: function () {',
23756     '      return $with1;',
23757     '    },',
23758     '  set: function (v) {',
23759     '      $with1 = v;',
23760     '    }',
23761     '}, 13);',
23762     '$mod.THelper.Fly.call({',
23763     '  p: $mod.TObject,',
23764     '  get: function () {',
23765     '      return this.p.FField;',
23766     '    },',
23767     '  set: function (v) {',
23768     '      $mod.TObject.FField = v;',
23769     '    }',
23770     '}, 14);',
23771     'var $with2 = $mod.TObject;',
23772     '$mod.THelper.Fly.call({',
23773     '  p: $with2,',
23774     '  get: function () {',
23775     '      return this.p.FField;',
23776     '    },',
23777     '  set: function (v) {',
23778     '      $mod.TObject.FField = v;',
23779     '    }',
23780     '}, 15);',
23781     'var $with3 = $mod.TObject.FField;',
23782     '$mod.THelper.Fly.call({',
23783     '  get: function () {',
23784     '      return $with3;',
23785     '    },',
23786     '  set: function (v) {',
23787     '      $with3 = v;',
23788     '    }',
23789     '}, 16);',
23790     '']));
23791 end;
23792 
23793 procedure TTestModule.TestTypeHelper_PassClassPropertyGetterStatic;
23794 begin
23795   StartProgram(false);
23796   Add([
23797   '{$modeswitch typehelpers}',
23798   'type',
23799   '  TObject = class',
23800   '    class var FField: word;',
23801   '    class function GetField: word; static;',
23802   '    class property Field: word read GetField write FField;',
23803   '  end;',
23804   '  THelper = type helper for word',
23805   '    procedure Fly(n: byte);',
23806   '  end;',
23807   'class function TObject.GetField: word;',
23808   'begin',
23809   '  Field.Fly(1);',
23810   '  TObject.Field.Fly(5);',
23811   '  with TObject do Field.Fly(6);',
23812   '  with TObject.Field do Fly(7);',
23813   'end;',
23814   'procedure THelper.Fly(n: byte);',
23815   'begin',
23816   'end;',
23817   'var',
23818   '  o: TObject;',
23819   'begin',
23820   '  o.Field.Fly(11);',
23821   '  with o do Field.Fly(12);',
23822   '  with o.Field do Fly(13);',
23823   '']);
23824   ConvertProgram;
23825   CheckSource('TestTypeHelper_PassClassPropertyGetterStatic',
23826     LinesToStr([ // statements
23827     'rtl.createClass($mod, "TObject", null, function () {',
23828     '  this.FField = 0;',
23829     '  this.$init = function () {',
23830     '  };',
23831     '  this.$final = function () {',
23832     '  };',
23833     '  this.GetField = function () {',
23834     '    var Result = 0;',
23835     '    $mod.THelper.Fly.call({',
23836     '      p: $mod.TObject.GetField(),',
23837     '      get: function () {',
23838     '          return this.p;',
23839     '        },',
23840     '      set: function (v) {',
23841     '          this.p = v;',
23842     '        }',
23843     '    }, 1);',
23844     '    $mod.THelper.Fly.call({',
23845     '      p: $mod.TObject.GetField(),',
23846     '      get: function () {',
23847     '          return this.p;',
23848     '        },',
23849     '      set: function (v) {',
23850     '          this.p = v;',
23851     '        }',
23852     '    }, 5);',
23853     '    var $with = $mod.TObject;',
23854     '    $mod.THelper.Fly.call({',
23855     '      p: $with.GetField(),',
23856     '      get: function () {',
23857     '          return this.p;',
23858     '        },',
23859     '      set: function (v) {',
23860     '          this.p = v;',
23861     '        }',
23862     '    }, 6);',
23863     '    var $with1 = $mod.TObject.GetField();',
23864     '    $mod.THelper.Fly.call({',
23865     '      get: function () {',
23866     '          return $with1;',
23867     '        },',
23868     '      set: function (v) {',
23869     '          $with1 = v;',
23870     '        }',
23871     '    }, 7);',
23872     '    return Result;',
23873     '  };',
23874     '});',
23875     'rtl.createHelper($mod, "THelper", null, function () {',
23876     '  this.Fly = function (n) {',
23877     '  };',
23878     '});',
23879     'this.o = null;',
23880     '']),
23881     LinesToStr([ // $mod.$main
23882     '$mod.THelper.Fly.call({',
23883     '  p: $mod.o.GetField(),',
23884     '  get: function () {',
23885     '      return this.p;',
23886     '    },',
23887     '  set: function (v) {',
23888     '      this.p = v;',
23889     '    }',
23890     '}, 11);',
23891     'var $with = $mod.o;',
23892     '$mod.THelper.Fly.call({',
23893     '  p: $with.GetField(),',
23894     '  get: function () {',
23895     '      return this.p;',
23896     '    },',
23897     '  set: function (v) {',
23898     '      this.p = v;',
23899     '    }',
23900     '}, 12);',
23901     'var $with1 = $mod.o.GetField();',
23902     '$mod.THelper.Fly.call({',
23903     '  get: function () {',
23904     '      return $with1;',
23905     '    },',
23906     '  set: function (v) {',
23907     '      $with1 = v;',
23908     '    }',
23909     '}, 13);',
23910     '']));
23911 end;
23912 
23913 procedure TTestModule.TestTypeHelper_PassClassPropertyGetterNonStatic;
23914 begin
23915   StartProgram(false);
23916   Add([
23917   '{$modeswitch typehelpers}',
23918   'type',
23919   '  TObject = class',
23920   '    class var FField: word;',
23921   '    class function GetField: word;',
23922   '    class property Field: word read GetField write FField;',
23923   '  end;',
23924   '  TClass = class of TObject;',
23925   '  THelper = type helper for word',
23926   '    procedure Fly(n: byte);',
23927   '  end;',
23928   'class function TObject.GetField: word;',
23929   'begin',
23930   '  Field.Fly(1);',
23931   '  Self.Field.Fly(5);',
23932   '  with Self do Field.Fly(6);',
23933   '  with Self.Field do Fly(7);',
23934   'end;',
23935   'procedure THelper.Fly(n: byte);',
23936   'begin',
23937   'end;',
23938   'var',
23939   '  o: TObject;',
23940   '  c: TClass;',
23941   'begin',
23942   '  o.Field.Fly(11);',
23943   '  with o do Field.Fly(12);',
23944   '  with o.Field do Fly(13);',
23945   '  c.Field.Fly(14);',
23946   '  with c do Field.Fly(15);',
23947   '  with c.Field do Fly(16);',
23948   '']);
23949   ConvertProgram;
23950   CheckSource('TestTypeHelper_PassClassPropertyGetterNonStatic',
23951     LinesToStr([ // statements
23952     'rtl.createClass($mod, "TObject", null, function () {',
23953     '  this.FField = 0;',
23954     '  this.$init = function () {',
23955     '  };',
23956     '  this.$final = function () {',
23957     '  };',
23958     '  this.GetField = function () {',
23959     '    var Result = 0;',
23960     '    $mod.THelper.Fly.call({',
23961     '      p: this.GetField(),',
23962     '      get: function () {',
23963     '          return this.p;',
23964     '        },',
23965     '      set: function (v) {',
23966     '          this.p = v;',
23967     '        }',
23968     '    }, 1);',
23969     '    $mod.THelper.Fly.call({',
23970     '      p: this.GetField(),',
23971     '      get: function () {',
23972     '          return this.p;',
23973     '        },',
23974     '      set: function (v) {',
23975     '          this.p = v;',
23976     '        }',
23977     '    }, 5);',
23978     '    $mod.THelper.Fly.call({',
23979     '      p: this.GetField(),',
23980     '      get: function () {',
23981     '          return this.p;',
23982     '        },',
23983     '      set: function (v) {',
23984     '          this.p = v;',
23985     '        }',
23986     '    }, 6);',
23987     '    var $with = this.GetField();',
23988     '    $mod.THelper.Fly.call({',
23989     '      get: function () {',
23990     '          return $with;',
23991     '        },',
23992     '      set: function (v) {',
23993     '          $with = v;',
23994     '        }',
23995     '    }, 7);',
23996     '    return Result;',
23997     '  };',
23998     '});',
23999     'rtl.createHelper($mod, "THelper", null, function () {',
24000     '  this.Fly = function (n) {',
24001     '  };',
24002     '});',
24003     'this.o = null;',
24004     'this.c = null;',
24005     '']),
24006     LinesToStr([ // $mod.$main
24007     '$mod.THelper.Fly.call({',
24008     '  p: $mod.o.$class.GetField(),',
24009     '  get: function () {',
24010     '      return this.p;',
24011     '    },',
24012     '  set: function (v) {',
24013     '      this.p = v;',
24014     '    }',
24015     '}, 11);',
24016     'var $with = $mod.o;',
24017     '$mod.THelper.Fly.call({',
24018     '  p: $with.$class.GetField(),',
24019     '  get: function () {',
24020     '      return this.p;',
24021     '    },',
24022     '  set: function (v) {',
24023     '      this.p = v;',
24024     '    }',
24025     '}, 12);',
24026     'var $with1 = $mod.o.$class.GetField();',
24027     '$mod.THelper.Fly.call({',
24028     '  get: function () {',
24029     '      return $with1;',
24030     '    },',
24031     '  set: function (v) {',
24032     '      $with1 = v;',
24033     '    }',
24034     '}, 13);',
24035     '$mod.THelper.Fly.call({',
24036     '  p: $mod.c.GetField(),',
24037     '  get: function () {',
24038     '      return this.p;',
24039     '    },',
24040     '  set: function (v) {',
24041     '      this.p = v;',
24042     '    }',
24043     '}, 14);',
24044     'var $with2 = $mod.c;',
24045     '$mod.THelper.Fly.call({',
24046     '  p: $with2.GetField(),',
24047     '  get: function () {',
24048     '      return this.p;',
24049     '    },',
24050     '  set: function (v) {',
24051     '      this.p = v;',
24052     '    }',
24053     '}, 15);',
24054     'var $with3 = $mod.c.GetField();',
24055     '$mod.THelper.Fly.call({',
24056     '  get: function () {',
24057     '      return $with3;',
24058     '    },',
24059     '  set: function (v) {',
24060     '      $with3 = v;',
24061     '    }',
24062     '}, 16);',
24063     '']));
24064 end;
24065 
24066 procedure TTestModule.TestTypeHelper_Property;
24067 begin
24068   StartProgram(false);
24069   Add([
24070   '{$modeswitch typehelpers}',
24071   'type',
24072   '  THelper = type helper for word',
24073   '    function GetSize: longint;',
24074   '    procedure SetSize(Value: longint);',
24075   '    property Size: longint read GetSize write SetSize;',
24076   '  end;',
24077   'function THelper.GetSize: longint;',
24078   'begin',
24079   '  Result:=Size+1;',
24080   '  Size:=2;',
24081   '  Result:=Self.Size+3;',
24082   '  Self.Size:=4;',
24083   '  with Self do begin',
24084   '    Result:=Size+5;',
24085   '    Size:=6;',
24086   '  end;',
24087   'end;',
24088   'procedure THelper.SetSize(Value: longint);',
24089   'begin',
24090   'end;',
24091   'var w: word;',
24092   'begin',
24093   '  w:=w.Size+7;',
24094   '  w.Size:=w+8;',
24095   '  with w do begin',
24096   '    w:=Size+9;',
24097   '    Size:=w+10;',
24098   '  end;',
24099   '']);
24100   ConvertProgram;
24101   CheckSource('TestTypeHelper_Property',
24102     LinesToStr([ // statements
24103     'rtl.createHelper($mod, "THelper", null, function () {',
24104     '  this.GetSize = function () {',
24105     '    var Result = 0;',
24106     '    Result = $mod.THelper.GetSize.call(this) + 1;',
24107     '    $mod.THelper.SetSize.call(this, 2);',
24108     '    Result = $mod.THelper.GetSize.call(this) + 3;',
24109     '    $mod.THelper.SetSize.call(this, 4);',
24110     '    var $with = this.get();',
24111     '    Result = $mod.THelper.GetSize.call(this) + 5;',
24112     '    $mod.THelper.SetSize.call(this, 6);',
24113     '    return Result;',
24114     '  };',
24115     '  this.SetSize = function (Value) {',
24116     '  };',
24117     '});',
24118     'this.w = 0;',
24119     '']),
24120     LinesToStr([ // $mod.$main
24121     '$mod.w = $mod.THelper.GetSize.call({',
24122     '  p: $mod,',
24123     '  get: function () {',
24124     '      return this.p.w;',
24125     '    },',
24126     '  set: function (v) {',
24127     '      this.p.w = v;',
24128     '    }',
24129     '}) + 7;',
24130     '$mod.THelper.SetSize.call({',
24131     '  p: $mod,',
24132     '  get: function () {',
24133     '      return this.p.w;',
24134     '    },',
24135     '  set: function (v) {',
24136     '      this.p.w = v;',
24137     '    }',
24138     '}, $mod.w + 8);',
24139     'var $with = $mod.w;',
24140     '$mod.w = $mod.THelper.GetSize.call({',
24141     '  get: function () {',
24142     '      return $with;',
24143     '    },',
24144     '  set: function (v) {',
24145     '      $with = v;',
24146     '    }',
24147     '}) + 9;',
24148     '$mod.THelper.SetSize.call({',
24149     '  get: function () {',
24150     '      return $with;',
24151     '    },',
24152     '  set: function (v) {',
24153     '      $with = v;',
24154     '    }',
24155     '}, $mod.w + 10);',
24156     '']));
24157 end;
24158 
24159 procedure TTestModule.TestTypeHelper_Property_Array;
24160 begin
24161   StartProgram(false);
24162   Add([
24163   '{$modeswitch typehelpers}',
24164   'type',
24165   '  THelper = type helper for word',
24166   '    function GetItems(Index: byte): boolean;',
24167   '    procedure SetItems(Index: byte; Value: boolean);',
24168   '    property Items[Index: byte]: boolean read GetItems write SetItems;',
24169   '  end;',
24170   'function THelper.GetItems(Index: byte): boolean;',
24171   'begin',
24172   '  Result:=Items[1];',
24173   '  Items[2]:=false;',
24174   '  Result:=Self.Items[3];',
24175   '  Self.Items[4]:=true;',
24176   '  with Self do begin',
24177   '    Result:=Items[5];',
24178   '    Items[6]:=false;',
24179   '  end;',
24180   'end;',
24181   'procedure THelper.SetItems(Index: byte; Value: boolean);',
24182   'begin',
24183   'end;',
24184   'var',
24185   '  w: word;',
24186   '  b: boolean;',
24187   'begin',
24188   '  b:=w.Items[1];',
24189   '  w.Items[2]:=b;',
24190   '  with w do begin',
24191   '    b:=Items[3];',
24192   '    Items[4]:=b;',
24193   '  end;',
24194   '']);
24195   ConvertProgram;
24196   CheckSource('TestTypeHelper_Property_Array',
24197     LinesToStr([ // statements
24198     'rtl.createHelper($mod, "THelper", null, function () {',
24199     '  this.GetItems = function (Index) {',
24200     '    var Result = false;',
24201     '    Result = $mod.THelper.GetItems.call(this, 1);',
24202     '    $mod.THelper.SetItems.call(this, 2, false);',
24203     '    Result = $mod.THelper.GetItems.call(this, 3);',
24204     '    $mod.THelper.SetItems.call(this, 4, true);',
24205     '    var $with = this.get();',
24206     '    Result = $mod.THelper.GetItems.call(this, 5);',
24207     '    $mod.THelper.SetItems.call(this, 6, false);',
24208     '    return Result;',
24209     '  };',
24210     '  this.SetItems = function (Index, Value) {',
24211     '  };',
24212     '});',
24213     'this.w = 0;',
24214     'this.b = false;',
24215     '']),
24216     LinesToStr([ // $mod.$main
24217     '$mod.b = $mod.THelper.GetItems.call({',
24218     '  p: $mod,',
24219     '  get: function () {',
24220     '      return this.p.w;',
24221     '    },',
24222     '  set: function (v) {',
24223     '      this.p.w = v;',
24224     '    }',
24225     '}, 1);',
24226     '$mod.THelper.SetItems.call({',
24227     '  p: $mod,',
24228     '  get: function () {',
24229     '      return this.p.w;',
24230     '    },',
24231     '  set: function (v) {',
24232     '      this.p.w = v;',
24233     '    }',
24234     '}, 2, $mod.b);',
24235     'var $with = $mod.w;',
24236     '$mod.b = $mod.THelper.GetItems.call({',
24237     '  get: function () {',
24238     '      return $with;',
24239     '    },',
24240     '  set: function (v) {',
24241     '      $with = v;',
24242     '    }',
24243     '}, 3);',
24244     '$mod.THelper.SetItems.call({',
24245     '  get: function () {',
24246     '      return $with;',
24247     '    },',
24248     '  set: function (v) {',
24249     '      $with = v;',
24250     '    }',
24251     '}, 4, $mod.b);',
24252     '']));
24253 end;
24254 
24255 procedure TTestModule.TestTypeHelper_ClassProperty;
24256 begin
24257   StartProgram(false);
24258   Add([
24259   '{$modeswitch typehelpers}',
24260   'type',
24261   '  THelper = type helper for word',
24262   '    class function GetSize: longint; static;',
24263   '    class procedure SetSize(Value: longint); static;',
24264   '    class property Size: longint read GetSize write SetSize;',
24265   '  end;',
24266   'class function THelper.GetSize: longint;',
24267   'begin',
24268   '  Result:=Size+1;',
24269   '  Size:=2;',
24270   'end;',
24271   'class procedure THelper.SetSize(Value: longint);',
24272   'begin',
24273   'end;',
24274   'begin',
24275   '']);
24276   ConvertProgram;
24277   CheckSource('TestTypeHelper_ClassProperty',
24278     LinesToStr([ // statements
24279     'rtl.createHelper($mod, "THelper", null, function () {',
24280     '  this.GetSize = function () {',
24281     '    var Result = 0;',
24282     '    Result = $mod.THelper.GetSize() + 1;',
24283     '    $mod.THelper.SetSize(2);',
24284     '    return Result;',
24285     '  };',
24286     '  this.SetSize = function (Value) {',
24287     '  };',
24288     '});',
24289     '']),
24290     LinesToStr([ // $mod.$main
24291     '']));
24292 end;
24293 
24294 procedure TTestModule.TestTypeHelper_ClassProperty_Array;
24295 begin
24296   StartProgram(false);
24297   Add([
24298   '{$modeswitch typehelpers}',
24299   'type',
24300   '  THelper = type helper for word',
24301   '    class function GetItems(Index: byte): boolean; static;',
24302   '    class procedure SetItems(Index: byte; Value: boolean); static;',
24303   '    class property Items[Index: byte]: boolean read GetItems write SetItems;',
24304   '  end;',
24305   'class function THelper.GetItems(Index: byte): boolean;',
24306   'begin',
24307   '  Result:=Items[1];',
24308   '  Items[2]:=false;',
24309   'end;',
24310   'class procedure THelper.SetItems(Index: byte; Value: boolean);',
24311   'begin',
24312   'end;',
24313   'var',
24314   '  w: word;',
24315   '  b: boolean;',
24316   'begin',
24317   '  b:=w.Items[1];',
24318   '  w.Items[2]:=b;',
24319   '  with w do begin',
24320   '    b:=Items[3];',
24321   '    Items[4]:=b;',
24322   '  end;',
24323   '']);
24324   ConvertProgram;
24325   CheckSource('TestTypeHelper_ClassProperty_Array',
24326     LinesToStr([ // statements
24327     'rtl.createHelper($mod, "THelper", null, function () {',
24328     '  this.GetItems = function (Index) {',
24329     '    var Result = false;',
24330     '    Result = $mod.THelper.GetItems(1);',
24331     '    $mod.THelper.SetItems(2, false);',
24332     '    return Result;',
24333     '  };',
24334     '  this.SetItems = function (Index, Value) {',
24335     '  };',
24336     '});',
24337     'this.w = 0;',
24338     'this.b = false;',
24339     '']),
24340     LinesToStr([ // $mod.$main
24341     '$mod.b = $mod.THelper.GetItems(1);',
24342     '$mod.THelper.SetItems(2, $mod.b);',
24343     'var $with = $mod.w;',
24344     '$mod.b = $mod.THelper.GetItems(3);',
24345     '$mod.THelper.SetItems(4, $mod.b);',
24346     '']));
24347 end;
24348 
24349 procedure TTestModule.TestTypeHelper_ClassMethod;
24350 begin
24351   StartProgram(false);
24352   Add([
24353   '{$modeswitch typehelpers}',
24354   'type',
24355   '  THelper = type helper for word',
24356   '    class procedure DoStatic; static;',
24357   '  end;',
24358   'class procedure THelper.DoStatic;',
24359   'begin',
24360   '  DoStatic;',
24361   '  DoStatic();',
24362   'end;',
24363   'var w: word;',
24364   'begin',
24365   '  w.DoStatic;',
24366   '  w.DoStatic();',
24367   '']);
24368   ConvertProgram;
24369   CheckSource('TestTypeHelper_ClassMethod',
24370     LinesToStr([ // statements
24371     'rtl.createHelper($mod, "THelper", null, function () {',
24372     '  this.DoStatic = function () {',
24373     '    $mod.THelper.DoStatic();',
24374     '    $mod.THelper.DoStatic();',
24375     '  };',
24376     '});',
24377     'this.w = 0;',
24378     '']),
24379     LinesToStr([ // $mod.$main
24380     '$mod.THelper.DoStatic();',
24381     '$mod.THelper.DoStatic();',
24382     '']));
24383 end;
24384 
24385 procedure TTestModule.TestTypeHelper_ExtClassMethodFail;
24386 begin
24387   StartProgram(false);
24388   Add([
24389   '{$modeswitch typehelpers}',
24390   'type',
24391   '  THelper = type helper for word',
24392   '    procedure Run; external name ''Run'';',
24393   '  end;',
24394   'var w: word;',
24395   'begin',
24396   '  w.Run;',
24397   '']);
24398   SetExpectedPasResolverError('Not supported: external method in type helper',nNotSupportedX);
24399   ConvertProgram;
24400 end;
24401 
24402 procedure TTestModule.TestTypeHelper_Constructor;
24403 begin
24404   StartProgram(false);
24405   Add([
24406   '{$modeswitch typehelpers}',
24407   'type',
24408   '  THelper = type helper for word',
24409   '    constructor Init(e: longint);',
24410   '  end;',
24411   'constructor THelper.Init(e: longint);',
24412   'begin',
24413   '  Self:=e;',
24414   '  Init(e+1);',
24415   'end;',
24416   'var w: word;',
24417   'begin',
24418   '  w:=word.Init(2);',
24419   '  w:=w.Init(3);',
24420   '  with word do w:=Init(4);',
24421   '  with w do w:=Init(5);',
24422   '']);
24423   ConvertProgram;
24424   CheckSource('TestTypeHelper_Constructor',
24425     LinesToStr([ // statements
24426     'rtl.createHelper($mod, "THelper", null, function () {',
24427     '  this.Init = function (e) {',
24428     '    this.set(e);',
24429     '    $mod.THelper.Init.call(this, e + 1);',
24430     '    return this.get();',
24431     '  };',
24432     '  this.$new = function (fn, args) {',
24433     '    return this[fn].apply({',
24434     '      p: 0,',
24435     '      get: function () {',
24436     '          return this.p;',
24437     '        },',
24438     '      set: function (v) {',
24439     '          this.p = v;',
24440     '        }',
24441     '    }, args);',
24442     '  };',
24443     '});',
24444     'this.w = 0;',
24445     '']),
24446     LinesToStr([ // $mod.$main
24447     '$mod.w = $mod.THelper.$new("Init", [2]);',
24448     '$mod.w = $mod.THelper.Init.call({',
24449     '  p: $mod,',
24450     '  get: function () {',
24451     '      return this.p.w;',
24452     '    },',
24453     '  set: function (v) {',
24454     '      this.p.w = v;',
24455     '    }',
24456     '}, 3);',
24457     '$mod.w = $mod.THelper.$new("Init", [4]);',
24458     'var $with = $mod.w;',
24459     '$mod.w = $mod.THelper.Init.call({',
24460     '  get: function () {',
24461     '      return $with;',
24462     '    },',
24463     '  set: function (v) {',
24464     '      $with = v;',
24465     '    }',
24466     '}, 5);',
24467     '']));
24468 end;
24469 
24470 procedure TTestModule.TestTypeHelper_Word;
24471 begin
24472   StartProgram(false);
24473   Add([
24474   '{$modeswitch typehelpers}',
24475   'type',
24476   '  THelper = type helper for word',
24477   '    procedure DoIt(e: byte = 123);',
24478   '  end;',
24479   'procedure THelper.DoIt(e: byte);',
24480   'begin',
24481   '  Self:=e;',
24482   '  Self:=Self+1;',
24483   '  with Self do Doit;',
24484   'end;',
24485   'begin',
24486   '  word(3).DoIt;',
24487   '']);
24488   ConvertProgram;
24489   CheckSource('TestTypeHelper_Word',
24490     LinesToStr([ // statements
24491     'rtl.createHelper($mod, "THelper", null, function () {',
24492     '  this.DoIt = function (e) {',
24493     '    this.set(e);',
24494     '    this.set(this.get() + 1);',
24495     '    var $with = this.get();',
24496     '    $mod.THelper.DoIt.call(this, 123);',
24497     '  };',
24498     '});',
24499     '']),
24500     LinesToStr([ // $mod.$main
24501     '$mod.THelper.DoIt.call({',
24502     '  get: function () {',
24503     '      return 3;',
24504     '    },',
24505     '  set: function (v) {',
24506     '      rtl.raiseE("EPropReadOnly");',
24507     '    }',
24508     '}, 123);',
24509     '']));
24510 end;
24511 
24512 procedure TTestModule.TestTypeHelper_Boolean;
24513 begin
24514   StartProgram(false);
24515   Add([
24516   '{$modeswitch typehelpers}',
24517   'type',
24518   '  Integer = longint;',
24519   '  THelper = type helper for boolean',
24520   '    procedure Run(e: wordbool = true);',
24521   '  end;',
24522   'procedure THelper.Run(e: wordbool);',
24523   'begin',
24524   '  Self:=e;',
24525   '  Self:=not Self;',
24526   '  with Self do Run;',
24527   '  if Integer(Self)=0 then ;',
24528   'end;',
24529   'begin',
24530   '  boolean(3).Run;',
24531   '']);
24532   ConvertProgram;
24533   CheckSource('TestTypeHelper_Boolean',
24534     LinesToStr([ // statements
24535     'rtl.createHelper($mod, "THelper", null, function () {',
24536     '  this.Run = function (e) {',
24537     '    this.set(e);',
24538     '    this.set(!this.get());',
24539     '    var $with = this.get();',
24540     '    $mod.THelper.Run.call(this, true);',
24541     '    if ((this.get() ? 1 : 0) === 0) ;',
24542     '  };',
24543     '});',
24544     '']),
24545     LinesToStr([ // $mod.$main
24546     '$mod.THelper.Run.call({',
24547     '  a: 3 != 0,',
24548     '  get: function () {',
24549     '      return this.a;',
24550     '    },',
24551     '  set: function (v) {',
24552     '      rtl.raiseE("EPropReadOnly");',
24553     '    }',
24554     '}, true);',
24555     '']));
24556 end;
24557 
24558 procedure TTestModule.TestTypeHelper_WordBool;
24559 begin
24560   StartProgram(false);
24561   Add([
24562   '{$modeswitch typehelpers}',
24563   'type',
24564   '  Integer = longint;',
24565   '  THelper = type helper for WordBool',
24566   '    procedure Run(e: wordbool = true);',
24567   '  end;',
24568   'procedure THelper.Run(e: wordbool);',
24569   'var i: integer;',
24570   'begin',
24571   '  i:=Integer(Self);',
24572   'end;',
24573   'var w: wordbool;',
24574   'begin',
24575   '  w.Run;',
24576   '  wordbool(3).Run;',
24577   '']);
24578   ConvertProgram;
24579   CheckSource('TestTypeHelper_WordBool',
24580     LinesToStr([ // statements
24581     'rtl.createHelper($mod, "THelper", null, function () {',
24582     '  this.Run = function (e) {',
24583     '    var i = 0;',
24584     '    i = (this.get() ? 1 : 0);',
24585     '  };',
24586     '});',
24587     'this.w = false;',
24588     '']),
24589     LinesToStr([ // $mod.$main
24590     '$mod.THelper.Run.call({',
24591     '  p: $mod,',
24592     '  get: function () {',
24593     '      return this.p.w;',
24594     '    },',
24595     '  set: function (v) {',
24596     '      this.p.w = v;',
24597     '    }',
24598     '}, true);',
24599     '$mod.THelper.Run.call({',
24600     '  a: 3 != 0,',
24601     '  get: function () {',
24602     '      return this.a;',
24603     '    },',
24604     '  set: function (v) {',
24605     '      rtl.raiseE("EPropReadOnly");',
24606     '    }',
24607     '}, true);',
24608     '']));
24609 end;
24610 
24611 procedure TTestModule.TestTypeHelper_Double;
24612 begin
24613   StartProgram(false);
24614   Add([
24615   '{$modeswitch typehelpers}',
24616   'type',
24617   '  Float = type double;',
24618   '  THelper = type helper for Float',
24619   '    const NPI = 3.141592;',
24620   '    function ToStr: String;',
24621   '  end;',
24622   'function THelper.ToStr: String;',
24623   'begin',
24624   'end;',
24625   'procedure DoIt(s: string);',
24626   'begin',
24627   'end;',
24628   'var f: Float;',
24629   'begin',
24630   '  DoIt(f.toStr);',
24631   '  DoIt(f.toStr());',
24632   '  (f*f).toStr;',
24633   '  DoIt((f*f).toStr);',
24634   '']);
24635   ConvertProgram;
24636   CheckSource('TestTypeHelper_Double',
24637     LinesToStr([ // statements
24638     'rtl.createHelper($mod, "THelper", null, function () {',
24639     '  this.NPI = 3.141592;',
24640     '  this.ToStr = function () {',
24641     '    var Result = "";',
24642     '    return Result;',
24643     '  };',
24644     '});',
24645     'this.DoIt = function (s) {',
24646     '};',
24647     'this.f = 0.0;',
24648     '']),
24649     LinesToStr([ // $mod.$main
24650     '$mod.DoIt($mod.THelper.ToStr.call({',
24651     '  p: $mod,',
24652     '  get: function () {',
24653     '      return this.p.f;',
24654     '    },',
24655     '  set: function (v) {',
24656     '      this.p.f = v;',
24657     '    }',
24658     '}));',
24659     '$mod.DoIt($mod.THelper.ToStr.call({',
24660     '  p: $mod,',
24661     '  get: function () {',
24662     '      return this.p.f;',
24663     '    },',
24664     '  set: function (v) {',
24665     '      this.p.f = v;',
24666     '    }',
24667     '}));',
24668     '$mod.THelper.ToStr.call({',
24669     '  a: $mod.f * $mod.f,',
24670     '  get: function () {',
24671     '      return this.a;',
24672     '    },',
24673     '  set: function (v) {',
24674     '      rtl.raiseE("EPropReadOnly");',
24675     '    }',
24676     '});',
24677     '$mod.DoIt($mod.THelper.ToStr.call({',
24678     '  a: $mod.f * $mod.f,',
24679     '  get: function () {',
24680     '      return this.a;',
24681     '    },',
24682     '  set: function (v) {',
24683     '      rtl.raiseE("EPropReadOnly");',
24684     '    }',
24685     '}));',
24686     '']));
24687 end;
24688 
24689 procedure TTestModule.TestTypeHelper_NativeInt;
24690 begin
24691   StartProgram(false);
24692   Add([
24693   '{$modeswitch typehelpers}',
24694   'type',
24695   '  MaxInt = type nativeint;',
24696   '  THelperI = type helper for MaxInt',
24697   '    function ToStr: String;',
24698   '  end;',
24699   '  MaxUInt = type nativeuint;',
24700   '  THelperU = type helper for MaxUInt',
24701   '    function ToStr: String;',
24702   '  end;',
24703   'function THelperI.ToStr: String;',
24704   'begin',
24705   '  Result:=str(Self);',
24706   'end;',
24707   'function THelperU.ToStr: String;',
24708   'begin',
24709   '  Result:=str(Self);',
24710   'end;',
24711   'procedure DoIt(s: string);',
24712   'begin',
24713   'end;',
24714   'var i: MaxInt;',
24715   'begin',
24716   '  DoIt(i.toStr);',
24717   '  DoIt(i.toStr());',
24718   '  (i*i).toStr;',
24719   '  DoIt((i*i).toStr);',
24720   '']);
24721   ConvertProgram;
24722   CheckSource('TestTypeHelper_NativeInt',
24723     LinesToStr([ // statements
24724     'rtl.createHelper($mod, "THelperI", null, function () {',
24725     '  this.ToStr = function () {',
24726     '    var Result = "";',
24727     '    Result = "" + this.get();',
24728     '    return Result;',
24729     '  };',
24730     '});',
24731     'rtl.createHelper($mod, "THelperU", null, function () {',
24732     '  this.ToStr = function () {',
24733     '    var Result = "";',
24734     '    Result = "" + this.get();',
24735     '    return Result;',
24736     '  };',
24737     '});',
24738     'this.DoIt = function (s) {',
24739     '};',
24740     'this.i = 0;',
24741     '']),
24742     LinesToStr([ // $mod.$main
24743     '$mod.DoIt($mod.THelperI.ToStr.call({',
24744     '  p: $mod,',
24745     '  get: function () {',
24746     '      return this.p.i;',
24747     '    },',
24748     '  set: function (v) {',
24749     '      this.p.i = v;',
24750     '    }',
24751     '}));',
24752     '$mod.DoIt($mod.THelperI.ToStr.call({',
24753     '  p: $mod,',
24754     '  get: function () {',
24755     '      return this.p.i;',
24756     '    },',
24757     '  set: function (v) {',
24758     '      this.p.i = v;',
24759     '    }',
24760     '}));',
24761     '$mod.THelperI.ToStr.call({',
24762     '  a: $mod.i * $mod.i,',
24763     '  get: function () {',
24764     '      return this.a;',
24765     '    },',
24766     '  set: function (v) {',
24767     '      rtl.raiseE("EPropReadOnly");',
24768     '    }',
24769     '});',
24770     '$mod.DoIt($mod.THelperI.ToStr.call({',
24771     '  a: $mod.i * $mod.i,',
24772     '  get: function () {',
24773     '      return this.a;',
24774     '    },',
24775     '  set: function (v) {',
24776     '      rtl.raiseE("EPropReadOnly");',
24777     '    }',
24778     '}));',
24779     '']));
24780 end;
24781 
24782 procedure TTestModule.TestTypeHelper_StringChar;
24783 begin
24784   StartProgram(false);
24785   Add([
24786   '{$modeswitch typehelpers}',
24787   'type',
24788   '  TStringHelper = type helper for string',
24789   '    procedure DoIt(e: byte = 123);',
24790   '  end;',
24791   '  TCharHelper = type helper for char',
24792   '    procedure Fly;',
24793   '  end;',
24794   'procedure TStringHelper.DoIt(e: byte);',
24795   'begin',
24796   '  Self[1]:=''c'';',
24797   '  Self[2]:=Self[3];',
24798   'end;',
24799   'procedure TCharHelper.Fly;',
24800   'begin',
24801   '  Self:=''c'';',
24802   'end;',
24803   'begin',
24804   '  ''abc''.DoIt;',
24805   '  ''xyz''.DoIt();',
24806   '  ''c''.Fly();',
24807   '']);
24808   ConvertProgram;
24809   CheckSource('TestTypeHelper_StringChar',
24810     LinesToStr([ // statements
24811     'rtl.createHelper($mod, "TStringHelper", null, function () {',
24812     '  this.DoIt = function (e) {',
24813     '    this.set(rtl.setCharAt(this.get(), 0, "c"));',
24814     '    this.set(rtl.setCharAt(this.get(), 1, this.get().charAt(2)));',
24815     '  };',
24816     '});',
24817     'rtl.createHelper($mod, "TCharHelper", null, function () {',
24818     '  this.Fly = function () {',
24819     '    this.set("c");',
24820     '  };',
24821     '});',
24822     '']),
24823     LinesToStr([ // $mod.$main
24824     '$mod.TStringHelper.DoIt.call({',
24825     '  get: function () {',
24826     '      return "abc";',
24827     '    },',
24828     '  set: function (v) {',
24829     '      rtl.raiseE("EPropReadOnly");',
24830     '    }',
24831     '}, 123);',
24832     '$mod.TStringHelper.DoIt.call({',
24833     '  get: function () {',
24834     '      return "xyz";',
24835     '    },',
24836     '  set: function (v) {',
24837     '      rtl.raiseE("EPropReadOnly");',
24838     '    }',
24839     '}, 123);',
24840     '$mod.TCharHelper.Fly.call({',
24841     '  get: function () {',
24842     '      return "c";',
24843     '    },',
24844     '  set: function (v) {',
24845     '      rtl.raiseE("EPropReadOnly");',
24846     '    }',
24847     '});',
24848     '']));
24849 end;
24850 
24851 procedure TTestModule.TestTypeHelper_JSValue;
24852 begin
24853   StartProgram(false);
24854   Add([
24855   '{$modeswitch typehelpers}',
24856   'type',
24857   '  TExtValue = type jsvalue;',
24858   '  THelper = type helper for TExtValue',
24859   '    function ToStr: String;',
24860   '  end;',
24861   'function THelper.ToStr: String;',
24862   'begin',
24863   'end;',
24864   'var',
24865   '  s: string;',
24866   '  v: TExtValue;',
24867   'begin',
24868   '  s:=v.toStr;',
24869   '  s:=v.toStr();',
24870   '  TExtValue(s).toStr;',
24871   '']);
24872   ConvertProgram;
24873   CheckSource('TestTypeHelper_JSValue',
24874     LinesToStr([ // statements
24875     'rtl.createHelper($mod, "THelper", null, function () {',
24876     '  this.ToStr = function () {',
24877     '    var Result = "";',
24878     '    return Result;',
24879     '  };',
24880     '});',
24881     'this.s = "";',
24882     'this.v = undefined;',
24883     '']),
24884     LinesToStr([ // $mod.$main
24885     '$mod.s = $mod.THelper.ToStr.call({',
24886     '  p: $mod,',
24887     '  get: function () {',
24888     '      return this.p.v;',
24889     '    },',
24890     '  set: function (v) {',
24891     '      this.p.v = v;',
24892     '    }',
24893     '});',
24894     '$mod.s = $mod.THelper.ToStr.call({',
24895     '  p: $mod,',
24896     '  get: function () {',
24897     '      return this.p.v;',
24898     '    },',
24899     '  set: function (v) {',
24900     '      this.p.v = v;',
24901     '    }',
24902     '});',
24903     '$mod.THelper.ToStr.call({',
24904     '  p: $mod,',
24905     '  get: function () {',
24906     '      return this.p.s;',
24907     '    },',
24908     '  set: function (v) {',
24909     '      rtl.raiseE("EPropReadOnly");',
24910     '    }',
24911     '});',
24912     '']));
24913 end;
24914 
24915 procedure TTestModule.TestTypeHelper_Array;
24916 begin
24917   StartProgram(false);
24918   Add([
24919   '{$modeswitch typehelpers}',
24920   'type',
24921   '  TArrOfBool = array of boolean;',
24922   '  TArrOfJS = array of jsvalue;',
24923   '  THelper = type helper for TArrOfBool',
24924   '    procedure DoIt(e: byte = 123);',
24925   '  end;',
24926   'procedure THelper.DoIt(e: byte);',
24927   'begin',
24928   '  Self[1]:=true;',
24929   '  Self[2]:=not Self[3];',
24930   '  SetLength(Self,4);',
24931   'end;',
24932   'var',
24933   '  b: TArrOfBool;',
24934   '  j: TArrOfJS;',
24935   'begin',
24936   '  b.DoIt;',
24937   '  TArrOfBool(j).DoIt();',
24938   '']);
24939   ConvertProgram;
24940   CheckSource('TestTypeHelper_Array',
24941     LinesToStr([ // statements
24942     'rtl.createHelper($mod, "THelper", null, function () {',
24943     '  this.DoIt = function (e) {',
24944     '    this.get()[1] = true;',
24945     '    this.get()[2] = !this.get()[3];',
24946     '    this.set(rtl.arraySetLength(this.get(), false, 4));',
24947     '  };',
24948     '});',
24949     'this.b = [];',
24950     'this.j = [];',
24951     '']),
24952     LinesToStr([ // $mod.$main
24953     '$mod.THelper.DoIt.call({',
24954     '  p: $mod,',
24955     '  get: function () {',
24956     '      return this.p.b;',
24957     '    },',
24958     '  set: function (v) {',
24959     '      this.p.b = v;',
24960     '    }',
24961     '}, 123);',
24962     '$mod.THelper.DoIt.call({',
24963     '  p: $mod,',
24964     '  get: function () {',
24965     '      return this.p.j;',
24966     '    },',
24967     '  set: function (v) {',
24968     '      this.p.j = v;',
24969     '    }',
24970     '}, 123);',
24971     '']));
24972 end;
24973 
24974 procedure TTestModule.TestTypeHelper_EnumType;
24975 begin
24976   StartProgram(false);
24977   Add([
24978   '{$modeswitch typehelpers}',
24979   'type',
24980   '  TEnum = (red,blue);',
24981   '  THelper = type helper for TEnum',
24982   '    procedure DoIt(e: byte = 123);',
24983   '    class procedure Swing(w: word); static;',
24984   '  end;',
24985   'procedure THelper.DoIt(e: byte);',
24986   'begin',
24987   '  Self:=red;',
24988   '  Self:=succ(Self);',
24989   '  with Self do Doit;',
24990   'end;',
24991   'class procedure THelper.Swing(w: word);',
24992   'begin',
24993   'end;',
24994   'var e: TEnum;',
24995   'begin',
24996   '  e.DoIt;',
24997   '  red.DoIt;',
24998   '  TEnum.blue.DoIt;',
24999   '  TEnum(1).DoIt;',
25000   '  TEnum.Swing(3);',
25001   '']);
25002   ConvertProgram;
25003   CheckSource('TestTypeHelper_EnumType',
25004     LinesToStr([ // statements
25005     'this.TEnum = {',
25006     '  "0": "red",',
25007     '  red: 0,',
25008     '  "1": "blue",',
25009     '  blue: 1',
25010     '};',
25011     'rtl.createHelper($mod, "THelper", null, function () {',
25012     '  this.DoIt = function (e) {',
25013     '    this.set($mod.TEnum.red);',
25014     '    this.set(this.get() + 1);',
25015     '    var $with = this.get();',
25016     '    $mod.THelper.DoIt.call(this, 123);',
25017     '  };',
25018     '  this.Swing = function (w) {',
25019     '  };',
25020     '});',
25021     'this.e = 0;',
25022     '']),
25023     LinesToStr([ // $mod.$main
25024     '$mod.THelper.DoIt.call({',
25025     '  p: $mod,',
25026     '  get: function () {',
25027     '      return this.p.e;',
25028     '    },',
25029     '  set: function (v) {',
25030     '      this.p.e = v;',
25031     '    }',
25032     '}, 123);',
25033     '$mod.THelper.DoIt.call({',
25034     '  p: $mod.TEnum,',
25035     '  get: function () {',
25036     '      return this.p.red;',
25037     '    },',
25038     '  set: function (v) {',
25039     '      rtl.raiseE("EPropReadOnly");',
25040     '    }',
25041     '}, 123);',
25042     '$mod.THelper.DoIt.call({',
25043     '  p: $mod.TEnum,',
25044     '  get: function () {',
25045     '      return this.p.blue;',
25046     '    },',
25047     '  set: function (v) {',
25048     '      rtl.raiseE("EPropReadOnly");',
25049     '    }',
25050     '}, 123);',
25051     '$mod.THelper.DoIt.call({',
25052     '  get: function () {',
25053     '      return 1;',
25054     '    },',
25055     '  set: function (v) {',
25056     '      rtl.raiseE("EPropReadOnly");',
25057     '    }',
25058     '}, 123);',
25059     '$mod.THelper.Swing(3);',
25060     '']));
25061 end;
25062 
25063 procedure TTestModule.TestTypeHelper_SetType;
25064 begin
25065   StartProgram(false);
25066   Add([
25067   '{$modeswitch typehelpers}',
25068   'type',
25069   '  TEnum = (red,blue);',
25070   '  TSetOfEnum = set of TEnum;',
25071   '  THelper = type helper for TSetOfEnum',
25072   '    procedure DoIt(e: byte = 123);',
25073   '    constructor Init(e: TEnum);',
25074   '    constructor InitEmpty;',
25075   '  end;',
25076   'procedure THelper.DoIt(e: byte);',
25077   'begin',
25078   '  Self:=[];',
25079   '  Self:=[red];',
25080   '  Include(Self,blue);',
25081   'end;',
25082   'constructor THelper.Init(e: TEnum);',
25083   'begin',
25084   '  Self:=[];',
25085   '  Self:=[e];',
25086   '  Include(Self,blue);',
25087   'end;',
25088   'constructor THelper.InitEmpty;',
25089   'begin',
25090   'end;',
25091   'var s: TSetOfEnum;',
25092   'begin',
25093   '  s.DoIt;',
25094   //'  [red].DoIt;',
25095   //'  with s do DoIt;',
25096   //'  with [red,blue] do DoIt;',
25097   '  s:=TSetOfEnum.Init(blue);',
25098   '  s:=s.Init(blue);',
25099   '']);
25100   ConvertProgram;
25101   CheckSource('TestTypeHelper_SetType',
25102     LinesToStr([ // statements
25103     'this.TEnum = {',
25104     '  "0": "red",',
25105     '  red: 0,',
25106     '  "1": "blue",',
25107     '  blue: 1',
25108     '};',
25109     'rtl.createHelper($mod, "THelper", null, function () {',
25110     '  this.DoIt = function (e) {',
25111     '    this.set({});',
25112     '    this.set(rtl.createSet($mod.TEnum.red));',
25113     '    this.set(rtl.includeSet(this.get(), $mod.TEnum.blue));',
25114     '  };',
25115     '  this.Init = function (e) {',
25116     '    this.set({});',
25117     '    this.set(rtl.createSet(e));',
25118     '    this.set(rtl.includeSet(this.get(), $mod.TEnum.blue));',
25119     '    return this.get();',
25120     '  };',
25121     '  this.InitEmpty = function () {',
25122     '    return this.get();',
25123     '  };',
25124     '  this.$new = function (fn, args) {',
25125     '    return this[fn].apply({',
25126     '      p: {},',
25127     '      get: function () {',
25128     '          return this.p;',
25129     '        },',
25130     '      set: function (v) {',
25131     '          this.p = v;',
25132     '        }',
25133     '    }, args);',
25134     '  };',
25135     '});',
25136     'this.s = {};',
25137     '']),
25138     LinesToStr([ // $mod.$main
25139     '$mod.THelper.DoIt.call({',
25140     '  p: $mod,',
25141     '  get: function () {',
25142     '      return this.p.s;',
25143     '    },',
25144     '  set: function (v) {',
25145     '      this.p.s = v;',
25146     '    }',
25147     '}, 123);',
25148     '$mod.s = rtl.refSet($mod.THelper.$new("Init", [$mod.TEnum.blue]));',
25149     '$mod.s = rtl.refSet($mod.THelper.Init.call({',
25150     '  p: $mod,',
25151     '  get: function () {',
25152     '      return this.p.s;',
25153     '    },',
25154     '  set: function (v) {',
25155     '      this.p.s = v;',
25156     '    }',
25157     '}, $mod.TEnum.blue));',
25158     '']));
25159 end;
25160 
25161 procedure TTestModule.TestTypeHelper_InterfaceType;
25162 begin
25163   StartProgram(false);
25164   Add([
25165   '{$interfaces com}',
25166   '{$modeswitch typehelpers}',
25167   'type',
25168   '  IUnknown = interface',
25169   '    function _AddRef: longint;',
25170   '    function _Release: longint;',
25171   '  end;',
25172   '  TObject = class(IUnknown)',
25173   '    function _AddRef: longint; virtual; abstract;',
25174   '    function _Release: longint; virtual; abstract;',
25175   '  end;',
25176   '  THelper = type helper for IUnknown',
25177   '    procedure Fly(e: byte = 123);',
25178   '    class procedure Run; static;',
25179   '  end;',
25180   'var',
25181   '  i: IUnknown;',
25182   '  o: TObject;',
25183   'procedure THelper.Fly(e: byte);',
25184   'begin',
25185   '  i:=Self;',
25186   '  o:=Self as TObject;',
25187   '  Self:=nil;',
25188   '  Self:=i;',
25189   '  Self:=o;',
25190   '  with Self do begin',
25191   '    Fly;',
25192   '    Fly();',
25193   '  end;',
25194   'end;',
25195   'class procedure THelper.Run;',
25196   'var l: IUnknown;',
25197   'begin',
25198   '  l.Fly;',
25199   '  l.Fly();',
25200   'end;',
25201   'begin',
25202   '  i.Fly;',
25203   '  i.Fly();',
25204   '  i.Run;',
25205   '  i.Run();',
25206   '  IUnknown.Run;',
25207   '  IUnknown.Run();',
25208   '']);
25209   ConvertProgram;
25210   CheckSource('TestTypeHelper_InterfaceType',
25211     LinesToStr([ // statements
25212     'rtl.createInterface($mod, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
25213     'rtl.createClass($mod, "TObject", null, function () {',
25214     '  this.$init = function () {',
25215     '  };',
25216     '  this.$final = function () {',
25217     '  };',
25218     '  rtl.addIntf(this, $mod.IUnknown);',
25219     '});',
25220     'rtl.createHelper($mod, "THelper", null, function () {',
25221     '  this.Fly = function (e) {',
25222     '    var $ir = rtl.createIntfRefs();',
25223     '    try {',
25224     '      rtl.setIntfP($mod, "i", this.get());',
25225     '      $mod.o = rtl.intfAsClass(this.get(), $mod.TObject);',
25226     '      this.set(null);',
25227     '      this.set($mod.i);',
25228     '      this.set($ir.ref(1, rtl.queryIntfT($mod.o, $mod.IUnknown)));',
25229     '      var $with = this.get();',
25230     '      $mod.THelper.Fly.call(this, 123);',
25231     '      $mod.THelper.Fly.call(this, 123);',
25232     '    } finally {',
25233     '      $ir.free();',
25234     '    };',
25235     '  };',
25236     '  this.Run = function () {',
25237     '    var l = null;',
25238     '    try {',
25239     '      $mod.THelper.Fly.call({',
25240     '        get: function () {',
25241     '            return l;',
25242     '          },',
25243     '        set: function (v) {',
25244     '            l = rtl.setIntfL(l, v);',
25245     '          }',
25246     '      }, 123);',
25247     '      $mod.THelper.Fly.call({',
25248     '        get: function () {',
25249     '            return l;',
25250     '          },',
25251     '        set: function (v) {',
25252     '            l = rtl.setIntfL(l, v);',
25253     '          }',
25254     '      }, 123);',
25255     '    } finally {',
25256     '      rtl._Release(l);',
25257     '    };',
25258     '  };',
25259     '});',
25260     'this.i = null;',
25261     'this.o = null;',
25262     '']),
25263     LinesToStr([ // $mod.$main
25264     '$mod.THelper.Fly.call({',
25265     '  p: $mod,',
25266     '  get: function () {',
25267     '      return this.p.i;',
25268     '    },',
25269     '  set: function (v) {',
25270     '      rtl.setIntfP(this.p, "i", v);',
25271     '    }',
25272     '}, 123);',
25273     '$mod.THelper.Fly.call({',
25274     '  p: $mod,',
25275     '  get: function () {',
25276     '      return this.p.i;',
25277     '    },',
25278     '  set: function (v) {',
25279     '      rtl.setIntfP(this.p, "i", v);',
25280     '    }',
25281     '}, 123);',
25282     '$mod.THelper.Run();',
25283     '$mod.THelper.Run();',
25284     '$mod.THelper.Run();',
25285     '$mod.THelper.Run();',
25286     '']));
25287 end;
25288 
25289 procedure TTestModule.TestTypeHelper_NestedSelf;
25290 begin
25291   StartProgram(false);
25292   Add([
25293   '{$modeswitch typehelpers}',
25294   'type',
25295   '  THelper = type helper for string',
25296   '    procedure Run(Value: string);',
25297   '  end;',
25298   'procedure THelper.Run(Value: string);',
25299   '  function Sub(i: nativeint): boolean;',
25300   '  begin',
25301   '    Result:=Self[i+1]=Value[i];',
25302   '  end;',
25303   'begin',
25304   '  if Self[3]=Value[4] then ;',
25305   'end;',
25306   'begin',
25307   '']);
25308   ConvertProgram;
25309   CheckSource('TestTypeHelper_NestedSelf',
25310     LinesToStr([ // statements
25311     'rtl.createHelper($mod, "THelper", null, function () {',
25312     '  this.Run = function (Value) {',
25313     '    var $Self = this;',
25314     '    function Sub(i) {',
25315     '      var Result = false;',
25316     '      Result = $Self.get().charAt((i + 1) - 1) === Value.charAt(i - 1);',
25317     '      return Result;',
25318     '    };',
25319     '    if ($Self.get().charAt(2) === Value.charAt(3)) ;',
25320     '  };',
25321     '});',
25322     '']),
25323     LinesToStr([ // $mod.$main
25324     '']));
25325 end;
25326 
25327 procedure TTestModule.TestProcType;
25328 begin
25329   StartProgram(false);
25330   Add([
25331   'type',
25332   '  TProcInt = procedure(vI: longint = 1);',
25333   'procedure DoIt(vJ: longint);',
25334   'begin end;',
25335   'var',
25336   '  b: boolean;',
25337   '  vP, vQ: tprocint;',
25338   'begin',
25339   '  vp:=nil;',
25340   '  vp:=vp;',
25341   '  vp:=@doit;',
25342   '  vp;',
25343   '  vp();',
25344   '  vp(2);',
25345   '  b:=vp=nil;',
25346   '  b:=nil=vp;',
25347   '  b:=vp=vq;',
25348   '  b:=vp=@doit;',
25349   '  b:=@doit=vp;',
25350   '  b:=vp<>nil;',
25351   '  b:=nil<>vp;',
25352   '  b:=vp<>vq;',
25353   '  b:=vp<>@doit;',
25354   '  b:=@doit<>vp;',
25355   '  b:=Assigned(vp);',
25356   '  if Assigned(vp) then ;']);
25357   ConvertProgram;
25358   CheckSource('TestProcType',
25359     LinesToStr([ // statements
25360     'this.DoIt = function(vJ) {',
25361     '};',
25362     'this.b = false;',
25363     'this.vP = null;',
25364     'this.vQ = null;'
25365     ]),
25366     LinesToStr([ // $mod.$main
25367     '$mod.vP = null;',
25368     '$mod.vP = $mod.vP;',
25369     '$mod.vP = $mod.DoIt;',
25370     '$mod.vP(1);',
25371     '$mod.vP(1);',
25372     '$mod.vP(2);',
25373     '$mod.b = $mod.vP === null;',
25374     '$mod.b = null === $mod.vP;',
25375     '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
25376     '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
25377     '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
25378     '$mod.b = $mod.vP !== null;',
25379     '$mod.b = null !== $mod.vP;',
25380     '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
25381     '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
25382     '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
25383     '$mod.b = $mod.vP != null;',
25384     'if ($mod.vP != null) ;',
25385     '']));
25386 end;
25387 
25388 procedure TTestModule.TestProcType_Arg;
25389 begin
25390   StartProgram(false);
25391   Add([
25392   'type',
25393   '  TProcInt = procedure(vI: longint = 1);',
25394   'procedure DoIt(vJ: longint); begin end;',
25395   'procedure DoSome(vP, vQ: TProcInt);',
25396   'var',
25397   '  b: boolean;',
25398   'begin',
25399   '  vp:=nil;',
25400   '  vp:=vp;',
25401   '  vp:=@doit;',
25402   '  vp;',
25403   '  vp();',
25404   '  vp(2);',
25405   '  b:=vp=nil;',
25406   '  b:=nil=vp;',
25407   '  b:=vp=vq;',
25408   '  b:=vp=@doit;',
25409   '  b:=@doit=vp;',
25410   '  b:=vp<>nil;',
25411   '  b:=nil<>vp;',
25412   '  b:=vp<>vq;',
25413   '  b:=vp<>@doit;',
25414   '  b:=@doit<>vp;',
25415   '  b:=Assigned(vp);',
25416   '  if Assigned(vp) then ;',
25417   'end;',
25418   'begin',
25419   '  DoSome(@DoIt,nil);']);
25420   ConvertProgram;
25421   CheckSource('TestProcType_Arg',
25422     LinesToStr([ // statements
25423     'this.DoIt = function(vJ) {',
25424     '};',
25425     'this.DoSome = function(vP, vQ) {',
25426     '  var b = false;',
25427     '  vP = null;',
25428     '  vP = vP;',
25429     '  vP = $mod.DoIt;',
25430     '  vP(1);',
25431     '  vP(1);',
25432     '  vP(2);',
25433     '  b = vP === null;',
25434     '  b = null === vP;',
25435     '  b = rtl.eqCallback(vP,vQ);',
25436     '  b = rtl.eqCallback(vP, $mod.DoIt);',
25437     '  b = rtl.eqCallback($mod.DoIt, vP);',
25438     '  b = vP !== null;',
25439     '  b = null !== vP;',
25440     '  b = !rtl.eqCallback(vP, vQ);',
25441     '  b = !rtl.eqCallback(vP, $mod.DoIt);',
25442     '  b = !rtl.eqCallback($mod.DoIt, vP);',
25443     '  b = vP != null;',
25444     '  if (vP != null) ;',
25445     '};',
25446     '']),
25447     LinesToStr([ // $mod.$main
25448     '$mod.DoSome($mod.DoIt,null);',
25449     '']));
25450 end;
25451 
25452 procedure TTestModule.TestProcType_FunctionFPC;
25453 begin
25454   StartProgram(false);
25455   Add('type');
25456   Add('  TFuncInt = function(vA: longint = 1): longint;');
25457   Add('function DoIt(vI: longint): longint;');
25458   Add('begin end;');
25459   Add('var');
25460   Add('  b: boolean;');
25461   Add('  vP, vQ: tfuncint;');
25462   Add('begin');
25463   Add('  vp:=nil;');
25464   Add('  vp:=vp;');
25465   Add('  vp:=@doit;'); // ok in fpc and delphi
25466   //Add('  vp:=doit;'); // illegal in fpc, ok in delphi
25467   Add('  vp;'); // ok in fpc and delphi
25468   Add('  vp();');
25469   Add('  vp(2);');
25470   Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
25471   Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
25472   Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
25473   Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
25474   Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
25475   //Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
25476   Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
25477   Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
25478   Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
25479   Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
25480   Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
25481   Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
25482   //Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
25483   Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
25484   Add('  b:=Assigned(vp);');
25485   //Add('  doit(vp);'); // illegal in fpc, ok in delphi
25486   Add('  doit(vp());'); // ok in fpc and delphi
25487   Add('  doit(vp(2));'); // ok in fpc and delphi
25488   ConvertProgram;
25489   CheckSource('TestProcType_FunctionFPC',
25490     LinesToStr([ // statements
25491     'this.DoIt = function(vI) {',
25492     '  var Result = 0;',
25493     '  return Result;',
25494     '};',
25495     'this.b = false;',
25496     'this.vP = null;',
25497     'this.vQ = null;'
25498     ]),
25499     LinesToStr([ // $mod.$main
25500     '$mod.vP = null;',
25501     '$mod.vP = $mod.vP;',
25502     '$mod.vP = $mod.DoIt;',
25503     '$mod.vP(1);',
25504     '$mod.vP(1);',
25505     '$mod.vP(2);',
25506     '$mod.b = $mod.vP === null;',
25507     '$mod.b = null === $mod.vP;',
25508     '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
25509     '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
25510     '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
25511     '$mod.b = 4 === $mod.vP(1);',
25512     '$mod.b = $mod.vP !== null;',
25513     '$mod.b = null !== $mod.vP;',
25514     '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
25515     '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
25516     '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
25517     '$mod.b = 6 !== $mod.vP(1);',
25518     '$mod.b = $mod.vP != null;',
25519     '$mod.DoIt($mod.vP(1));',
25520     '$mod.DoIt($mod.vP(2));',
25521     '']));
25522 end;
25523 
25524 procedure TTestModule.TestProcType_FunctionDelphi;
25525 begin
25526   StartProgram(false);
25527   Add('{$mode Delphi}');
25528   Add('type');
25529   Add('  TFuncInt = function(vA: longint = 1): longint;');
25530   Add('function DoIt(vI: longint): longint;');
25531   Add('begin end;');
25532   Add('var');
25533   Add('  b: boolean;');
25534   Add('  vP, vQ: tfuncint;');
25535   Add('begin');
25536   Add('  vp:=nil;');
25537   Add('  vp:=vp;');
25538   Add('  vp:=@doit;'); // ok in fpc and delphi
25539   Add('  vp:=doit;'); // illegal in fpc, ok in delphi
25540   Add('  vp;'); // ok in fpc and delphi
25541   Add('  vp();');
25542   Add('  vp(2);');
25543   //Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
25544   //Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
25545   Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
25546   //Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
25547   //Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
25548   Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
25549   Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
25550   //Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
25551   //Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
25552   Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
25553   //Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
25554   //Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
25555   Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
25556   Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
25557   Add('  b:=Assigned(vp);');
25558   Add('  doit(vp);'); // illegal in fpc, ok in delphi
25559   Add('  doit(vp());'); // ok in fpc and delphi
25560   Add('  doit(vp(2));'); // ok in fpc and delphi  *)
25561   ConvertProgram;
25562   CheckSource('TestProcType_FunctionDelphi',
25563     LinesToStr([ // statements
25564     'this.DoIt = function(vI) {',
25565     '  var Result = 0;',
25566     '  return Result;',
25567     '};',
25568     'this.b = false;',
25569     'this.vP = null;',
25570     'this.vQ = null;'
25571     ]),
25572     LinesToStr([ // $mod.$main
25573     '$mod.vP = null;',
25574     '$mod.vP = $mod.vP;',
25575     '$mod.vP = $mod.DoIt;',
25576     '$mod.vP = $mod.DoIt;',
25577     '$mod.vP(1);',
25578     '$mod.vP(1);',
25579     '$mod.vP(2);',
25580     '$mod.b = $mod.vP(1) === $mod.vQ(1);',
25581     '$mod.b = $mod.vP(1) === 3;',
25582     '$mod.b = 4 === $mod.vP(1);',
25583     '$mod.b = $mod.vP(1) !== $mod.vQ(1);',
25584     '$mod.b = $mod.vP(1) !== 5;',
25585     '$mod.b = 6 !== $mod.vP(1);',
25586     '$mod.b = $mod.vP != null;',
25587     '$mod.DoIt($mod.vP(1));',
25588     '$mod.DoIt($mod.vP(1));',
25589     '$mod.DoIt($mod.vP(2));',
25590     '']));
25591 end;
25592 
25593 procedure TTestModule.TestProcType_ProcedureDelphi;
25594 begin
25595   StartProgram(false);
25596   Add('{$mode Delphi}');
25597   Add('type');
25598   Add('  TProc = procedure;');
25599   Add('procedure DoIt;');
25600   Add('begin end;');
25601   Add('var');
25602   Add('  b: boolean;');
25603   Add('  vP, vQ: tproc;');
25604   Add('begin');
25605   Add('  vp:=nil;');
25606   Add('  vp:=vp;');
25607   Add('  vp:=vq;');
25608   Add('  vp:=@doit;'); // ok in fpc and delphi, Note that in Delphi type of @F is Pointer, while in FPC it is the proc type
25609   Add('  vp:=doit;'); // illegal in fpc, ok in delphi
25610   //Add('  vp:=@doit;'); // illegal in fpc, ok in delphi (because Delphi treats @F as Pointer), not supported by resolver
25611   Add('  vp;'); // ok in fpc and delphi
25612   Add('  vp();');
25613 
25614   // equal
25615   //Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
25616   Add('  b:=@@vp=nil;'); // ok in fpc delphi mode, ok in delphi
25617   //Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
25618   Add('  b:=nil=@@vp;'); // ok in fpc delphi mode, ok in delphi
25619   Add('  b:=@@vp=@@vq;'); // ok in fpc delphi mode, ok in Delphi
25620   //Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
25621   //Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
25622   Add('  b:=@@vp=@doit;'); // ok in fpc delphi mode, ok in delphi
25623   //Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
25624   Add('  b:=@doit=@@vp;'); // ok in fpc delphi mode, ok in delphi
25625 
25626   // unequal
25627   //Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
25628   Add('  b:=@@vp<>nil;'); // ok in fpc mode delphi, ok in delphi
25629   //Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
25630   Add('  b:=nil<>@@vp;'); // ok in fpc mode delphi, ok in delphi
25631   //Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
25632   Add('  b:=@@vp<>@@vq;'); // ok in fpc mode delphi, ok in delphi
25633   //Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
25634   Add('  b:=@@vp<>@doit;'); // ok in fpc mode delphi, illegal in delphi
25635   //Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
25636   Add('  b:=@doit<>@@vp;'); // ok in fpc mode delphi, illegal in delphi
25637 
25638   Add('  b:=Assigned(vp);');
25639 
25640   ConvertProgram;
25641   CheckSource('TestProcType_ProcedureDelphi',
25642     LinesToStr([ // statements
25643     'this.DoIt = function() {',
25644     '};',
25645     'this.b = false;',
25646     'this.vP = null;',
25647     'this.vQ = null;'
25648     ]),
25649     LinesToStr([ // $mod.$main
25650     '$mod.vP = null;',
25651     '$mod.vP = $mod.vP;',
25652     '$mod.vP = $mod.vQ;',
25653     '$mod.vP = $mod.DoIt;',
25654     '$mod.vP = $mod.DoIt;',
25655     '$mod.vP();',
25656     '$mod.vP();',
25657     '$mod.b = $mod.vP === null;',
25658     '$mod.b = null === $mod.vP;',
25659     '$mod.b = rtl.eqCallback($mod.vP, $mod.vQ);',
25660     '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
25661     '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
25662     '$mod.b = $mod.vP !== null;',
25663     '$mod.b = null !== $mod.vP;',
25664     '$mod.b = !rtl.eqCallback($mod.vP, $mod.vQ);',
25665     '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
25666     '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
25667     '$mod.b = $mod.vP != null;',
25668     '']));
25669 end;
25670 
25671 procedure TTestModule.TestProcType_AsParam;
25672 begin
25673   StartProgram(false);
25674   Add('type');
25675   Add('  TFuncInt = function(vA: longint = 1): longint;');
25676   Add('procedure DoIt(vG: tfuncint; const vH: tfuncint; var vI: tfuncint);');
25677   Add('var vJ: tfuncint;');
25678   Add('begin');
25679   Add('  vg:=vg;');
25680   Add('  vj:=vh;');
25681   Add('  vi:=vi;');
25682   Add('  doit(vg,vg,vg);');
25683   Add('  doit(vh,vh,vj);');
25684   Add('  doit(vi,vi,vi);');
25685   Add('  doit(vj,vj,vj);');
25686   Add('end;');
25687   Add('var i: tfuncint;');
25688   Add('begin');
25689   Add('  doit(i,i,i);');
25690   ConvertProgram;
25691   CheckSource('TestProcType_AsParam',
25692     LinesToStr([ // statements
25693     'this.DoIt = function (vG,vH,vI) {',
25694     '  var vJ = null;',
25695     '  vG = vG;',
25696     '  vJ = vH;',
25697     '  vI.set(vI.get());',
25698     '  $mod.DoIt(vG, vG, {',
25699     '    get: function () {',
25700     '      return vG;',
25701     '    },',
25702     '    set: function (v) {',
25703     '      vG = v;',
25704     '    }',
25705     '  });',
25706     '  $mod.DoIt(vH, vH, {',
25707     '    get: function () {',
25708     '      return vJ;',
25709     '    },',
25710     '    set: function (v) {',
25711     '      vJ = v;',
25712     '    }',
25713     '  });',
25714     '  $mod.DoIt(vI.get(), vI.get(), vI);',
25715     '  $mod.DoIt(vJ, vJ, {',
25716     '    get: function () {',
25717     '      return vJ;',
25718     '    },',
25719     '    set: function (v) {',
25720     '      vJ = v;',
25721     '    }',
25722     '  });',
25723     '};',
25724     'this.i = null;'
25725     ]),
25726     LinesToStr([
25727     '$mod.DoIt($mod.i,$mod.i,{',
25728     '  p: $mod,',
25729     '  get: function () {',
25730     '      return this.p.i;',
25731     '    },',
25732     '  set: function (v) {',
25733     '      this.p.i = v;',
25734     '    }',
25735     '});'
25736     ]));
25737 end;
25738 
25739 procedure TTestModule.TestProcType_MethodFPC;
25740 begin
25741   StartProgram(false);
25742   Add('type');
25743   Add('  TFuncInt = function(vA: longint = 1): longint of object;');
25744   Add('  TObject = class');
25745   Add('    function DoIt(vA: longint = 1): longint;');
25746   Add('  end;');
25747   Add('function TObject.DoIt(vA: longint = 1): longint;');
25748   Add('begin');
25749   Add('end;');
25750   Add('var');
25751   Add('  Obj: TObject;');
25752   Add('  vP: tfuncint;');
25753   Add('  b: boolean;');
25754   Add('begin');
25755   Add('  vp:=@obj.doit;'); // ok in fpc and delphi
25756   //Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
25757   Add('  vp;'); // ok in fpc and delphi
25758   Add('  vp();');
25759   Add('  vp(2);');
25760   Add('  b:=vp=@obj.doit;'); // ok in fpc, illegal in delphi
25761   Add('  b:=@obj.doit=vp;'); // ok in fpc, illegal in delphi
25762   Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
25763   Add('  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
25764   ConvertProgram;
25765   CheckSource('TestProcType_MethodFPC',
25766     LinesToStr([ // statements
25767     'rtl.createClass($mod, "TObject", null, function () {',
25768     '  this.$init = function () {',
25769     '  };',
25770     '  this.$final = function () {',
25771     '  };',
25772     '  this.DoIt = function (vA) {',
25773     '    var Result = 0;',
25774     '    return Result;',
25775     '  };',
25776     '});',
25777     'this.Obj = null;',
25778     'this.vP = null;',
25779     'this.b = false;'
25780     ]),
25781     LinesToStr([
25782     '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
25783     '$mod.vP(1);',
25784     '$mod.vP(1);',
25785     '$mod.vP(2);',
25786     '$mod.b = rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
25787     '$mod.b = rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
25788     '$mod.b = !rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
25789     '$mod.b = !rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
25790     '']));
25791 end;
25792 
25793 procedure TTestModule.TestProcType_MethodDelphi;
25794 begin
25795   StartProgram(false);
25796   Add([
25797   '{$mode delphi}',
25798   'type',
25799   '  TFuncInt = function(vA: longint = 1): longint of object;',
25800   '  TObject = class',
25801   '    function DoIt(vA: longint = 1): longint;',
25802   '  end;',
25803   'function TObject.DoIt(vA: longint = 1): longint;',
25804   'begin',
25805   'end;',
25806   'var',
25807   '  Obj: TObject;',
25808   '  vP: tfuncint;',
25809   '  b: boolean;',
25810   'begin',
25811   '  vp:=@obj.doit;', // ok in fpc and delphi
25812   '  vp:=obj.doit;', // illegal in fpc, ok in delphi
25813   '  vp;', // ok in fpc and delphi
25814   '  vp();',
25815   '  vp(2);',
25816   //'  b:=vp=@obj.doit;', // ok in fpc, illegal in delphi
25817   //'  b:=@obj.doit=vp;', // ok in fpc, illegal in delphi
25818   //'  b:=vp<>@obj.doit;', // ok in fpc, illegal in delphi
25819   //'  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
25820   '']);
25821   ConvertProgram;
25822   CheckSource('TestProcType_MethodDelphi',
25823     LinesToStr([ // statements
25824     'rtl.createClass($mod, "TObject", null, function () {',
25825     '  this.$init = function () {',
25826     '  };',
25827     '  this.$final = function () {',
25828     '  };',
25829     '  this.DoIt = function (vA) {',
25830     '    var Result = 0;',
25831     '    return Result;',
25832     '  };',
25833     '});',
25834     'this.Obj = null;',
25835     'this.vP = null;',
25836     'this.b = false;'
25837     ]),
25838     LinesToStr([
25839     '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
25840     '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
25841     '$mod.vP(1);',
25842     '$mod.vP(1);',
25843     '$mod.vP(2);',
25844     '']));
25845 end;
25846 
25847 procedure TTestModule.TestProcType_PropertyFPC;
25848 begin
25849   StartProgram(false);
25850   Add('type');
25851   Add('  TFuncInt = function(vA: longint = 1): longint of object;');
25852   Add('  TObject = class');
25853   Add('    FOnFoo: TFuncInt;');
25854   Add('    function DoIt(vA: longint = 1): longint;');
25855   Add('    function GetFoo: TFuncInt;');
25856   Add('    procedure SetFoo(const Value: TFuncInt);');
25857   Add('    function GetEvents(Index: longint): TFuncInt;');
25858   Add('    procedure SetEvents(Index: longint; const Value: TFuncInt);');
25859   Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
25860   Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
25861   Add('    property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
25862   Add('  end;');
25863   Add('function tobject.doit(va: longint = 1): longint; begin end;');
25864   Add('function tobject.getfoo: tfuncint; begin end;');
25865   Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
25866   Add('function tobject.getevents(index: longint): tfuncint; begin end;');
25867   Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
25868   Add('var');
25869   Add('  Obj: TObject;');
25870   Add('  vP: tfuncint;');
25871   Add('  b: boolean;');
25872   Add('begin');
25873   Add('  obj.onfoo:=nil;');
25874   Add('  obj.onbar:=nil;');
25875   Add('  obj.events[1]:=nil;');
25876   Add('  obj.onfoo:=obj.onfoo;');
25877   Add('  obj.onbar:=obj.onbar;');
25878   Add('  obj.events[2]:=obj.events[3];');
25879   Add('  obj.onfoo:=@obj.doit;');
25880   Add('  obj.onbar:=@obj.doit;');
25881   Add('  obj.events[4]:=@obj.doit;');
25882   //Add('  obj.onfoo:=obj.doit;'); // delphi
25883   //Add('  obj.onbar:=obj.doit;'); // delphi
25884   //Add('  obj.events[4]:=obj.doit;'); // delphi
25885   Add('  obj.onfoo;');
25886   Add('  obj.onbar;');
25887   //Add('  obj.events[5];'); ToDo in pasresolver
25888   Add('  obj.onfoo();');
25889   Add('  obj.onbar();');
25890   Add('  obj.events[6]();');
25891   Add('  b:=obj.onfoo=nil;');
25892   Add('  b:=obj.onbar=nil;');
25893   Add('  b:=obj.events[7]=nil;');
25894   Add('  b:=obj.onfoo<>nil;');
25895   Add('  b:=obj.onbar<>nil;');
25896   Add('  b:=obj.events[8]<>nil;');
25897   Add('  b:=obj.onfoo=vp;');
25898   Add('  b:=obj.onbar=vp;');
25899   Add('  b:=obj.events[9]=vp;');
25900   Add('  b:=obj.onfoo=obj.onfoo;');
25901   Add('  b:=obj.onbar=obj.onfoo;');
25902   Add('  b:=obj.events[10]=obj.onfoo;');
25903   Add('  b:=obj.onfoo<>obj.onfoo;');
25904   Add('  b:=obj.onbar<>obj.onfoo;');
25905   Add('  b:=obj.events[11]<>obj.onfoo;');
25906   Add('  b:=obj.onfoo=@obj.doit;');
25907   Add('  b:=obj.onbar=@obj.doit;');
25908   Add('  b:=obj.events[12]=@obj.doit;');
25909   Add('  b:=obj.onfoo<>@obj.doit;');
25910   Add('  b:=obj.onbar<>@obj.doit;');
25911   Add('  b:=obj.events[12]<>@obj.doit;');
25912   Add('  b:=Assigned(obj.onfoo);');
25913   Add('  b:=Assigned(obj.onbar);');
25914   Add('  b:=Assigned(obj.events[13]);');
25915   ConvertProgram;
25916   CheckSource('TestProcType_PropertyFPC',
25917     LinesToStr([ // statements
25918     'rtl.createClass($mod, "TObject", null, function () {',
25919     '  this.$init = function () {',
25920     '    this.FOnFoo = null;',
25921     '  };',
25922     '  this.$final = function () {',
25923     '    this.FOnFoo = undefined;',
25924     '  };',
25925     '  this.DoIt = function (vA) {',
25926     '    var Result = 0;',
25927     '    return Result;',
25928     '  };',
25929     'this.GetFoo = function () {',
25930     '  var Result = null;',
25931     '  return Result;',
25932     '};',
25933     'this.SetFoo = function (Value) {',
25934     '};',
25935     'this.GetEvents = function (Index) {',
25936     '  var Result = null;',
25937     '  return Result;',
25938     '};',
25939     'this.SetEvents = function (Index, Value) {',
25940     '};',
25941     '});',
25942     'this.Obj = null;',
25943     'this.vP = null;',
25944     'this.b = false;'
25945     ]),
25946     LinesToStr([
25947     '$mod.Obj.FOnFoo = null;',
25948     '$mod.Obj.SetFoo(null);',
25949     '$mod.Obj.SetEvents(1, null);',
25950     '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
25951     '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
25952     '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
25953     '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
25954     '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
25955     '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
25956     '$mod.Obj.FOnFoo(1);',
25957     '$mod.Obj.GetFoo();',
25958     '$mod.Obj.FOnFoo(1);',
25959     '$mod.Obj.GetFoo()(1);',
25960     '$mod.Obj.GetEvents(6)(1);',
25961     '$mod.b = $mod.Obj.FOnFoo === null;',
25962     '$mod.b = $mod.Obj.GetFoo() === null;',
25963     '$mod.b = $mod.Obj.GetEvents(7) === null;',
25964     '$mod.b = $mod.Obj.FOnFoo !== null;',
25965     '$mod.b = $mod.Obj.GetFoo() !== null;',
25966     '$mod.b = $mod.Obj.GetEvents(8) !== null;',
25967     '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.vP);',
25968     '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.vP);',
25969     '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(9), $mod.vP);',
25970     '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
25971     '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
25972     '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(10), $mod.Obj.FOnFoo);',
25973     '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
25974     '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
25975     '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(11), $mod.Obj.FOnFoo);',
25976     '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
25977     '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
25978     '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
25979     '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
25980     '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
25981     '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
25982     '$mod.b = $mod.Obj.FOnFoo != null;',
25983     '$mod.b = $mod.Obj.GetFoo() != null;',
25984     '$mod.b = $mod.Obj.GetEvents(13) != null;',
25985     '']));
25986 end;
25987 
25988 procedure TTestModule.TestProcType_PropertyDelphi;
25989 begin
25990   StartProgram(false);
25991   Add('{$mode delphi}');
25992   Add('type');
25993   Add('  TFuncInt = function(vA: longint = 1): longint of object;');
25994   Add('  TObject = class');
25995   Add('    FOnFoo: TFuncInt;');
25996   Add('    function DoIt(vA: longint = 1): longint;');
25997   Add('    function GetFoo: TFuncInt;');
25998   Add('    procedure SetFoo(const Value: TFuncInt);');
25999   Add('    function GetEvents(Index: longint): TFuncInt;');
26000   Add('    procedure SetEvents(Index: longint; const Value: TFuncInt);');
26001   Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
26002   Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
26003   Add('    property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
26004   Add('  end;');
26005   Add('function tobject.doit(va: longint = 1): longint; begin end;');
26006   Add('function tobject.getfoo: tfuncint; begin end;');
26007   Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
26008   Add('function tobject.getevents(index: longint): tfuncint; begin end;');
26009   Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
26010   Add('var');
26011   Add('  Obj: TObject;');
26012   Add('  vP: tfuncint;');
26013   Add('  b: boolean;');
26014   Add('begin');
26015   Add('  obj.onfoo:=nil;');
26016   Add('  obj.onbar:=nil;');
26017   Add('  obj.events[1]:=nil;');
26018   Add('  obj.onfoo:=obj.onfoo;');
26019   Add('  obj.onbar:=obj.onbar;');
26020   Add('  obj.events[2]:=obj.events[3];');
26021   Add('  obj.onfoo:=@obj.doit;');
26022   Add('  obj.onbar:=@obj.doit;');
26023   Add('  obj.events[4]:=@obj.doit;');
26024   Add('  obj.onfoo:=obj.doit;'); // delphi
26025   Add('  obj.onbar:=obj.doit;'); // delphi
26026   Add('  obj.events[4]:=obj.doit;'); // delphi
26027   Add('  obj.onfoo;');
26028   Add('  obj.onbar;');
26029   //Add('  obj.events[5];'); ToDo in pasresolver
26030   Add('  obj.onfoo();');
26031   Add('  obj.onbar();');
26032   Add('  obj.events[6]();');
26033   //Add('  b:=obj.onfoo=nil;'); // fpc
26034   //Add('  b:=obj.onbar=nil;'); // fpc
26035   //Add('  b:=obj.events[7]=nil;'); // fpc
26036   //Add('  b:=obj.onfoo<>nil;'); // fpc
26037   //Add('  b:=obj.onbar<>nil;'); // fpc
26038   //Add('  b:=obj.events[8]<>nil;'); // fpc
26039   Add('  b:=obj.onfoo=vp;');
26040   Add('  b:=obj.onbar=vp;');
26041   //Add('  b:=obj.events[9]=vp;'); ToDo in pasresolver
26042   Add('  b:=obj.onfoo=obj.onfoo;');
26043   Add('  b:=obj.onbar=obj.onfoo;');
26044   //Add('  b:=obj.events[10]=obj.onfoo;'); // ToDo in pasresolver
26045   Add('  b:=obj.onfoo<>obj.onfoo;');
26046   Add('  b:=obj.onbar<>obj.onfoo;');
26047   //Add('  b:=obj.events[11]<>obj.onfoo;'); // ToDo in pasresolver
26048   //Add('  b:=obj.onfoo=@obj.doit;'); // fpc
26049   //Add('  b:=obj.onbar=@obj.doit;'); // fpc
26050   //Add('  b:=obj.events[12]=@obj.doit;'); // fpc
26051   //Add('  b:=obj.onfoo<>@obj.doit;'); // fpc
26052   //Add('  b:=obj.onbar<>@obj.doit;'); // fpc
26053   //Add('  b:=obj.events[12]<>@obj.doit;'); // fpc
26054   Add('  b:=Assigned(obj.onfoo);');
26055   Add('  b:=Assigned(obj.onbar);');
26056   Add('  b:=Assigned(obj.events[13]);');
26057   ConvertProgram;
26058   CheckSource('TestProcType_PropertyDelphi',
26059     LinesToStr([ // statements
26060     'rtl.createClass($mod, "TObject", null, function () {',
26061     '  this.$init = function () {',
26062     '    this.FOnFoo = null;',
26063     '  };',
26064     '  this.$final = function () {',
26065     '    this.FOnFoo = undefined;',
26066     '  };',
26067     '  this.DoIt = function (vA) {',
26068     '    var Result = 0;',
26069     '    return Result;',
26070     '  };',
26071     'this.GetFoo = function () {',
26072     '  var Result = null;',
26073     '  return Result;',
26074     '};',
26075     'this.SetFoo = function (Value) {',
26076     '};',
26077     'this.GetEvents = function (Index) {',
26078     '  var Result = null;',
26079     '  return Result;',
26080     '};',
26081     'this.SetEvents = function (Index, Value) {',
26082     '};',
26083     '});',
26084     'this.Obj = null;',
26085     'this.vP = null;',
26086     'this.b = false;'
26087     ]),
26088     LinesToStr([
26089     '$mod.Obj.FOnFoo = null;',
26090     '$mod.Obj.SetFoo(null);',
26091     '$mod.Obj.SetEvents(1, null);',
26092     '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
26093     '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
26094     '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
26095     '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
26096     '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
26097     '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
26098     '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
26099     '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
26100     '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
26101     '$mod.Obj.FOnFoo(1);',
26102     '$mod.Obj.GetFoo();',
26103     '$mod.Obj.FOnFoo(1);',
26104     '$mod.Obj.GetFoo()(1);',
26105     '$mod.Obj.GetEvents(6)(1);',
26106     '$mod.b = $mod.Obj.FOnFoo(1) === $mod.vP(1);',
26107     '$mod.b = $mod.Obj.GetFoo() === $mod.vP(1);',
26108     '$mod.b = $mod.Obj.FOnFoo(1) === $mod.Obj.FOnFoo(1);',
26109     '$mod.b = $mod.Obj.GetFoo() === $mod.Obj.FOnFoo(1);',
26110     '$mod.b = $mod.Obj.FOnFoo(1) !== $mod.Obj.FOnFoo(1);',
26111     '$mod.b = $mod.Obj.GetFoo() !== $mod.Obj.FOnFoo(1);',
26112     '$mod.b = $mod.Obj.FOnFoo != null;',
26113     '$mod.b = $mod.Obj.GetFoo() != null;',
26114     '$mod.b = $mod.Obj.GetEvents(13) != null;',
26115     '']));
26116 end;
26117 
26118 procedure TTestModule.TestProcType_WithClassInstDoPropertyFPC;
26119 begin
26120   StartProgram(false);
26121   Add('type');
26122   Add('  TFuncInt = function(vA: longint = 1): longint of object;');
26123   Add('  TObject = class');
26124   Add('    FOnFoo: TFuncInt;');
26125   Add('    function DoIt(vA: longint = 1): longint;');
26126   Add('    function GetFoo: TFuncInt;');
26127   Add('    procedure SetFoo(const Value: TFuncInt);');
26128   Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
26129   Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
26130   Add('  end;');
26131   Add('function tobject.doit(va: longint = 1): longint; begin end;');
26132   Add('function tobject.getfoo: tfuncint; begin end;');
26133   Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
26134   Add('var');
26135   Add('  Obj: TObject;');
26136   Add('  vP: tfuncint;');
26137   Add('  b: boolean;');
26138   Add('begin');
26139   Add('with obj do begin');
26140   Add('  fonfoo:=nil;');
26141   Add('  onfoo:=nil;');
26142   Add('  onbar:=nil;');
26143   Add('  fonfoo:=fonfoo;');
26144   Add('  onfoo:=onfoo;');
26145   Add('  onbar:=onbar;');
26146   Add('  fonfoo:=@doit;');
26147   Add('  onfoo:=@doit;');
26148   Add('  onbar:=@doit;');
26149   //Add('  fonfoo:=doit;'); // delphi
26150   //Add('  onfoo:=doit;'); // delphi
26151   //Add('  onbar:=doit;'); // delphi
26152   Add('  fonfoo;');
26153   Add('  onfoo;');
26154   Add('  onbar;');
26155   Add('  fonfoo();');
26156   Add('  onfoo();');
26157   Add('  onbar();');
26158   Add('  b:=fonfoo=nil;');
26159   Add('  b:=onfoo=nil;');
26160   Add('  b:=onbar=nil;');
26161   Add('  b:=fonfoo<>nil;');
26162   Add('  b:=onfoo<>nil;');
26163   Add('  b:=onbar<>nil;');
26164   Add('  b:=fonfoo=vp;');
26165   Add('  b:=onfoo=vp;');
26166   Add('  b:=onbar=vp;');
26167   Add('  b:=fonfoo=fonfoo;');
26168   Add('  b:=onfoo=onfoo;');
26169   Add('  b:=onbar=onfoo;');
26170   Add('  b:=fonfoo<>fonfoo;');
26171   Add('  b:=onfoo<>onfoo;');
26172   Add('  b:=onbar<>onfoo;');
26173   Add('  b:=fonfoo=@doit;');
26174   Add('  b:=onfoo=@doit;');
26175   Add('  b:=onbar=@doit;');
26176   Add('  b:=fonfoo<>@doit;');
26177   Add('  b:=onfoo<>@doit;');
26178   Add('  b:=onbar<>@doit;');
26179   Add('  b:=Assigned(fonfoo);');
26180   Add('  b:=Assigned(onfoo);');
26181   Add('  b:=Assigned(onbar);');
26182   Add('end;');
26183   ConvertProgram;
26184   CheckSource('TestProcType_WithClassInstDoPropertyFPC',
26185     LinesToStr([ // statements
26186     'rtl.createClass($mod, "TObject", null, function () {',
26187     '  this.$init = function () {',
26188     '    this.FOnFoo = null;',
26189     '  };',
26190     '  this.$final = function () {',
26191     '    this.FOnFoo = undefined;',
26192     '  };',
26193     '  this.DoIt = function (vA) {',
26194     '    var Result = 0;',
26195     '    return Result;',
26196     '  };',
26197     '  this.GetFoo = function () {',
26198     '    var Result = null;',
26199     '    return Result;',
26200     '  };',
26201     '  this.SetFoo = function (Value) {',
26202     '  };',
26203     '});',
26204     'this.Obj = null;',
26205     'this.vP = null;',
26206     'this.b = false;'
26207     ]),
26208     LinesToStr([
26209     'var $with = $mod.Obj;',
26210     '$with.FOnFoo = null;',
26211     '$with.FOnFoo = null;',
26212     '$with.SetFoo(null);',
26213     '$with.FOnFoo = $with.FOnFoo;',
26214     '$with.FOnFoo = $with.FOnFoo;',
26215     '$with.SetFoo($with.GetFoo());',
26216     '$with.FOnFoo = rtl.createCallback($with, "DoIt");',
26217     '$with.FOnFoo = rtl.createCallback($with, "DoIt");',
26218     '$with.SetFoo(rtl.createCallback($with, "DoIt"));',
26219     '$with.FOnFoo(1);',
26220     '$with.FOnFoo(1);',
26221     '$with.GetFoo();',
26222     '$with.FOnFoo(1);',
26223     '$with.FOnFoo(1);',
26224     '$with.GetFoo()(1);',
26225     '$mod.b = $with.FOnFoo === null;',
26226     '$mod.b = $with.FOnFoo === null;',
26227     '$mod.b = $with.GetFoo() === null;',
26228     '$mod.b = $with.FOnFoo !== null;',
26229     '$mod.b = $with.FOnFoo !== null;',
26230     '$mod.b = $with.GetFoo() !== null;',
26231     '$mod.b = rtl.eqCallback($with.FOnFoo, $mod.vP);',
26232     '$mod.b = rtl.eqCallback($with.FOnFoo, $mod.vP);',
26233     '$mod.b = rtl.eqCallback($with.GetFoo(), $mod.vP);',
26234     '$mod.b = rtl.eqCallback($with.FOnFoo, $with.FOnFoo);',
26235     '$mod.b = rtl.eqCallback($with.FOnFoo, $with.FOnFoo);',
26236     '$mod.b = rtl.eqCallback($with.GetFoo(), $with.FOnFoo);',
26237     '$mod.b = !rtl.eqCallback($with.FOnFoo, $with.FOnFoo);',
26238     '$mod.b = !rtl.eqCallback($with.FOnFoo, $with.FOnFoo);',
26239     '$mod.b = !rtl.eqCallback($with.GetFoo(), $with.FOnFoo);',
26240     '$mod.b = rtl.eqCallback($with.FOnFoo, rtl.createCallback($with, "DoIt"));',
26241     '$mod.b = rtl.eqCallback($with.FOnFoo, rtl.createCallback($with, "DoIt"));',
26242     '$mod.b = rtl.eqCallback($with.GetFoo(), rtl.createCallback($with, "DoIt"));',
26243     '$mod.b = !rtl.eqCallback($with.FOnFoo, rtl.createCallback($with, "DoIt"));',
26244     '$mod.b = !rtl.eqCallback($with.FOnFoo, rtl.createCallback($with, "DoIt"));',
26245     '$mod.b = !rtl.eqCallback($with.GetFoo(), rtl.createCallback($with, "DoIt"));',
26246     '$mod.b = $with.FOnFoo != null;',
26247     '$mod.b = $with.FOnFoo != null;',
26248     '$mod.b = $with.GetFoo() != null;',
26249     '']));
26250 end;
26251 
26252 procedure TTestModule.TestProcType_Nested;
26253 begin
26254   StartProgram(false);
26255   Add([
26256   'type',
26257   '  TProcInt = procedure(vI: longint = 1);',
26258   'procedure DoIt(vJ: longint);',
26259   'var aProc: TProcInt;',
26260   '    b: boolean;',
26261   '  procedure Sub(vK: longint);',
26262   '  var aSub: TProcInt;',
26263   '    procedure SubSub(vK: longint);',
26264   '    var aSubSub: TProcInt;',
26265   '    begin;',
26266   '      aProc:=@DoIt;',
26267   '      aSub:=@DoIt;',
26268   '      aSubSub:=@DoIt;',
26269   '      aProc:=@Sub;',
26270   '      aSub:=@Sub;',
26271   '      aSubSub:=@Sub;',
26272   '      aProc:=@SubSub;',
26273   '      aSub:=@SubSub;',
26274   '      aSubSub:=@SubSub;',
26275   '    end;',
26276   '  begin;',
26277   '  end;',
26278   'begin;',
26279   '  aProc:=@Sub;',
26280   '  b:=aProc=@Sub;',
26281   '  b:=@Sub=aProc;',
26282   'end;',
26283   'begin',
26284   '']);
26285   ConvertProgram;
26286   CheckSource('TestProcType_Nested',
26287     LinesToStr([ // statements
26288     'this.DoIt = function (vJ) {',
26289     '  var aProc = null;',
26290     '  var b = false;',
26291     '  function Sub(vK) {',
26292     '    var aSub = null;',
26293     '    function SubSub(vK) {',
26294     '      var aSubSub = null;',
26295     '      aProc = $mod.DoIt;',
26296     '      aSub = $mod.DoIt;',
26297     '      aSubSub = $mod.DoIt;',
26298     '      aProc = Sub;',
26299     '      aSub = Sub;',
26300     '      aSubSub = Sub;',
26301     '      aProc = SubSub;',
26302     '      aSub = SubSub;',
26303     '      aSubSub = SubSub;',
26304     '    };',
26305     '  };',
26306     '  aProc = Sub;',
26307     '  b = rtl.eqCallback(aProc, Sub);',
26308     '  b = rtl.eqCallback(Sub, aProc);',
26309     '};',
26310     '']),
26311     LinesToStr([ // $mod.$main
26312     '']));
26313 end;
26314 
26315 procedure TTestModule.TestProcType_NestedOfObject;
26316 begin
26317   StartProgram(false);
26318   Add([
26319   'type',
26320   '  TProcInt = procedure(vI: longint = 1) of object;',
26321   '  TObject = class',
26322   '    procedure DoIt(vJ: longint);',
26323   '  end;',
26324   'procedure TObject.DoIt(vJ: longint);',
26325   'var aProc: TProcInt;',
26326   '    b: boolean;',
26327   '  procedure Sub(vK: longint);',
26328   '  var aSub: TProcInt;',
26329   '    procedure SubSub(vK: longint);',
26330   '    var aSubSub: TProcInt;',
26331   '    begin;',
26332   '      aProc:=@DoIt;',
26333   '      aSub:=@DoIt;',
26334   '      aSubSub:=@DoIt;',
26335   '      aProc:=@Sub;',
26336   '      aSub:=@Sub;',
26337   '      aSubSub:=@Sub;',
26338   '      aProc:=@SubSub;',
26339   '      aSub:=@SubSub;',
26340   '      aSubSub:=@SubSub;',
26341   '    end;',
26342   '  begin;',
26343   '  end;',
26344   'begin;',
26345   '  aProc:=@Sub;',
26346   '  b:=aProc=@Sub;',
26347   '  b:=@Sub=aProc;',
26348   'end;',
26349   'begin',
26350   '']);
26351   ConvertProgram;
26352   CheckSource('TestProcType_Nested',
26353     LinesToStr([ // statements
26354     'rtl.createClass($mod, "TObject", null, function () {',
26355     '  this.$init = function () {',
26356     '  };',
26357     '  this.$final = function () {',
26358     '  };',
26359     '  this.DoIt = function (vJ) {',
26360     '    var $Self = this;',
26361     '    var aProc = null;',
26362     '    var b = false;',
26363     '    function Sub(vK) {',
26364     '      var aSub = null;',
26365     '      function SubSub(vK) {',
26366     '        var aSubSub = null;',
26367     '        aProc = rtl.createCallback($Self, "DoIt");',
26368     '        aSub = rtl.createCallback($Self, "DoIt");',
26369     '        aSubSub = rtl.createCallback($Self, "DoIt");',
26370     '        aProc = Sub;',
26371     '        aSub = Sub;',
26372     '        aSubSub = Sub;',
26373     '        aProc = SubSub;',
26374     '        aSub = SubSub;',
26375     '        aSubSub = SubSub;',
26376     '      };',
26377     '    };',
26378     '    aProc = Sub;',
26379     '    b = rtl.eqCallback(aProc, Sub);',
26380     '    b = rtl.eqCallback(Sub, aProc);',
26381     '  };',
26382     '});',
26383     '']),
26384     LinesToStr([ // $mod.$main
26385     '']));
26386 end;
26387 
26388 procedure TTestModule.TestProcType_ReferenceToProc;
26389 begin
26390   StartProgram(false);
26391   Add([
26392   'type',
26393   '  TProcRef = reference to procedure(i: longint = 0);',
26394   '  TFuncRef = reference to function(i: longint = 0): longint;',
26395   'var',
26396   '  p: TProcRef;',
26397   '  f: TFuncRef;',
26398   'procedure DoIt(i: longint);',
26399   'begin',
26400   'end;',
26401   'function GetIt(i: longint): longint;',
26402   'begin',
26403   '  p:=@DoIt;',
26404   '  f:=@GetIt;',
26405   '  f;',
26406   '  f();',
26407   '  f(1);',
26408   'end;',
26409   'begin',
26410   '  p:=@DoIt;',
26411   '  f:=@GetIt;',
26412   '  f;',
26413   '  f();',
26414   '  f(1);',
26415   '  p:=TProcRef(f);',
26416   '']);
26417   ConvertProgram;
26418   CheckSource('TestProcType_ReferenceToProc',
26419     LinesToStr([ // statements
26420     'this.p = null;',
26421     'this.f = null;',
26422     'this.DoIt = function (i) {',
26423     '};',
26424     'this.GetIt = function (i) {',
26425     '  var Result = 0;',
26426     '  $mod.p = $mod.DoIt;',
26427     '  $mod.f = $mod.GetIt;',
26428     '  $mod.f(0);',
26429     '  $mod.f(0);',
26430     '  $mod.f(1);',
26431     '  return Result;',
26432     '};',
26433     '']),
26434     LinesToStr([ // $mod.$main
26435     '$mod.p = $mod.DoIt;',
26436     '$mod.f = $mod.GetIt;',
26437     '$mod.f(0);',
26438     '$mod.f(0);',
26439     '$mod.f(1);',
26440     '$mod.p = $mod.f;',
26441     '']));
26442 end;
26443 
26444 procedure TTestModule.TestProcType_ReferenceToMethod;
26445 begin
26446   StartProgram(false);
26447   Add([
26448   'type',
26449   '  TFuncRef = reference to function(i: longint = 5): longint;',
26450   '  TObject = class',
26451   '    function Grow(s: longint): longint;',
26452   '  end;',
26453   'var',
26454   '  f: tfuncref;',
26455   'function tobject.grow(s: longint): longint;',
26456   '  function GrowSub(i: longint): longint;',
26457   '  begin',
26458   '    f:=@grow;',
26459   '    f:=@growsub;',
26460   '  end;',
26461   'begin',
26462   '  f:=@grow;',
26463   '  f:=@growsub;',
26464   'end;',
26465   'begin',
26466   '']);
26467   ConvertProgram;
26468   CheckSource('TestProcType_ReferenceToMethod',
26469     LinesToStr([ // statements
26470     'rtl.createClass($mod, "TObject", null, function () {',
26471     '  this.$init = function () {',
26472     '  };',
26473     '  this.$final = function () {',
26474     '  };',
26475     '  this.Grow = function (s) {',
26476     '    var $Self = this;',
26477     '    var Result = 0;',
26478     '    function GrowSub(i) {',
26479     '      var Result = 0;',
26480     '      $mod.f = rtl.createCallback($Self, "Grow");',
26481     '      $mod.f = GrowSub;',
26482     '      return Result;',
26483     '    };',
26484     '    $mod.f = rtl.createCallback($Self, "Grow");',
26485     '    $mod.f = GrowSub;',
26486     '    return Result;',
26487     '  };',
26488     '});',
26489     'this.f = null;',
26490     '']),
26491     LinesToStr([ // $mod.$main
26492     '']));
26493 end;
26494 
26495 procedure TTestModule.TestProcType_Typecast;
26496 begin
26497   StartProgram(false);
26498   Add([
26499   'type',
26500   '  TNotifyEvent = procedure(Sender: Pointer) of object;',
26501   '  TEvent = procedure of object;',
26502   '  TGetter = function:longint of object;',
26503   '  TProcA = procedure(i: longint);',
26504   '  TFuncB = function(i, j: longint): longint;',
26505   'procedure DoIt(); varargs; begin end;',
26506   'var',
26507   '  Notify: tnotifyevent;',
26508   '  Event: tevent;',
26509   '  Getter: tgetter;',
26510   '  ProcA: tproca;',
26511   '  FuncB: tfuncb;',
26512   '  p: pointer;',
26513   'begin',
26514   '  notify:=tnotifyevent(event);',
26515   '  event:=tevent(event);',
26516   '  event:=tevent(notify);',
26517   '  event:=tevent(getter);',
26518   '  event:=tevent(proca);',
26519   '  proca:=tproca(funcb);',
26520   '  funcb:=tfuncb(funcb);',
26521   '  funcb:=tfuncb(proca);',
26522   '  funcb:=tfuncb(getter);',
26523   '  proca:=tproca(p);',
26524   '  funcb:=tfuncb(p);',
26525   '  getter:=tgetter(p);',
26526   '  p:=pointer(notify);',
26527   '  p:=notify;',
26528   '  p:=pointer(proca);',
26529   '  p:=proca;',
26530   '  p:=pointer(funcb);',
26531   '  p:=funcb;',
26532   '  doit(Pointer(notify),pointer(event),pointer(proca));',
26533   '']);
26534   ConvertProgram;
26535   CheckSource('TestProcType_Typecast',
26536     LinesToStr([ // statements
26537     'this.DoIt = function () {',
26538     '};',
26539     'this.Notify = null;',
26540     'this.Event = null;',
26541     'this.Getter = null;',
26542     'this.ProcA = null;',
26543     'this.FuncB = null;',
26544     'this.p = null;',
26545     '']),
26546     LinesToStr([ // $mod.$main
26547     '$mod.Notify = $mod.Event;',
26548     '$mod.Event = $mod.Event;',
26549     '$mod.Event = $mod.Notify;',
26550     '$mod.Event = $mod.Getter;',
26551     '$mod.Event = $mod.ProcA;',
26552     '$mod.ProcA = $mod.FuncB;',
26553     '$mod.FuncB = $mod.FuncB;',
26554     '$mod.FuncB = $mod.ProcA;',
26555     '$mod.FuncB = $mod.Getter;',
26556     '$mod.ProcA = $mod.p;',
26557     '$mod.FuncB = $mod.p;',
26558     '$mod.Getter = $mod.p;',
26559     '$mod.p = $mod.Notify;',
26560     '$mod.p = $mod.Notify;',
26561     '$mod.p = $mod.ProcA;',
26562     '$mod.p = $mod.ProcA;',
26563     '$mod.p = $mod.FuncB;',
26564     '$mod.p = $mod.FuncB;',
26565     '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
26566     '']));
26567 end;
26568 
26569 procedure TTestModule.TestProcType_PassProcToUntyped;
26570 begin
26571   StartProgram(false);
26572   Add([
26573   'type',
26574   '  TEvent = procedure of object;',
26575   '  TFunc = function: longint;',
26576   'procedure DoIt(); varargs; begin end;',
26577   'procedure DoSome(const a; var b; p: pointer); begin end;',
26578   'var',
26579   '  Event: tevent;',
26580   '  Func: TFunc;',
26581   'begin',
26582   '  doit(event,func);',
26583   '  dosome(event,event,event);',
26584   '  dosome(func,func,func);',
26585   '']);
26586   ConvertProgram;
26587   CheckSource('TestProcType_PassProcToUntyped',
26588     LinesToStr([ // statements
26589     'this.DoIt = function () {',
26590     '};',
26591     'this.DoSome = function (a, b, p) {',
26592     '};',
26593     'this.Event = null;',
26594     'this.Func = null;',
26595     '']),
26596     LinesToStr([ // $mod.$main
26597     '$mod.DoIt($mod.Event, $mod.Func);',
26598     '$mod.DoSome($mod.Event, {',
26599     '  p: $mod,',
26600     '  get: function () {',
26601     '      return this.p.Event;',
26602     '    },',
26603     '  set: function (v) {',
26604     '      this.p.Event = v;',
26605     '    }',
26606     '}, $mod.Event);',
26607     '$mod.DoSome($mod.Func, {',
26608     '  p: $mod,',
26609     '  get: function () {',
26610     '      return this.p.Func;',
26611     '    },',
26612     '  set: function (v) {',
26613     '      this.p.Func = v;',
26614     '    }',
26615     '}, $mod.Func);',
26616     '']));
26617 end;
26618 
26619 procedure TTestModule.TestProcType_PassProcToArray;
26620 begin
26621   StartProgram(false);
26622   Add([
26623   'type',
26624   '  TFunc = function: longint;',
26625   '  TArrFunc = array of TFunc;',
26626   'procedure DoIt(Arr: TArrFunc); begin end;',
26627   'function GetIt: longint; begin end;',
26628   'var',
26629   '  Func: tfunc;',
26630   'begin',
26631   '  doit([]);',
26632   '  doit([@GetIt]);',
26633   '  doit([Func]);',
26634   '']);
26635   ConvertProgram;
26636   CheckSource('TestProcType_PassProcToArray',
26637     LinesToStr([ // statements
26638     'this.DoIt = function (Arr) {',
26639     '};',
26640     'this.GetIt = function () {',
26641     '  var Result = 0;',
26642     '  return Result;',
26643     '};',
26644     'this.Func = null;',
26645     '']),
26646     LinesToStr([ // $mod.$main
26647     '$mod.DoIt([]);',
26648     '$mod.DoIt([$mod.GetIt]);',
26649     '$mod.DoIt([$mod.Func]);',
26650     '']));
26651 end;
26652 
26653 procedure TTestModule.TestProcType_SafeCallObjFPC;
26654 begin
26655   StartProgram(false);
26656   Add([
26657   '{$modeswitch externalclass}',
26658   'type',
26659   '  TProc = reference to procedure(i: longint); safecall;',
26660   '  TEvent = procedure(i: longint) of object; safecall;',
26661   '  TExtA = class external name ''ExtObj''',
26662   '    procedure DoIt(Id: longint = 1); external name ''$Execute'';',
26663   '    procedure DoSome(Id: longint = 1);',
26664   '    procedure SetOnClick(const e: TEvent);',
26665   '    property OnClick: TEvent write SetOnClick;',
26666   '    class procedure Fly(Id: longint = 1); static;',
26667   '    procedure SetOnShow(const p: TProc);',
26668   '    property OnShow: TProc write SetOnShow;',
26669   '  end;',
26670   'procedure Run(i: longint = 1);',
26671   'begin',
26672   'end;',
26673   'var',
26674   '  Obj: texta;',
26675   '  e: TEvent;',
26676   '  p: TProc;',
26677   'begin',
26678   '  e:=e;',
26679   '  e:=@obj.doit;',
26680   '  e:=@obj.dosome;',
26681   '  e:=TEvent(@obj.dosome);', // no safecall
26682   '  obj.OnClick:=@obj.doit;',
26683   '  obj.OnClick:=@obj.dosome;',
26684   '  obj.setonclick(@obj.doit);',
26685   '  obj.setonclick(@obj.dosome);',
26686   '  p:=@Run;',
26687   '  p:=@TExtA.Fly;',
26688   '  obj.OnShow:=@Run;',
26689   '  obj.OnShow:=@TExtA.Fly;',
26690   '  obj.setOnShow(@Run);',
26691   '  obj.setOnShow(@TExtA.Fly);',
26692   '  with obj do begin',
26693   '    e:=@doit;',
26694   '    e:=@dosome;',
26695   '    OnClick:=@doit;',
26696   '    OnClick:=@dosome;',
26697   '    setonclick(@doit);',
26698   '    setonclick(@dosome);',
26699   '    OnShow:=@Run;',
26700   '    setOnShow(@Run);',
26701   '  end;']);
26702   ConvertProgram;
26703   CheckSource('TestProcType_SafeCallObjFPC',
26704     LinesToStr([ // statements
26705     'this.Run = function (i) {',
26706     '};',
26707     'this.Obj = null;',
26708     'this.e = null;',
26709     'this.p = null;',
26710     '']),
26711     LinesToStr([ // $mod.$main
26712     '$mod.e = $mod.e;',
26713     '$mod.e = rtl.createSafeCallback($mod.Obj, "$Execute");',
26714     '$mod.e = rtl.createSafeCallback($mod.Obj, "DoSome");',
26715     '$mod.e = rtl.createCallback($mod.Obj, "DoSome");',
26716     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "$Execute"));',
26717     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "DoSome"));',
26718     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "$Execute"));',
26719     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "DoSome"));',
26720     '$mod.p = rtl.createSafeCallback($mod, "Run");',
26721     '$mod.p = rtl.createSafeCallback(ExtObj, "Fly");',
26722     '$mod.Obj.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26723     '$mod.Obj.SetOnShow(rtl.createSafeCallback(ExtObj, "Fly"));',
26724     '$mod.Obj.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26725     '$mod.Obj.SetOnShow(rtl.createSafeCallback(ExtObj, "Fly"));',
26726     'var $with = $mod.Obj;',
26727     '$mod.e = rtl.createSafeCallback($with, "$Execute");',
26728     '$mod.e = rtl.createSafeCallback($with, "DoSome");',
26729     '$with.SetOnClick(rtl.createSafeCallback($with, "$Execute"));',
26730     '$with.SetOnClick(rtl.createSafeCallback($with, "DoSome"));',
26731     '$with.SetOnClick(rtl.createSafeCallback($with, "$Execute"));',
26732     '$with.SetOnClick(rtl.createSafeCallback($with, "DoSome"));',
26733     '$with.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26734     '$with.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26735     '']));
26736 end;
26737 
26738 procedure TTestModule.TestProcType_SafeCallDelphi;
26739 begin
26740   StartProgram(false);
26741   Add([
26742   '{$mode delphi}',
26743   '{$modeswitch externalclass}',
26744   'type',
26745   '  TProc = reference to procedure(i: longint); safecall;',
26746   '  TEvent = procedure(i: longint) of object; safecall;',
26747   '  TExtA = class external name ''ExtObj''',
26748   '    procedure DoIt(Id: longint = 1); external name ''$Execute'';',
26749   '    procedure DoSome(Id: longint = 1);',
26750   '    procedure SetOnClick(const e: TEvent);',
26751   '    property OnClick: TEvent write SetOnClick;',
26752   '    class procedure Fly(Id: longint = 1); static;',
26753   '    procedure SetOnShow(const p: TProc);',
26754   '    property OnShow: TProc write SetOnShow;',
26755   '  end;',
26756   'procedure Run(i: longint = 1);',
26757   'begin',
26758   'end;',
26759   'var',
26760   '  Obj: texta;',
26761   '  e: TEvent;',
26762   '  p: TProc;',
26763   'begin',
26764   '  e:=e;',
26765   '  e:=obj.doit;',
26766   '  e:=obj.dosome;',
26767   '  e:=TEvent(@obj.dosome);', // no safecall
26768   '  obj.OnClick:=obj.doit;',
26769   '  obj.OnClick:=obj.dosome;',
26770   '  obj.setonclick(obj.doit);',
26771   '  obj.setonclick(obj.dosome);',
26772   '  p:=Run;',
26773   '  p:=TExtA.Fly;',
26774   '  obj.OnShow:=Run;',
26775   '  obj.OnShow:=TExtA.Fly;',
26776   '  obj.setOnShow(Run);',
26777   '  obj.setOnShow(TExtA.Fly);',
26778   '  with obj do begin',
26779   '    e:=doit;',
26780   '    e:=dosome;',
26781   '    OnClick:=doit;',
26782   '    OnClick:=dosome;',
26783   '    setonclick(doit);',
26784   '    setonclick(dosome);',
26785   '    OnShow:=@Run;',
26786   '    setOnShow(@Run);',
26787   '  end;']);
26788   ConvertProgram;
26789   CheckSource('TestProcType_SafeCallDelphi',
26790     LinesToStr([ // statements
26791     'this.Run = function (i) {',
26792     '};',
26793     'this.Obj = null;',
26794     'this.e = null;',
26795     'this.p = null;',
26796     '']),
26797     LinesToStr([ // $mod.$main
26798     '$mod.e = $mod.e;',
26799     '$mod.e = rtl.createSafeCallback($mod.Obj, "$Execute");',
26800     '$mod.e = rtl.createSafeCallback($mod.Obj, "DoSome");',
26801     '$mod.e = rtl.createCallback($mod.Obj, "DoSome");',
26802     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "$Execute"));',
26803     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "DoSome"));',
26804     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "$Execute"));',
26805     '$mod.Obj.SetOnClick(rtl.createSafeCallback($mod.Obj, "DoSome"));',
26806     '$mod.p = rtl.createSafeCallback($mod, "Run");',
26807     '$mod.p = rtl.createSafeCallback(ExtObj, "Fly");',
26808     '$mod.Obj.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26809     '$mod.Obj.SetOnShow(rtl.createSafeCallback(ExtObj, "Fly"));',
26810     '$mod.Obj.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26811     '$mod.Obj.SetOnShow(rtl.createSafeCallback(ExtObj, "Fly"));',
26812     'var $with = $mod.Obj;',
26813     '$mod.e = rtl.createSafeCallback($with, "$Execute");',
26814     '$mod.e = rtl.createSafeCallback($with, "DoSome");',
26815     '$with.SetOnClick(rtl.createSafeCallback($with, "$Execute"));',
26816     '$with.SetOnClick(rtl.createSafeCallback($with, "DoSome"));',
26817     '$with.SetOnClick(rtl.createSafeCallback($with, "$Execute"));',
26818     '$with.SetOnClick(rtl.createSafeCallback($with, "DoSome"));',
26819     '$with.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26820     '$with.SetOnShow(rtl.createSafeCallback($mod, "Run"));',
26821     '']));
26822 end;
26823 
26824 procedure TTestModule.TestPointer;
26825 begin
26826   StartProgram(false);
26827   Add(['type',
26828   '  TObject = class end;',
26829   '  TClass = class of TObject;',
26830   '  TArrInt = array of longint;',
26831   'const',
26832   '  n = nil;',
26833   'var',
26834   '  v: jsvalue;',
26835   '  Obj: tobject;',
26836   '  C: tclass;',
26837   '  a: tarrint;',
26838   '  p: Pointer = nil;',
26839   '  s: string;',
26840   'begin',
26841   '  p:=p;',
26842   '  p:=nil;',
26843   '  if p=nil then;',
26844   '  if nil=p then;',
26845   '  if Assigned(p) then;',
26846   '  p:=Pointer(v);',
26847   '  p:=obj;',
26848   '  p:=c;',
26849   '  p:=a;',
26850   '  p:=tobject;',
26851   '  obj:=TObject(p);',
26852   '  c:=TClass(p);',
26853   '  a:=TArrInt(p);',
26854   '  p:=n;',
26855   '  p:=Pointer(a);',
26856   '  p:=pointer(s);',
26857   '  s:=string(p);',
26858   '']);
26859   ConvertProgram;
26860   CheckSource('TestPointer',
26861     LinesToStr([ // statements
26862     'rtl.createClass($mod, "TObject", null, function () {',
26863     '  this.$init = function () {',
26864     '  };',
26865     '  this.$final = function () {',
26866     '  };',
26867     '});',
26868     'this.n = null;',
26869     'this.v = undefined;',
26870     'this.Obj = null;',
26871     'this.C = null;',
26872     'this.a = [];',
26873     'this.p = null;',
26874     'this.s = "";',
26875     '']),
26876     LinesToStr([ // $mod.$main
26877     '$mod.p = $mod.p;',
26878     '$mod.p = null;',
26879     'if ($mod.p === null) ;',
26880     'if (null === $mod.p) ;',
26881     'if ($mod.p != null) ;',
26882     '$mod.p = $mod.v;',
26883     '$mod.p = $mod.Obj;',
26884     '$mod.p = $mod.C;',
26885     '$mod.p = $mod.a;',
26886     '$mod.p = $mod.TObject;',
26887     '$mod.Obj = $mod.p;',
26888     '$mod.C = $mod.p;',
26889     '$mod.a = $mod.p;',
26890     '$mod.p = null;',
26891     '$mod.p = $mod.a;',
26892     '$mod.p = $mod.s;',
26893     '$mod.s = $mod.p;',
26894     '']));
26895 end;
26896 
26897 procedure TTestModule.TestPointer_Proc;
26898 begin
26899   StartProgram(false);
26900   Add('type');
26901   Add('  TObject = class');
26902   Add('    procedure DoIt; virtual; abstract;');
26903   Add('  end;');
26904   Add('procedure DoSome; begin end;');
26905   Add('var');
26906   Add('  o: TObject;');
26907   Add('  p: Pointer;');
26908   Add('begin');
26909   Add('  p:=@DoSome;');
26910   Add('  p:=@o.DoIt;');
26911   ConvertProgram;
26912   CheckSource('TestPointer_Proc',
26913     LinesToStr([ // statements
26914     'rtl.createClass($mod, "TObject", null, function () {',
26915     '  this.$init = function () {',
26916     '  };',
26917     '  this.$final = function () {',
26918     '  };',
26919     '});',
26920     'this.DoSome = function () {',
26921     '};',
26922     'this.o = null;',
26923     'this.p = null;',
26924     '']),
26925     LinesToStr([ // $mod.$main
26926     '$mod.p = $mod.DoSome;',
26927     '$mod.p = rtl.createCallback($mod.o, "DoIt");',
26928     '']));
26929 end;
26930 
26931 procedure TTestModule.TestPointer_AssignRecordFail;
26932 begin
26933   StartProgram(false);
26934   Add('type');
26935   Add('  TRec = record end;');
26936   Add('var');
26937   Add('  p: Pointer;');
26938   Add('  r: TRec;');
26939   Add('begin');
26940   Add('  p:=r;');
26941   SetExpectedPasResolverError('Incompatible types: got "TRec" expected "Pointer"',
26942     nIncompatibleTypesGotExpected);
26943   ConvertProgram;
26944 end;
26945 
26946 procedure TTestModule.TestPointer_AssignStaticArrayFail;
26947 begin
26948   StartProgram(false);
26949   Add('type');
26950   Add('  TArr = array[boolean] of longint;');
26951   Add('var');
26952   Add('  p: Pointer;');
26953   Add('  a: TArr;');
26954   Add('begin');
26955   Add('  p:=a;');
26956   SetExpectedPasResolverError('Incompatible types: got "TArr" expected "Pointer"',
26957     nIncompatibleTypesGotExpected);
26958   ConvertProgram;
26959 end;
26960 
26961 procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
26962 begin
26963   StartProgram(false);
26964   Add([
26965   'procedure DoIt(args: array of jsvalue); begin end;',
26966   'procedure DoAll; varargs; begin end;',
26967   'var',
26968   '  v: jsvalue;',
26969   'begin',
26970   '  DoIt([pointer(v)]);',
26971   '  DoAll(pointer(v));',
26972   '']);
26973   ConvertProgram;
26974   CheckSource('TestPointer_TypeCastJSValueToPointer',
26975     LinesToStr([ // statements
26976     'this.DoIt = function (args) {',
26977     '};',
26978     'this.DoAll = function () {',
26979     '};',
26980     'this.v = undefined;',
26981     '']),
26982     LinesToStr([ // $mod.$main
26983     '$mod.DoIt([$mod.v]);',
26984     '$mod.DoAll($mod.v);',
26985     '']));
26986 end;
26987 
26988 procedure TTestModule.TestPointer_NonRecordFail;
26989 begin
26990   StartProgram(false);
26991   Add([
26992   'type',
26993   '  p = ^longint;',
26994   'begin',
26995   '']);
26996   SetExpectedPasResolverError('Not supported: pointer of Longint',nNotSupportedX);
26997   ConvertProgram;
26998 end;
26999 
27000 procedure TTestModule.TestPointer_AnonymousArgTypeFail;
27001 begin
27002   StartProgram(false);
27003   Add([
27004   'procedure DoIt(p: ^longint); begin end;',
27005   'begin',
27006   '']);
27007   SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
27008   ConvertProgram;
27009 end;
27010 
27011 procedure TTestModule.TestPointer_AnonymousVarTypeFail;
27012 begin
27013   StartProgram(false);
27014   Add([
27015   'var p: ^longint;',
27016   'begin',
27017   '']);
27018   SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
27019   ConvertProgram;
27020 end;
27021 
27022 procedure TTestModule.TestPointer_AnonymousResultTypeFail;
27023 begin
27024   StartProgram(false);
27025   Add([
27026   'function DoIt: ^longint; begin end;',
27027   'begin',
27028   '']);
27029   SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
27030   ConvertProgram;
27031 end;
27032 
27033 procedure TTestModule.TestPointer_AddrOperatorFail;
27034 begin
27035   StartProgram(false);
27036   Add([
27037   'var i: longint;',
27038   'begin',
27039   '  if @i=nil then ;',
27040   '']);
27041   SetExpectedConverterError('illegal qualifier "@" in front of "i:Longint"',nIllegalQualifierInFrontOf);
27042   ConvertProgram;
27043 end;
27044 
27045 procedure TTestModule.TestPointer_ArrayParamsFail;
27046 begin
27047   StartProgram(false);
27048   Add([
27049   'var',
27050   '  p: Pointer;',
27051   'begin',
27052   '  p:=p[1];',
27053   '']);
27054   SetExpectedPasResolverError('illegal qualifier "[" after "Pointer"',nIllegalQualifierAfter);
27055   ConvertProgram;
27056 end;
27057 
27058 procedure TTestModule.TestPointer_PointerAddFail;
27059 begin
27060   StartProgram(false);
27061   Add([
27062   'var',
27063   '  p: Pointer;',
27064   'begin',
27065   '  p:=p+1;',
27066   '']);
27067   SetExpectedPasResolverError('Operator is not overloaded: "Pointer" + "Longint"',nOperatorIsNotOverloadedAOpB);
27068   ConvertProgram;
27069 end;
27070 
27071 procedure TTestModule.TestPointer_IncPointerFail;
27072 begin
27073   StartProgram(false);
27074   Add([
27075   'var',
27076   '  p: Pointer;',
27077   'begin',
27078   '  inc(p,1);',
27079   '']);
27080   SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Pointer", expected "integer"',
27081     nIncompatibleTypeArgNo);
27082   ConvertProgram;
27083 end;
27084 
27085 procedure TTestModule.TestPointer_Record;
27086 begin
27087   StartProgram(false);
27088   Add([
27089   'type',
27090   '  TRec = record x: longint; end;',
27091   '  PRec = ^TRec;',
27092   'var',
27093   '  r: TRec;',
27094   '  p: PRec;',
27095   '  q: ^TRec;',
27096   '  Ptr: pointer;',
27097   'begin',
27098   '  new(p);',
27099   '  p:=@r;',
27100   '  r:=p^;',
27101   '  r.x:=p^.x;',
27102   '  p^.x:=r.x;',
27103   '  if p^.x=3 then ;',
27104   '  if 4=p^.x then ;',
27105   '  dispose(p);',
27106   '  new(q);',
27107   '  dispose(q);',
27108   '  Ptr:=p;',
27109   '  p:=PRec(ptr);',
27110   '']);
27111   ConvertProgram;
27112   CheckSource('TestPointer_Record',
27113     LinesToStr([ // statements
27114     'rtl.recNewT($mod, "TRec", function () {',
27115     '  this.x = 0;',
27116     '  this.$eq = function (b) {',
27117     '    return this.x === b.x;',
27118     '  };',
27119     '  this.$assign = function (s) {',
27120     '    this.x = s.x;',
27121     '    return this;',
27122     '  };',
27123     '});',
27124     'this.r = $mod.TRec.$new();',
27125     'this.p = null;',
27126     'this.q = null;',
27127     'this.Ptr = null;',
27128     '']),
27129     LinesToStr([ // $mod.$main
27130     '$mod.p = $mod.TRec.$new();',
27131     '$mod.p = $mod.r;',
27132     '$mod.r.$assign($mod.p);',
27133     '$mod.r.x = $mod.p.x;',
27134     '$mod.p.x = $mod.r.x;',
27135     'if ($mod.p.x === 3) ;',
27136     'if (4 === $mod.p.x) ;',
27137     '$mod.p = null;',
27138     '$mod.q = $mod.TRec.$new();',
27139     '$mod.q = null;',
27140     '$mod.Ptr = $mod.p;',
27141     '$mod.p = $mod.Ptr;',
27142     '']));
27143 end;
27144 
27145 procedure TTestModule.TestPointer_RecordArg;
27146 begin
27147   StartProgram(false);
27148   Add([
27149   '{$modeswitch autoderef}',
27150   'type',
27151   '  TRec = record x: longint; end;',
27152   '  PRec = ^TRec;',
27153   'function DoIt(const a: PRec; var b: PRec; out c: PRec): TRec;',
27154   'begin',
27155   '  a.x:=a.x;',
27156   '  a^.x:=a^.x;',
27157   '  with a^ do',
27158   '    x:=x;',
27159   'end;',
27160   'function GetIt(p: PRec): PRec;',
27161   'begin',
27162   '  p.x:=p.x;',
27163   '  p^.x:=p^.x;',
27164   '  with p^ do',
27165   '    x:=x;',
27166   'end;',
27167   'var',
27168   '  r: TRec;',
27169   '  p: PRec;',
27170   'begin',
27171   '  p:=GetIt(p);',
27172   '  p^:=GetIt(@r)^;',
27173   '  DoIt(p,p,p);',
27174   '  DoIt(@r,p,p);',
27175   '']);
27176   ConvertProgram;
27177   CheckSource('TestPointer_Record',
27178     LinesToStr([ // statements
27179     'rtl.recNewT($mod, "TRec", function () {',
27180     '  this.x = 0;',
27181     '  this.$eq = function (b) {',
27182     '    return this.x === b.x;',
27183     '  };',
27184     '  this.$assign = function (s) {',
27185     '    this.x = s.x;',
27186     '    return this;',
27187     '  };',
27188     '});',
27189     'this.DoIt = function (a, b, c) {',
27190     '  var Result = $mod.TRec.$new();',
27191     '  a.x = a.x;',
27192     '  a.x = a.x;',
27193     '  a.x = a.x;',
27194     '  return Result;',
27195     '};',
27196     'this.GetIt = function (p) {',
27197     '  var Result = null;',
27198     '  p.x = p.x;',
27199     '  p.x = p.x;',
27200     '  p.x = p.x;',
27201     '  return Result;',
27202     '};',
27203     'this.r = $mod.TRec.$new();',
27204     'this.p = null;',
27205     '']),
27206     LinesToStr([ // $mod.$main
27207     '$mod.p = $mod.GetIt($mod.p);',
27208     '$mod.p.$assign($mod.GetIt($mod.r));',
27209     '$mod.DoIt($mod.p, {',
27210     '  p: $mod,',
27211     '  get: function () {',
27212     '      return this.p.p;',
27213     '    },',
27214     '  set: function (v) {',
27215     '      this.p.p = v;',
27216     '    }',
27217     '}, {',
27218     '  p: $mod,',
27219     '  get: function () {',
27220     '      return this.p.p;',
27221     '    },',
27222     '  set: function (v) {',
27223     '      this.p.p = v;',
27224     '    }',
27225     '});',
27226     '$mod.DoIt($mod.r, {',
27227     '  p: $mod,',
27228     '  get: function () {',
27229     '      return this.p.p;',
27230     '    },',
27231     '  set: function (v) {',
27232     '      this.p.p = v;',
27233     '    }',
27234     '}, {',
27235     '  p: $mod,',
27236     '  get: function () {',
27237     '      return this.p.p;',
27238     '    },',
27239     '  set: function (v) {',
27240     '      this.p.p = v;',
27241     '    }',
27242     '});',
27243     '']));
27244 end;
27245 
27246 procedure TTestModule.TestJSValue_AssignToJSValue;
27247 begin
27248   StartProgram(false);
27249   Add('var');
27250   Add('  v: jsvalue;');
27251   Add('  i: longint;');
27252   Add('  s: string;');
27253   Add('  b: boolean;');
27254   Add('  d: double;');
27255   Add('  p: pointer;');
27256   Add('begin');
27257   Add('  v:=v;');
27258   Add('  v:=1;');
27259   Add('  v:=i;');
27260   Add('  v:='''';');
27261   Add('  v:=''c'';');
27262   Add('  v:=''foo'';');
27263   Add('  v:=s;');
27264   Add('  v:=false;');
27265   Add('  v:=true;');
27266   Add('  v:=b;');
27267   Add('  v:=0.1;');
27268   Add('  v:=d;');
27269   Add('  v:=nil;');
27270   Add('  v:=p;');
27271   ConvertProgram;
27272   CheckSource('TestJSValue_AssignToJSValue',
27273     LinesToStr([ // statements
27274     'this.v = undefined;',
27275     'this.i = 0;',
27276     'this.s = "";',
27277     'this.b = false;',
27278     'this.d = 0.0;',
27279     'this.p = null;',
27280     '']),
27281     LinesToStr([ // $mod.$main
27282     '$mod.v = $mod.v;',
27283     '$mod.v = 1;',
27284     '$mod.v = $mod.i;',
27285     '$mod.v = "";',
27286     '$mod.v = "c";',
27287     '$mod.v = "foo";',
27288     '$mod.v = $mod.s;',
27289     '$mod.v = false;',
27290     '$mod.v = true;',
27291     '$mod.v = $mod.b;',
27292     '$mod.v = 0.1;',
27293     '$mod.v = $mod.d;',
27294     '$mod.v = null;',
27295     '$mod.v = $mod.p;',
27296     '']));
27297 end;
27298 
27299 procedure TTestModule.TestJSValue_TypeCastToBaseType;
27300 begin
27301   StartProgram(false);
27302   Add('type');
27303   Add('  integer = longint;');
27304   Add('  TYesNo = boolean;');
27305   Add('  TFloat = double;');
27306   Add('  TCaption = string;');
27307   Add('  TChar = char;');
27308   Add('var');
27309   Add('  v: jsvalue;');
27310   Add('  i: integer;');
27311   Add('  s: TCaption;');
27312   Add('  b: TYesNo;');
27313   Add('  d: TFloat;');
27314   Add('  c: char;');
27315   Add('begin');
27316   Add('  i:=longint(v);');
27317   Add('  i:=integer(v);');
27318   Add('  s:=string(v);');
27319   Add('  s:=TCaption(v);');
27320   Add('  b:=boolean(v);');
27321   Add('  b:=TYesNo(v);');
27322   Add('  d:=double(v);');
27323   Add('  d:=TFloat(v);');
27324   Add('  c:=char(v);');
27325   Add('  c:=TChar(v);');
27326   ConvertProgram;
27327   CheckSource('TestJSValue_TypeCastToBaseType',
27328     LinesToStr([ // statements
27329     'this.v = undefined;',
27330     'this.i = 0;',
27331     'this.s = "";',
27332     'this.b = false;',
27333     'this.d = 0.0;',
27334     'this.c = "";',
27335     '']),
27336     LinesToStr([ // $mod.$main
27337     '$mod.i = Math.floor($mod.v);',
27338     '$mod.i = Math.floor($mod.v);',
27339     '$mod.s = "" + $mod.v;',
27340     '$mod.s = "" + $mod.v;',
27341     '$mod.b = !($mod.v == false);',
27342     '$mod.b = !($mod.v == false);',
27343     '$mod.d = rtl.getNumber($mod.v);',
27344     '$mod.d = rtl.getNumber($mod.v);',
27345     '$mod.c = rtl.getChar($mod.v);',
27346     '$mod.c = rtl.getChar($mod.v);',
27347     '']));
27348 end;
27349 
27350 procedure TTestModule.TestJSValue_TypecastToJSValue;
27351 begin
27352   StartProgram(false);
27353   Add([
27354   'type',
27355   '  TArr = array of word;',
27356   '  TRec = record end;',
27357   '  TSet = set of boolean;',
27358   'procedure Fly(v: jsvalue);',
27359   'begin',
27360   'end;',
27361   'var',
27362   '  a: TArr;',
27363   '  r: TRec;',
27364   '  s: TSet;',
27365   'begin',
27366   '  Fly(jsvalue(a));',
27367   '  Fly(jsvalue(r));',
27368   '  Fly(jsvalue(s));',
27369   '']);
27370   ConvertProgram;
27371   CheckSource('TestJSValue_TypecastToJSValue',
27372     LinesToStr([ // statements
27373     'rtl.recNewT($mod, "TRec", function () {',
27374     '  this.$eq = function (b) {',
27375     '    return true;',
27376     '  };',
27377     '  this.$assign = function (s) {',
27378     '    return this;',
27379     '  };',
27380     '});',
27381     'this.Fly = function (v) {',
27382     '};',
27383     'this.a = [];',
27384     'this.r = $mod.TRec.$new();',
27385     'this.s = {};',
27386     '']),
27387     LinesToStr([ // $mod.$main
27388     '$mod.Fly($mod.a);',
27389     '$mod.Fly($mod.r);',
27390     '$mod.Fly($mod.s);',
27391     '']));
27392 end;
27393 
27394 procedure TTestModule.TestJSValue_Equal;
27395 begin
27396   StartProgram(false);
27397   Add('type');
27398   Add('  integer = longint;');
27399   Add('  TYesNo = boolean;');
27400   Add('  TFloat = double;');
27401   Add('  TCaption = string;');
27402   Add('  TChar = char;');
27403   Add('  TMulti = JSValue;');
27404   Add('var');
27405   Add('  v: jsvalue;');
27406   Add('  i: integer;');
27407   Add('  s: TCaption;');
27408   Add('  b: TYesNo;');
27409   Add('  d: TFloat;');
27410   Add('  c: char;');
27411   Add('  m: TMulti;');
27412   Add('begin');
27413   Add('  b:=v=v;');
27414   Add('  b:=v<>v;');
27415   Add('  b:=v=1;');
27416   Add('  b:=v<>1;');
27417   Add('  b:=2=v;');
27418   Add('  b:=2<>v;');
27419   Add('  b:=v=i;');
27420   Add('  b:=i=v;');
27421   Add('  b:=v=nil;');
27422   Add('  b:=nil=v;');
27423   Add('  b:=v=false;');
27424   Add('  b:=true=v;');
27425   Add('  b:=v=b;');
27426   Add('  b:=b=v;');
27427   Add('  b:=v=s;');
27428   Add('  b:=s=v;');
27429   Add('  b:=v=''foo'';');
27430   Add('  b:=''''=v;');
27431   Add('  b:=v=d;');
27432   Add('  b:=d=v;');
27433   Add('  b:=v=3.4;');
27434   Add('  b:=5.6=v;');
27435   Add('  b:=v=c;');
27436   Add('  b:=c=v;');
27437   Add('  b:=m=m;');
27438   Add('  b:=v=m;');
27439   Add('  b:=m=v;');
27440   ConvertProgram;
27441   CheckSource('TestJSValue_Equal',
27442     LinesToStr([ // statements
27443     'this.v = undefined;',
27444     'this.i = 0;',
27445     'this.s = "";',
27446     'this.b = false;',
27447     'this.d = 0.0;',
27448     'this.c = "";',
27449     'this.m = undefined;',
27450     '']),
27451     LinesToStr([ // $mod.$main
27452     '$mod.b = $mod.v == $mod.v;',
27453     '$mod.b = $mod.v != $mod.v;',
27454     '$mod.b = $mod.v == 1;',
27455     '$mod.b = $mod.v != 1;',
27456     '$mod.b = 2 == $mod.v;',
27457     '$mod.b = 2 != $mod.v;',
27458     '$mod.b = $mod.v == $mod.i;',
27459     '$mod.b = $mod.i == $mod.v;',
27460     '$mod.b = $mod.v == null;',
27461     '$mod.b = null == $mod.v;',
27462     '$mod.b = $mod.v == false;',
27463     '$mod.b = true == $mod.v;',
27464     '$mod.b = $mod.v == $mod.b;',
27465     '$mod.b = $mod.b == $mod.v;',
27466     '$mod.b = $mod.v == $mod.s;',
27467     '$mod.b = $mod.s == $mod.v;',
27468     '$mod.b = $mod.v == "foo";',
27469     '$mod.b = "" == $mod.v;',
27470     '$mod.b = $mod.v == $mod.d;',
27471     '$mod.b = $mod.d == $mod.v;',
27472     '$mod.b = $mod.v == 3.4;',
27473     '$mod.b = 5.6 == $mod.v;',
27474     '$mod.b = $mod.v == $mod.c;',
27475     '$mod.b = $mod.c == $mod.v;',
27476     '$mod.b = $mod.m == $mod.m;',
27477     '$mod.b = $mod.v == $mod.m;',
27478     '$mod.b = $mod.m == $mod.v;',
27479     '']));
27480 end;
27481 
27482 procedure TTestModule.TestJSValue_If;
27483 begin
27484   StartProgram(false);
27485   Add([
27486   'procedure Fly(var u);',
27487   'begin',
27488   '  if jsvalue(u) then ;',
27489   'end;',
27490   'var',
27491   '  v: jsvalue;',
27492   'begin',
27493   '  if v then ;',
27494   '  while v do ;',
27495   '  repeat until v;',
27496   '']);
27497   ConvertProgram;
27498   CheckSource('TestJSValue_If',
27499     LinesToStr([ // statements
27500     'this.Fly = function (u) {',
27501     '  if (u.get()) ;',
27502     '};',
27503     'this.v = undefined;',
27504     '']),
27505     LinesToStr([ // $mod.$main
27506     'if ($mod.v) ;',
27507     'while($mod.v){',
27508     '};',
27509     'do{',
27510     '} while(!$mod.v);',
27511     '']));
27512 end;
27513 
27514 procedure TTestModule.TestJSValue_Not;
27515 begin
27516   StartProgram(false);
27517   Add([
27518   'var',
27519   '  v: jsvalue;',
27520   '  b: boolean;',
27521   'begin',
27522   '  b:=not v;',
27523   '  if not v then ;',
27524   '  while not v do ;',
27525   '  repeat until not v;',
27526   '']);
27527   ConvertProgram;
27528   CheckSource('TestJSValue_If',
27529     LinesToStr([ // statements
27530     'this.v = undefined;',
27531     'this.b = false;',
27532     '']),
27533     LinesToStr([ // $mod.$main
27534     '$mod.b=!$mod.v;',
27535     'if (!$mod.v) ;',
27536     'while(!$mod.v){',
27537     '};',
27538     'do{',
27539     '} while($mod.v);',
27540     '']));
27541 end;
27542 
27543 procedure TTestModule.TestJSValue_Enum;
27544 begin
27545   StartProgram(false);
27546   Add('type');
27547   Add('  TColor = (red, blue);');
27548   Add('  TRedBlue = TColor;');
27549   Add('var');
27550   Add('  v: jsvalue;');
27551   Add('  e: TColor;');
27552   Add('begin');
27553   Add('  v:=e;');
27554   Add('  v:=TColor(e);');
27555   Add('  v:=TRedBlue(e);');
27556   Add('  e:=TColor(v);');
27557   Add('  e:=TRedBlue(v);');
27558   ConvertProgram;
27559   CheckSource('TestJSValue_Enum',
27560     LinesToStr([ // statements
27561     'this.TColor = {',
27562     '  "0": "red",',
27563     '  red: 0,',
27564     '  "1": "blue",',
27565     '  blue: 1',
27566     '};',
27567     'this.v = undefined;',
27568     'this.e = 0;',
27569     '']),
27570     LinesToStr([ // $mod.$main
27571     '$mod.v = $mod.e;',
27572     '$mod.v = $mod.e;',
27573     '$mod.v = $mod.e;',
27574     '$mod.e = $mod.v;',
27575     '$mod.e = $mod.v;',
27576     '']));
27577 end;
27578 
27579 procedure TTestModule.TestJSValue_ClassInstance;
27580 begin
27581   StartProgram(false);
27582   Add([
27583   'type',
27584   '  TObject = class',
27585   '  end;',
27586   '  TBirdObject = TObject;',
27587   'var',
27588   '  v: jsvalue;',
27589   '  o: TObject;',
27590   'begin',
27591   '  v:=o;',
27592   '  v:=TObject(o);',
27593   '  v:=TBirdObject(o);',
27594   '  o:=TObject(v);',
27595   '  o:=TBirdObject(v);',
27596   '  if v is TObject then ;',
27597   '']);
27598   ConvertProgram;
27599   CheckSource('TestJSValue_ClassInstance',
27600     LinesToStr([ // statements
27601     'rtl.createClass($mod, "TObject", null, function () {',
27602     '  this.$init = function () {',
27603     '  };',
27604     '  this.$final = function () {',
27605     '  };',
27606     '});',
27607     'this.v = undefined;',
27608     'this.o = null;',
27609     '']),
27610     LinesToStr([ // $mod.$main
27611     '$mod.v = $mod.o;',
27612     '$mod.v = $mod.o;',
27613     '$mod.v = $mod.o;',
27614     '$mod.o = rtl.getObject($mod.v);',
27615     '$mod.o = rtl.getObject($mod.v);',
27616     'if (rtl.isExt($mod.v, $mod.TObject, 1)) ;',
27617     '']));
27618 end;
27619 
27620 procedure TTestModule.TestJSValue_ClassOf;
27621 begin
27622   StartProgram(false);
27623   Add([
27624   'type',
27625   '  TClass = class of TObject;',
27626   '  TObject = class',
27627   '  end;',
27628   '  TBirds = class of TBird;',
27629   '  TBird = class(TObject) end;',
27630   'var',
27631   '  v: jsvalue;',
27632   '  c: TClass;',
27633   'begin',
27634   '  v:=c;',
27635   '  v:=TObject;',
27636   '  v:=TClass(c);',
27637   '  v:=TBirds(c);',
27638   '  c:=TClass(v);',
27639   '  c:=TBirds(v);',
27640   '  if v is TClass then ;',
27641   '']);
27642   ConvertProgram;
27643   CheckSource('TestJSValue_ClassOf',
27644     LinesToStr([ // statements
27645     'rtl.createClass($mod, "TObject", null, function () {',
27646     '  this.$init = function () {',
27647     '  };',
27648     '  this.$final = function () {',
27649     '  };',
27650     '});',
27651     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
27652     '});',
27653     'this.v = undefined;',
27654     'this.c = null;',
27655     '']),
27656     LinesToStr([ // $mod.$main
27657     '$mod.v = $mod.c;',
27658     '$mod.v = $mod.TObject;',
27659     '$mod.v = $mod.c;',
27660     '$mod.v = $mod.c;',
27661     '$mod.c = rtl.getObject($mod.v);',
27662     '$mod.c = rtl.getObject($mod.v);',
27663     'if (rtl.isExt($mod.v, $mod.TObject, 2)) ;',
27664     '']));
27665 end;
27666 
27667 procedure TTestModule.TestJSValue_ArrayOfJSValue;
27668 begin
27669   StartProgram(false);
27670   Add([
27671   'type',
27672   '  integer = longint;',
27673   '  TArray = array of JSValue;',
27674   '  TArrgh = tarray;',
27675   '  TArrInt = array of integer;',
27676   'var',
27677   '  v: jsvalue;',
27678   '  TheArray: tarray = (1,''2'');',
27679   '  Arr: tarrgh;',
27680   '  i: integer;',
27681   '  ArrInt: tarrint;',
27682   'begin',
27683   '  arr:=thearray;',
27684   '  thearray:=arr;',
27685   '  setlength(arr,2);',
27686   '  setlength(thearray,3);',
27687   '  arr[4]:=v;',
27688   '  arr[5]:=length(thearray);',
27689   '  arr[6]:=nil;',
27690   '  arr[7]:=thearray[8];',
27691   '  arr[low(arr)]:=high(thearray);',
27692   '  arr:=arrint;',
27693   '  arrInt:=tarrint(arr);',
27694   '  if TheArray = nil then ;',
27695   '  if nil = TheArray then ;',
27696   '  if TheArray <> nil then ;',
27697   '  if nil <> TheArray then ;',
27698   '']);
27699   ConvertProgram;
27700   CheckSource('TestJSValue_ArrayOfJSValue',
27701     LinesToStr([ // statements
27702     'this.v = undefined;',
27703     'this.TheArray = [1, "2"];',
27704     'this.Arr = [];',
27705     'this.i = 0;',
27706     'this.ArrInt = [];',
27707     '']),
27708     LinesToStr([ // $mod.$main
27709     '$mod.Arr = rtl.arrayRef($mod.TheArray);',
27710     '$mod.TheArray = rtl.arrayRef($mod.Arr);',
27711     '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
27712     '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
27713     '$mod.Arr[4] = $mod.v;',
27714     '$mod.Arr[5] = rtl.length($mod.TheArray);',
27715     '$mod.Arr[6] = null;',
27716     '$mod.Arr[7] = $mod.TheArray[8];',
27717     '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
27718     '$mod.Arr = rtl.arrayRef($mod.ArrInt);',
27719     '$mod.ArrInt = $mod.Arr;',
27720     'if (rtl.length($mod.TheArray) === 0) ;',
27721     'if (rtl.length($mod.TheArray) === 0) ;',
27722     'if (rtl.length($mod.TheArray) > 0) ;',
27723     'if (rtl.length($mod.TheArray) > 0) ;',
27724     '']));
27725 end;
27726 
27727 procedure TTestModule.TestJSValue_ArrayLit;
27728 begin
27729   StartProgram(false);
27730   Add([
27731   'type',
27732   '  TFlag = (big,small);',
27733   '  TArray = array of JSValue;',
27734   '  TObject = class end;',
27735   '  TClass = class of TObject;',
27736   'var',
27737   '  v: jsvalue;',
27738   '  a: TArray;',
27739   '  o: TObject;',
27740   'begin',
27741   '  a:=[];',
27742   '  a:=[1];',
27743   '  a:=[1,2];',
27744   '  a:=[big];',
27745   '  a:=[1,big];',
27746   '  a:=[o,nil];',
27747   '']);
27748   ConvertProgram;
27749   CheckSource('TestJSValue_ArrayLit',
27750     LinesToStr([ // statements
27751     'this.TFlag = {',
27752     '  "0": "big",',
27753     '  big: 0,',
27754     '  "1": "small",',
27755     '  small: 1',
27756     '};',
27757     'rtl.createClass($mod, "TObject", null, function () {',
27758     '  this.$init = function () {',
27759     '  };',
27760     '  this.$final = function () {',
27761     '  };',
27762     '});',
27763     'this.v = undefined;',
27764     'this.a = [];',
27765     'this.o = null;',
27766     '']),
27767     LinesToStr([ // $mod.$main
27768     '$mod.a = [];',
27769     '$mod.a = [1];',
27770     '$mod.a = [1, 2];',
27771     '$mod.a = [$mod.TFlag.big];',
27772     '$mod.a = [1, $mod.TFlag.big];',
27773     '$mod.a = [$mod.o, null];',
27774     '']));
27775 end;
27776 
27777 procedure TTestModule.TestJSValue_Params;
27778 begin
27779   StartProgram(false);
27780   Add('type');
27781   Add('  integer = longint;');
27782   Add('  TYesNo = boolean;');
27783   Add('  TFloat = double;');
27784   Add('  TCaption = string;');
27785   Add('  TChar = char;');
27786   Add('function DoIt(a: jsvalue; const b: jsvalue; var c: jsvalue; out d: jsvalue): jsvalue;');
27787   Add('var');
27788   Add('  l: jsvalue;');
27789   Add('begin');
27790   Add('  a:=a;');
27791   Add('  l:=b;');
27792   Add('  c:=c;');
27793   Add('  d:=d;');
27794   Add('  Result:=l;');
27795   Add('end;');
27796   Add('function DoSome(a: jsvalue; const b: jsvalue): jsvalue; begin end;');
27797   Add('var');
27798   Add('  v: jsvalue;');
27799   Add('  i: integer;');
27800   Add('  b: TYesNo;');
27801   Add('  d: TFloat;');
27802   Add('  s: TCaption;');
27803   Add('  c: TChar;');
27804   Add('begin');
27805   Add('  v:=doit(v,v,v,v);');
27806   Add('  i:=integer(dosome(i,i));');
27807   Add('  b:=TYesNo(dosome(b,b));');
27808   Add('  d:=TFloat(dosome(d,d));');
27809   Add('  s:=TCaption(dosome(s,s));');
27810   Add('  c:=TChar(dosome(c,c));');
27811   ConvertProgram;
27812   CheckSource('TestJSValue_Params',
27813     LinesToStr([ // statements
27814     'this.DoIt = function (a, b, c, d) {',
27815     '  var Result = undefined;',
27816     '  var l = undefined;',
27817     '  a = a;',
27818     '  l = b;',
27819     '  c.set(c.get());',
27820     '  d.set(d.get());',
27821     '  Result = l;',
27822     '  return Result;',
27823     '};',
27824     'this.DoSome = function (a, b) {',
27825     '  var Result = undefined;',
27826     '  return Result;',
27827     '};',
27828     'this.v = undefined;',
27829     'this.i = 0;',
27830     'this.b = false;',
27831     'this.d = 0.0;',
27832     'this.s = "";',
27833     'this.c = "";',
27834     '']),
27835     LinesToStr([ // $mod.$main
27836     '$mod.v = $mod.DoIt($mod.v, $mod.v, {',
27837     '  p: $mod,',
27838     '  get: function () {',
27839     '      return this.p.v;',
27840     '    },',
27841     '  set: function (v) {',
27842     '      this.p.v = v;',
27843     '    }',
27844     '}, {',
27845     '  p: $mod,',
27846     '  get: function () {',
27847     '      return this.p.v;',
27848     '    },',
27849     '  set: function (v) {',
27850     '      this.p.v = v;',
27851     '    }',
27852     '});',
27853     '$mod.i = Math.floor($mod.DoSome($mod.i, $mod.i));',
27854     '$mod.b = !($mod.DoSome($mod.b, $mod.b) == false);',
27855     '$mod.d = rtl.getNumber($mod.DoSome($mod.d, $mod.d));',
27856     '$mod.s = "" + $mod.DoSome($mod.s, $mod.s);',
27857     '$mod.c = rtl.getChar($mod.DoSome($mod.c, $mod.c));',
27858     '']));
27859 end;
27860 
27861 procedure TTestModule.TestJSValue_UntypedParam;
27862 begin
27863   StartProgram(false);
27864   Add('function DoIt(const a; var b; out c): jsvalue;');
27865   Add('begin');
27866   Add('  Result:=a;');
27867   Add('  Result:=b;');
27868   Add('  Result:=c;');
27869   Add('  b:=Result;');
27870   Add('  c:=Result;');
27871   Add('end;');
27872   Add('var i: longint;');
27873   Add('begin');
27874   Add('  doit(i,i,i);');
27875   ConvertProgram;
27876   CheckSource('TestJSValue_UntypedParam',
27877     LinesToStr([ // statements
27878     'this.DoIt = function (a, b, c) {',
27879     '  var Result = undefined;',
27880     '  Result = a;',
27881     '  Result = b.get();',
27882     '  Result = c.get();',
27883     '  b.set(Result);',
27884     '  c.set(Result);',
27885     '  return Result;',
27886     '};',
27887     'this.i = 0;',
27888     '']),
27889     LinesToStr([ // $mod.$main
27890     '$mod.DoIt($mod.i, {',
27891     '  p: $mod,',
27892     '  get: function () {',
27893     '      return this.p.i;',
27894     '    },',
27895     '  set: function (v) {',
27896     '      this.p.i = v;',
27897     '    }',
27898     '}, {',
27899     '  p: $mod,',
27900     '  get: function () {',
27901     '      return this.p.i;',
27902     '    },',
27903     '  set: function (v) {',
27904     '      this.p.i = v;',
27905     '    }',
27906     '});',
27907     '']));
27908 end;
27909 
27910 procedure TTestModule.TestJSValue_FuncResultType;
27911 begin
27912   StartProgram(false);
27913   Add('type');
27914   Add('  integer = longint;');
27915   Add('  TJSValueArray = array of JSValue;');
27916   Add('  TListSortCompare = function(Item1, Item2: JSValue): Integer;');
27917   Add('procedure Sort(P: JSValue; aList: TJSValueArray; const Compare: TListSortCompare);');
27918   Add('begin');
27919   Add('  while Compare(P,aList[0])>0 do ;');
27920   Add('end;');
27921   Add('var');
27922   Add('  Compare: TListSortCompare;');
27923   Add('  V: JSValue;');
27924   Add('  i: integer;');
27925   Add('begin');
27926   Add('  if Compare(V,V)>0 then ;');
27927   Add('  if Compare(i,i)>1 then ;');
27928   Add('  if Compare(nil,false)>2 then ;');
27929   Add('  if Compare(1,true)>3 then ;');
27930   ConvertProgram;
27931   CheckSource('TestJSValue_UntypedParam',
27932     LinesToStr([ // statements
27933     'this.Sort = function (P, aList, Compare) {',
27934     '  while (Compare(P, aList[0]) > 0) {',
27935     '  };',
27936     '};',
27937     'this.Compare = null;',
27938     'this.V = undefined;',
27939     'this.i = 0;',
27940     '']),
27941     LinesToStr([ // $mod.$main
27942     'if ($mod.Compare($mod.V, $mod.V) > 0) ;',
27943     'if ($mod.Compare($mod.i, $mod.i) > 1) ;',
27944     'if ($mod.Compare(null, false) > 2) ;',
27945     'if ($mod.Compare(1, true) > 3) ;',
27946     '']));
27947 end;
27948 
27949 procedure TTestModule.TestJSValue_ProcType_Assign;
27950 begin
27951   StartProgram(false);
27952   Add('type');
27953   Add('  integer = longint;');
27954   Add('  TObject = class');
27955   Add('    class function GetGlob: integer;');
27956   Add('    function Getter: integer;');
27957   Add('  end;');
27958   Add('class function TObject.GetGlob: integer;');
27959   Add('var v1: jsvalue;');
27960   Add('begin');
27961   Add('  v1:=@GetGlob;');
27962   Add('  v1:=@Self.GetGlob;');
27963   Add('end;');
27964   Add('function TObject.Getter: integer;');
27965   Add('var v2: jsvalue;');
27966   Add('begin');
27967   Add('  v2:=@Getter;');
27968   Add('  v2:=@Self.Getter;');
27969   Add('  v2:=@GetGlob;');
27970   Add('  v2:=@Self.GetGlob;');
27971   Add('end;');
27972   Add('function GetIt(i: integer): integer;');
27973   Add('var v3: jsvalue;');
27974   Add('begin');
27975   Add('  v3:=@GetIt;');
27976   Add('end;');
27977   Add('var');
27978   Add('  V: JSValue;');
27979   Add('  o: TObject;');
27980   Add('begin');
27981   Add('  v:=@GetIt;');
27982   Add('  v:=@o.Getter;');
27983   Add('  v:=@o.GetGlob;');
27984   ConvertProgram;
27985   CheckSource('TestJSValue_ProcType_Assign',
27986     LinesToStr([ // statements
27987     'rtl.createClass($mod, "TObject", null, function () {',
27988     '  this.$init = function () {',
27989     '  };',
27990     '  this.$final = function () {',
27991     '  };',
27992     '  this.GetGlob = function () {',
27993     '    var Result = 0;',
27994     '    var v1 = undefined;',
27995     '    v1 = rtl.createCallback(this, "GetGlob");',
27996     '    v1 = rtl.createCallback(this, "GetGlob");',
27997     '    return Result;',
27998     '  };',
27999     '  this.Getter = function () {',
28000     '    var Result = 0;',
28001     '    var v2 = undefined;',
28002     '    v2 = rtl.createCallback(this, "Getter");',
28003     '    v2 = rtl.createCallback(this, "Getter");',
28004     '    v2 = rtl.createCallback(this.$class, "GetGlob");',
28005     '    v2 = rtl.createCallback(this.$class, "GetGlob");',
28006     '    return Result;',
28007     '  };',
28008     '});',
28009     'this.GetIt = function (i) {',
28010     '  var Result = 0;',
28011     '  var v3 = undefined;',
28012     '  v3 = $mod.GetIt;',
28013     '  return Result;',
28014     '};',
28015     'this.V = undefined;',
28016     'this.o = null;',
28017     '']),
28018     LinesToStr([ // $mod.$main
28019     '$mod.V = $mod.GetIt;',
28020     '$mod.V = rtl.createCallback($mod.o, "Getter");',
28021     '$mod.V = rtl.createCallback($mod.o.$class, "GetGlob");',
28022     '']));
28023 end;
28024 
28025 procedure TTestModule.TestJSValue_ProcType_Equal;
28026 begin
28027   StartProgram(false);
28028   Add('type');
28029   Add('  integer = longint;');
28030   Add('  TObject = class');
28031   Add('    class function GetGlob: integer;');
28032   Add('    function Getter: integer;');
28033   Add('  end;');
28034   Add('class function TObject.GetGlob: integer;');
28035   Add('var v1: jsvalue;');
28036   Add('begin');
28037   Add('  if v1=@GetGlob then;');
28038   Add('  if v1=@Self.GetGlob then ;');
28039   Add('end;');
28040   Add('function TObject.Getter: integer;');
28041   Add('var v2: jsvalue;');
28042   Add('begin');
28043   Add('  if v2=@Getter then;');
28044   Add('  if v2=@Self.Getter then ;');
28045   Add('  if v2=@GetGlob then;');
28046   Add('  if v2=@Self.GetGlob then;');
28047   Add('end;');
28048   Add('function GetIt(i: integer): integer;');
28049   Add('var v3: jsvalue;');
28050   Add('begin');
28051   Add('  if v3=@GetIt then;');
28052   Add('end;');
28053   Add('var');
28054   Add('  V: JSValue;');
28055   Add('  o: TObject;');
28056   Add('begin');
28057   Add('  if v=@GetIt then;');
28058   Add('  if v=@o.Getter then;');
28059   Add('  if v=@o.GetGlob then;');
28060   Add('  if @GetIt=v then;');
28061   Add('  if @o.Getter=v then;');
28062   Add('  if @o.GetGlob=v then;');
28063   ConvertProgram;
28064   CheckSource('TestJSValue_ProcType_Equal',
28065     LinesToStr([ // statements
28066     'rtl.createClass($mod, "TObject", null, function () {',
28067     '  this.$init = function () {',
28068     '  };',
28069     '  this.$final = function () {',
28070     '  };',
28071     '  this.GetGlob = function () {',
28072     '    var Result = 0;',
28073     '    var v1 = undefined;',
28074     '    if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
28075     '    if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
28076     '    return Result;',
28077     '  };',
28078     '  this.Getter = function () {',
28079     '    var Result = 0;',
28080     '    var v2 = undefined;',
28081     '    if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
28082     '    if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
28083     '    if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
28084     '    if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
28085     '    return Result;',
28086     '  };',
28087     '});',
28088     'this.GetIt = function (i) {',
28089     '  var Result = 0;',
28090     '  var v3 = undefined;',
28091     '  if (rtl.eqCallback(v3, $mod.GetIt)) ;',
28092     '  return Result;',
28093     '};',
28094     'this.V = undefined;',
28095     'this.o = null;',
28096     '']),
28097     LinesToStr([ // $mod.$main
28098     'if (rtl.eqCallback($mod.V, $mod.GetIt)) ;',
28099     'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o, "Getter"))) ;',
28100     'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o.$class, "GetGlob"))) ;',
28101     'if (rtl.eqCallback($mod.GetIt, $mod.V)) ;',
28102     'if (rtl.eqCallback(rtl.createCallback($mod.o, "Getter"), $mod.V)) ;',
28103     'if (rtl.eqCallback(rtl.createCallback($mod.o.$class, "GetGlob"), $mod.V)) ;',
28104     '']));
28105 end;
28106 
28107 procedure TTestModule.TestJSValue_ProcType_Param;
28108 begin
28109   StartProgram(false);
28110   Add([
28111   'type',
28112   '  variant = jsvalue;',
28113   '  TArrVariant = array of variant;',
28114   '  TArrVar2 = TArrVariant;',
28115   '  TFuncInt = function: longint;',
28116   'function GetIt: longint;',
28117   'begin',
28118   'end;',
28119   'procedure DoIt(p: jsvalue; Arr: TArrVar2);',
28120   'var v: variant;',
28121   'begin',
28122   '  v:=arr[1];',
28123   'end;',
28124   'var s: string;',
28125   'begin',
28126   '  DoIt(GetIt,[]);',
28127   '  DoIt(@GetIt,[]);',
28128   '  DoIt(1,[s,GetIt]);',
28129   '  DoIt(1,[s,@GetIt]);',
28130   '']);
28131   ConvertProgram;
28132   CheckSource('TestJSValue_ProcType_Param',
28133     LinesToStr([ // statements
28134     'this.GetIt = function () {',
28135     '  var Result = 0;',
28136     '  return Result;',
28137     '};',
28138     'this.DoIt = function (p, Arr) {',
28139     '  var v = undefined;',
28140     '  v = Arr[1];',
28141     '};',
28142     'this.s = "";',
28143     '']),
28144     LinesToStr([ // $mod.$main
28145     '$mod.DoIt($mod.GetIt(), []);',
28146     '$mod.DoIt($mod.GetIt, []);',
28147     '$mod.DoIt(1, [$mod.s, $mod.GetIt()]);',
28148     '$mod.DoIt(1, [$mod.s, $mod.GetIt]);',
28149     '']));
28150 end;
28151 
28152 procedure TTestModule.TestJSValue_AssignToPointerFail;
28153 begin
28154   StartProgram(false);
28155   Add([
28156   'var',
28157   '  v: JSValue;',
28158   '  p: Pointer;',
28159   'begin',
28160   '  p:=v;',
28161   '']);
28162   SetExpectedPasResolverError('Incompatible types: got "JSValue" expected "Pointer"',
28163     nIncompatibleTypesGotExpected);
28164   ConvertProgram;
28165 end;
28166 
28167 procedure TTestModule.TestJSValue_OverloadDouble;
28168 begin
28169   StartProgram(false);
28170   Add([
28171   'type',
28172   '  integer = longint;',
28173   '  tdatetime = double;',
28174   'procedure DoIt(d: double); begin end;',
28175   'procedure DoIt(v: jsvalue); begin end;',
28176   'var',
28177   '  d: double;',
28178   '  dt: tdatetime;',
28179   '  i: integer;',
28180   '  b: byte;',
28181   '  shi: shortint;',
28182   '  w: word;',
28183   '  smi: smallint;',
28184   '  lw: longword;',
28185   '  li: longint;',
28186   '  ni: nativeint;',
28187   '  nu: nativeuint;',
28188   'begin',
28189   '  DoIt(d);',
28190   '  DoIt(dt);',
28191   '  DoIt(i);',
28192   '  DoIt(b);',
28193   '  DoIt(shi);',
28194   '  DoIt(w);',
28195   '  DoIt(smi);',
28196   '  DoIt(lw);',
28197   '  DoIt(li);',
28198   '  DoIt(ni);',
28199   '  DoIt(nu);',
28200   '']);
28201   ConvertProgram;
28202   CheckSource('TestJSValue_OverloadDouble',
28203     LinesToStr([ // statements
28204     'this.DoIt = function (d) {',
28205     '};',
28206     'this.DoIt$1 = function (v) {',
28207     '};',
28208     'this.d = 0.0;',
28209     'this.dt = 0.0;',
28210     'this.i = 0;',
28211     'this.b = 0;',
28212     'this.shi = 0;',
28213     'this.w = 0;',
28214     'this.smi = 0;',
28215     'this.lw = 0;',
28216     'this.li = 0;',
28217     'this.ni = 0;',
28218     'this.nu = 0;',
28219     '']),
28220     LinesToStr([ // $mod.$main
28221     '$mod.DoIt($mod.d);',
28222     '$mod.DoIt($mod.dt);',
28223     '$mod.DoIt$1($mod.i);',
28224     '$mod.DoIt$1($mod.b);',
28225     '$mod.DoIt$1($mod.shi);',
28226     '$mod.DoIt$1($mod.w);',
28227     '$mod.DoIt$1($mod.smi);',
28228     '$mod.DoIt$1($mod.lw);',
28229     '$mod.DoIt$1($mod.li);',
28230     '$mod.DoIt$1($mod.ni);',
28231     '$mod.DoIt$1($mod.nu);',
28232     '']));
28233 end;
28234 
28235 procedure TTestModule.TestJSValue_OverloadNativeInt;
28236 begin
28237   StartProgram(false);
28238   Add([
28239   'type',
28240   '  integer = longint;',
28241   '  int53 = nativeint;',
28242   '  tdatetime = double;',
28243   'procedure DoIt(n: nativeint); begin end;',
28244   'procedure DoIt(v: jsvalue); begin end;',
28245   'var',
28246   '  d: double;',
28247   '  dt: tdatetime;',
28248   '  i: integer;',
28249   '  b: byte;',
28250   '  shi: shortint;',
28251   '  w: word;',
28252   '  smi: smallint;',
28253   '  lw: longword;',
28254   '  li: longint;',
28255   '  ni: nativeint;',
28256   '  nu: nativeuint;',
28257   'begin',
28258   '  DoIt(d);',
28259   '  DoIt(dt);',
28260   '  DoIt(i);',
28261   '  DoIt(b);',
28262   '  DoIt(shi);',
28263   '  DoIt(w);',
28264   '  DoIt(smi);',
28265   '  DoIt(lw);',
28266   '  DoIt(li);',
28267   '  DoIt(ni);',
28268   '  DoIt(nu);',
28269   '']);
28270   ConvertProgram;
28271   CheckSource('TestJSValue_OverloadNativeInt',
28272     LinesToStr([ // statements
28273     'this.DoIt = function (n) {',
28274     '};',
28275     'this.DoIt$1 = function (v) {',
28276     '};',
28277     'this.d = 0.0;',
28278     'this.dt = 0.0;',
28279     'this.i = 0;',
28280     'this.b = 0;',
28281     'this.shi = 0;',
28282     'this.w = 0;',
28283     'this.smi = 0;',
28284     'this.lw = 0;',
28285     'this.li = 0;',
28286     'this.ni = 0;',
28287     'this.nu = 0;',
28288     '']),
28289     LinesToStr([ // $mod.$main
28290     '$mod.DoIt$1($mod.d);',
28291     '$mod.DoIt$1($mod.dt);',
28292     '$mod.DoIt($mod.i);',
28293     '$mod.DoIt($mod.b);',
28294     '$mod.DoIt($mod.shi);',
28295     '$mod.DoIt($mod.w);',
28296     '$mod.DoIt($mod.smi);',
28297     '$mod.DoIt($mod.lw);',
28298     '$mod.DoIt($mod.li);',
28299     '$mod.DoIt($mod.ni);',
28300     '$mod.DoIt($mod.nu);',
28301     '']));
28302 end;
28303 
28304 procedure TTestModule.TestJSValue_OverloadWord;
28305 begin
28306   StartProgram(false);
28307   Add([
28308   'type',
28309   '  integer = longint;',
28310   '  int53 = nativeint;',
28311   '  tdatetime = double;',
28312   'procedure DoIt(w: word); begin end;',
28313   'procedure DoIt(v: jsvalue); begin end;',
28314   'var',
28315   '  d: double;',
28316   '  dt: tdatetime;',
28317   '  i: integer;',
28318   '  b: byte;',
28319   '  shi: shortint;',
28320   '  w: word;',
28321   '  smi: smallint;',
28322   '  lw: longword;',
28323   '  li: longint;',
28324   '  ni: nativeint;',
28325   '  nu: nativeuint;',
28326   'begin',
28327   '  DoIt(d);',
28328   '  DoIt(dt);',
28329   '  DoIt(i);',
28330   '  DoIt(b);',
28331   '  DoIt(shi);',
28332   '  DoIt(w);',
28333   '  DoIt(smi);',
28334   '  DoIt(lw);',
28335   '  DoIt(li);',
28336   '  DoIt(ni);',
28337   '  DoIt(nu);',
28338   '']);
28339   ConvertProgram;
28340   CheckSource('TestJSValue_OverloadWord',
28341     LinesToStr([ // statements
28342     'this.DoIt = function (w) {',
28343     '};',
28344     'this.DoIt$1 = function (v) {',
28345     '};',
28346     'this.d = 0.0;',
28347     'this.dt = 0.0;',
28348     'this.i = 0;',
28349     'this.b = 0;',
28350     'this.shi = 0;',
28351     'this.w = 0;',
28352     'this.smi = 0;',
28353     'this.lw = 0;',
28354     'this.li = 0;',
28355     'this.ni = 0;',
28356     'this.nu = 0;',
28357     '']),
28358     LinesToStr([ // $mod.$main
28359     '$mod.DoIt$1($mod.d);',
28360     '$mod.DoIt$1($mod.dt);',
28361     '$mod.DoIt$1($mod.i);',
28362     '$mod.DoIt($mod.b);',
28363     '$mod.DoIt($mod.shi);',
28364     '$mod.DoIt($mod.w);',
28365     '$mod.DoIt$1($mod.smi);',
28366     '$mod.DoIt$1($mod.lw);',
28367     '$mod.DoIt$1($mod.li);',
28368     '$mod.DoIt$1($mod.ni);',
28369     '$mod.DoIt$1($mod.nu);',
28370     '']));
28371 end;
28372 
28373 procedure TTestModule.TestJSValue_OverloadString;
28374 begin
28375   StartProgram(false);
28376   Add([
28377   'type',
28378   '  uni = string;',
28379   '  WChar = char;',
28380   'procedure DoIt(s: string); begin end;',
28381   'procedure DoIt(v: jsvalue); begin end;',
28382   'var',
28383   '  s: string;',
28384   '  c: char;',
28385   '  u: uni;',
28386   'begin',
28387   '  DoIt(s);',
28388   '  DoIt(c);',
28389   '  DoIt(u);',
28390   '']);
28391   ConvertProgram;
28392   CheckSource('TestJSValue_OverloadString',
28393     LinesToStr([ // statements
28394     'this.DoIt = function (s) {',
28395     '};',
28396     'this.DoIt$1 = function (v) {',
28397     '};',
28398     'this.s = "";',
28399     'this.c = "";',
28400     'this.u = "";',
28401     '']),
28402     LinesToStr([ // $mod.$main
28403     '$mod.DoIt($mod.s);',
28404     '$mod.DoIt($mod.c);',
28405     '$mod.DoIt($mod.u);',
28406     '']));
28407 end;
28408 
28409 procedure TTestModule.TestJSValue_OverloadChar;
28410 begin
28411   StartProgram(false);
28412   Add([
28413   'type',
28414   '  uni = string;',
28415   '  WChar = char;',
28416   'procedure DoIt(c: char); begin end;',
28417   'procedure DoIt(v: jsvalue); begin end;',
28418   'var',
28419   '  s: string;',
28420   '  c: char;',
28421   '  u: uni;',
28422   'begin',
28423   '  DoIt(s);',
28424   '  DoIt(c);',
28425   '  DoIt(u);',
28426   '']);
28427   ConvertProgram;
28428   CheckSource('TestJSValue_OverloadChar',
28429     LinesToStr([ // statements
28430     'this.DoIt = function (c) {',
28431     '};',
28432     'this.DoIt$1 = function (v) {',
28433     '};',
28434     'this.s = "";',
28435     'this.c = "";',
28436     'this.u = "";',
28437     '']),
28438     LinesToStr([ // $mod.$main
28439     '$mod.DoIt$1($mod.s);',
28440     '$mod.DoIt($mod.c);',
28441     '$mod.DoIt$1($mod.u);',
28442     '']));
28443 end;
28444 
28445 procedure TTestModule.TestJSValue_OverloadPointer;
28446 begin
28447   StartProgram(false);
28448   Add([
28449   'type',
28450   '  TObject = class end;',
28451   'procedure DoIt(p: pointer); begin end;',
28452   'procedure DoIt(v: jsvalue); begin end;',
28453   'var',
28454   '  o: TObject;',
28455   'begin',
28456   '  DoIt(o);',
28457   '']);
28458   ConvertProgram;
28459   CheckSource('TestJSValue_OverloadPointer',
28460     LinesToStr([ // statements
28461     'rtl.createClass($mod, "TObject", null, function () {',
28462     '  this.$init = function () {',
28463     '  };',
28464     '  this.$final = function () {',
28465     '  };',
28466     '});',
28467     'this.DoIt = function (p) {',
28468     '};',
28469     'this.DoIt$1 = function (v) {',
28470     '};',
28471     'this.o = null;',
28472     '']),
28473     LinesToStr([ // $mod.$main
28474     '$mod.DoIt($mod.o);',
28475     '']));
28476 end;
28477 
28478 procedure TTestModule.TestJSValue_ForIn;
28479 begin
28480   StartProgram(false);
28481   Add([
28482   'var',
28483   '  v: JSValue;',
28484   '  key: string;',
28485   'begin',
28486   '  for key in v do begin',
28487   '    if key=''abc'' then ;',
28488   '  end;',
28489   '']);
28490   ConvertProgram;
28491   CheckSource('TestJSValue_ForIn',
28492     LinesToStr([ // statements
28493     'this.v = undefined;',
28494     'this.key = "";',
28495     '']),
28496     LinesToStr([ // $mod.$main
28497     'for ($mod.key in $mod.v) {',
28498     '  if ($mod.key === "abc") ;',
28499     '};',
28500     '']));
28501 end;
28502 
28503 procedure TTestModule.TestRTTI_IntRange;
28504 begin
28505   Converter.Options:=Converter.Options-[coNoTypeInfo];
28506   StartProgram(true,[supTypeInfo]);
28507   Add([
28508   '{$modeswitch externalclass}',
28509   'type',
28510   '  TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
28511   '  TColor = type TGraphicsColor;',
28512   'var',
28513   '  p: TTypeInfo;',
28514   '  k: TTypeKind;',
28515   'begin',
28516   '  p:=typeinfo(TGraphicsColor);',
28517   '  p:=typeinfo(TColor);',
28518   '  k:=GetTypeKind(TGraphicsColor);',
28519   '  k:=GetTypeKind(TColor);',
28520   '']);
28521   ConvertProgram;
28522   CheckSource('TestRTTI_IntRange',
28523     LinesToStr([ // statements
28524     '$mod.$rtti.$Int("TGraphicsColor", {',
28525     '  minvalue: -2147483648,',
28526     '  maxvalue: 2147483647,',
28527     '  ordtype: 4',
28528     '});',
28529     '$mod.$rtti.$inherited("TColor", $mod.$rtti["TGraphicsColor"], {});',
28530     'this.p = null;',
28531     'this.k = 0;',
28532     '']),
28533     LinesToStr([ // $mod.$main
28534     '$mod.p = $mod.$rtti["TGraphicsColor"];',
28535     '$mod.p = $mod.$rtti["TColor"];',
28536     '$mod.k = 1;',
28537     '$mod.k = 1;',
28538     '']));
28539 end;
28540 
28541 procedure TTestModule.TestRTTI_Double;
28542 begin
28543   Converter.Options:=Converter.Options-[coNoTypeInfo];
28544   StartProgram(true,[supTypeInfo]);
28545   Add([
28546   '{$modeswitch externalclass}',
28547   'type',
28548   '  TFloat = type double;',
28549   'var',
28550   '  p: TTypeInfo;',
28551   'begin',
28552   '  p:=typeinfo(double);',
28553   '  p:=typeinfo(TFloat);',
28554   '']);
28555   ConvertProgram;
28556   CheckSource('TestRTTI_Double',
28557     LinesToStr([ // statements
28558     '$mod.$rtti.$inherited("TFloat", rtl.double, {});',
28559     'this.p = null;',
28560     '']),
28561     LinesToStr([ // $mod.$main
28562     '$mod.p = rtl.double;',
28563     '$mod.p = $mod.$rtti["TFloat"];',
28564     '']));
28565 end;
28566 
28567 procedure TTestModule.TestRTTI_ProcType;
28568 begin
28569   Converter.Options:=Converter.Options-[coNoTypeInfo];
28570   StartProgram(false);
28571   Add('type');
28572   Add('  TProcA = procedure;');
28573   Add('  TMethodB = procedure of object;');
28574   Add('  TProcC = procedure; varargs;');
28575   Add('  TProcD = procedure(i: longint; const j: string; var c: char; out d: double);');
28576   Add('  TProcE = function: nativeint;');
28577   Add('  TProcF = function(const p: TProcA): nativeuint;');
28578   Add('var p: pointer;');
28579   Add('begin');
28580   Add('  p:=typeinfo(tproca);');
28581   ConvertProgram;
28582   CheckSource('TestRTTI_ProcType',
28583     LinesToStr([ // statements
28584     '$mod.$rtti.$ProcVar("TProcA", {',
28585     '  procsig: rtl.newTIProcSig(null)',
28586     '});',
28587     '$mod.$rtti.$MethodVar("TMethodB", {',
28588     '  procsig: rtl.newTIProcSig(null),',
28589     '  methodkind: 0',
28590     '});',
28591     '$mod.$rtti.$ProcVar("TProcC", {',
28592     '  procsig: rtl.newTIProcSig(null, 2)',
28593     '});',
28594     '$mod.$rtti.$ProcVar("TProcD", {',
28595     '  procsig: rtl.newTIProcSig([["i", rtl.longint], ["j", rtl.string, 2], ["c", rtl.char, 1], ["d", rtl.double, 4]])',
28596     '});',
28597     '$mod.$rtti.$ProcVar("TProcE", {',
28598     '  procsig: rtl.newTIProcSig(null, rtl.nativeint)',
28599     '});',
28600     '$mod.$rtti.$ProcVar("TProcF", {',
28601     '  procsig: rtl.newTIProcSig([["p", $mod.$rtti["TProcA"], 2]], rtl.nativeuint)',
28602     '});',
28603     'this.p = null;',
28604     '']),
28605     LinesToStr([ // $mod.$main
28606     '$mod.p = $mod.$rtti["TProcA"];',
28607     '']));
28608 end;
28609 
28610 procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
28611 begin
28612   Converter.Options:=Converter.Options-[coNoTypeInfo];
28613 
28614   AddModuleWithIntfImplSrc('unit2.pas',
28615     LinesToStr([
28616     'type',
28617     '  TObject = class end;'
28618     ]),
28619     '');
28620   StartUnit(true);
28621   Add('interface');
28622   Add('uses unit2;');
28623   Add('type');
28624   Add('  TProcA = function(o: tobject): tobject;');
28625   Add('implementation');
28626   Add('type');
28627   Add('  TProcB = function(o: tobject): tobject;');
28628   Add('var p: Pointer;');
28629   Add('initialization');
28630   Add('  p:=typeinfo(tproca);');
28631   Add('  p:=typeinfo(tprocb);');
28632   ConvertUnit;
28633   CheckSource('TestRTTI_ProcType_ArgFromOtherUnit',
28634     LinesToStr([ // statements
28635     'var $impl = $mod.$impl;',
28636     '$mod.$rtti.$ProcVar("TProcA", {',
28637     '  procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
28638     '});',
28639     '']),
28640     LinesToStr([ // this.$init
28641     '$impl.p = $mod.$rtti["TProcA"];',
28642     '$impl.p = $mod.$rtti["TProcB"];',
28643     '']),
28644     LinesToStr([ // implementation
28645     '$mod.$rtti.$ProcVar("TProcB", {',
28646     '  procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
28647     '});',
28648     '$impl.p = null;',
28649     '']) );
28650 end;
28651 
28652 procedure TTestModule.TestRTTI_EnumAndSetType;
28653 begin
28654   Converter.Options:=Converter.Options-[coNoTypeInfo];
28655   StartProgram(false);
28656   Add('type');
28657   Add('  TFlag = (light,dark);');
28658   Add('  TFlags = set of TFlag;');
28659   Add('  TProc = function(f: TFlags): TFlag;');
28660   Add('var p: pointer;');
28661   Add('begin');
28662   Add('  p:=typeinfo(tflag);');
28663   Add('  p:=typeinfo(tflags);');
28664   ConvertProgram;
28665   CheckSource('TestRTTI_EnumAndType',
28666     LinesToStr([ // statements
28667     'this.TFlag = {',
28668     '  "0": "light",',
28669     '  light: 0,',
28670     '  "1": "dark",',
28671     '  dark: 1',
28672     '};',
28673     '$mod.$rtti.$Enum("TFlag", {',
28674     '  minvalue: 0,',
28675     '  maxvalue: 1,',
28676     '  ordtype: 1,',
28677     '  enumtype: this.TFlag',
28678     '});',
28679     '$mod.$rtti.$Set("TFlags", {',
28680     '  comptype: $mod.$rtti["TFlag"]',
28681     '});',
28682     '$mod.$rtti.$ProcVar("TProc", {',
28683     '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TFlags"]]], $mod.$rtti["TFlag"])',
28684     '});',
28685     'this.p = null;',
28686     '']),
28687     LinesToStr([ // $mod.$main
28688     '$mod.p = $mod.$rtti["TFlag"];',
28689     '$mod.p = $mod.$rtti["TFlags"];',
28690     '']));
28691 end;
28692 
28693 procedure TTestModule.TestRTTI_EnumRange;
28694 begin
28695   Converter.Options:=Converter.Options-[coNoTypeInfo];
28696   StartProgram(false);
28697   Add([
28698   'type',
28699   '  TCol = (red,green,blue);',
28700   '  TColRg = green..blue;',
28701   '  TSetOfColRg = set of TColRg;',
28702   'var p: pointer;',
28703   'begin',
28704   '  p:=typeinfo(tcolrg);',
28705   '  p:=typeinfo(tsetofcolrg);',
28706   '']);
28707   ConvertProgram;
28708 end;
28709 
28710 procedure TTestModule.TestRTTI_AnonymousEnumType;
28711 begin
28712   Converter.Options:=Converter.Options-[coNoTypeInfo];
28713   StartProgram(false);
28714   Add('type');
28715   Add('  TFlags = set of (red, green);');
28716   Add('var');
28717   Add('  f: TFlags;');
28718   Add('begin');
28719   Add('  Include(f,red);');
28720   ConvertProgram;
28721   CheckSource('TestRTTI_AnonymousEnumType',
28722     LinesToStr([ // statements
28723     'this.TFlags$a = {',
28724     '  "0": "red",',
28725     '  red: 0,',
28726     '  "1": "green",',
28727     '  green: 1',
28728     '};',
28729     '$mod.$rtti.$Enum("TFlags$a", {',
28730     '  minvalue: 0,',
28731     '  maxvalue: 1,',
28732     '  ordtype: 1,',
28733     '  enumtype: this.TFlags$a',
28734     '});',
28735     '$mod.$rtti.$Set("TFlags", {',
28736     '  comptype: $mod.$rtti["TFlags$a"]',
28737     '});',
28738     'this.f = {};',
28739     '']),
28740     LinesToStr([
28741     '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
28742     '']));
28743 end;
28744 
28745 procedure TTestModule.TestRTTI_StaticArray;
28746 begin
28747   Converter.Options:=Converter.Options-[coNoTypeInfo];
28748   StartProgram(false);
28749   Add('type');
28750   Add('  TFlag = (light,dark);');
28751   Add('  TFlagNames = array[TFlag] of string;');
28752   Add('  TBoolNames = array[boolean] of string;');
28753   Add('  TByteArray = array[1..32768] of byte;');
28754   Add('  TProc = function(f: TBoolNames): TFlagNames;');
28755   Add('var p: pointer;');
28756   Add('begin');
28757   Add('  p:=typeinfo(TFlagNames);');
28758   Add('  p:=typeinfo(TBoolNames);');
28759   ConvertProgram;
28760   CheckSource('TestRTTI_StaticArray',
28761     LinesToStr([ // statements
28762     'this.TFlag = {',
28763     '  "0": "light",',
28764     '  light: 0,',
28765     '  "1": "dark",',
28766     '  dark: 1',
28767     '};',
28768     '$mod.$rtti.$Enum("TFlag", {',
28769     '  minvalue: 0,',
28770     '  maxvalue: 1,',
28771     '  ordtype: 1,',
28772     '  enumtype: this.TFlag',
28773     '});',
28774     '$mod.$rtti.$StaticArray("TFlagNames", {',
28775     '  dims: [2],',
28776     '  eltype: rtl.string',
28777     '});',
28778     '$mod.$rtti.$StaticArray("TBoolNames", {',
28779     '  dims: [2],',
28780     '  eltype: rtl.string',
28781     '});',
28782     '$mod.$rtti.$StaticArray("TByteArray", {',
28783     '  dims: [32768],',
28784     '  eltype: rtl.byte',
28785     '});',
28786     '$mod.$rtti.$ProcVar("TProc", {',
28787     '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TBoolNames"]]], $mod.$rtti["TFlagNames"])',
28788     '});',
28789     'this.p = null;',
28790     '']),
28791     LinesToStr([ // $mod.$main
28792     '$mod.p = $mod.$rtti["TFlagNames"];',
28793     '$mod.p = $mod.$rtti["TBoolNames"];',
28794     '']));
28795 end;
28796 
28797 procedure TTestModule.TestRTTI_DynArray;
28798 begin
28799   Converter.Options:=Converter.Options-[coNoTypeInfo];
28800   StartProgram(false);
28801   Add('type');
28802   Add('  TArrStr = array of string;');
28803   Add('  TArr2Dim = array of tarrstr;');
28804   Add('  TProc = function(f: TArrStr): TArr2Dim;');
28805   Add('var p: pointer;');
28806   Add('begin');
28807   Add('  p:=typeinfo(tarrstr);');
28808   Add('  p:=typeinfo(tarr2dim);');
28809   ConvertProgram;
28810   CheckSource('TestRTTI_DynArray',
28811     LinesToStr([ // statements
28812     '$mod.$rtti.$DynArray("TArrStr", {',
28813     '  eltype: rtl.string',
28814     '});',
28815     '$mod.$rtti.$DynArray("TArr2Dim", {',
28816     '  eltype: $mod.$rtti["TArrStr"]',
28817     '});',
28818     '$mod.$rtti.$ProcVar("TProc", {',
28819     '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TArrStr"]]], $mod.$rtti["TArr2Dim"])',
28820     '});',
28821     'this.p = null;',
28822     '']),
28823     LinesToStr([ // $mod.$main
28824     '$mod.p = $mod.$rtti["TArrStr"];',
28825     '$mod.p = $mod.$rtti["TArr2Dim"];',
28826     '']));
28827 end;
28828 
28829 procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
28830 begin
28831   Converter.Options:=Converter.Options-[coNoTypeInfo];
28832   StartProgram(false);
28833   Add('type');
28834   Add('  TArr = array of array of longint;');
28835   Add('var a: TArr;');
28836   Add('begin');
28837   ConvertProgram;
28838   CheckSource('TestRTTI_ArrayNestedAnonymous',
28839     LinesToStr([ // statements
28840     '$mod.$rtti.$DynArray("TArr$a", {',
28841     '  eltype: rtl.longint',
28842     '});',
28843     '$mod.$rtti.$DynArray("TArr", {',
28844     '  eltype: $mod.$rtti["TArr$a"]',
28845     '});',
28846     'this.a = [];',
28847     '']),
28848     LinesToStr([ // $mod.$main
28849     ]));
28850 end;
28851 
28852 procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
28853 begin
28854   Converter.Options:=Converter.Options-[coNoTypeInfo];
28855   StartProgram(false);
28856   Add('type');
28857   Add('  TObject = class');
28858   Add('  published');
28859   Add('    procedure Proc; virtual; abstract;');
28860   Add('    procedure Proc(Sender: tobject); virtual; abstract;');
28861   Add('  end;');
28862   Add('begin');
28863   SetExpectedPasResolverError('Duplicate published method "Proc" at test1.pp(6,19)',
28864     nDuplicatePublishedMethodXAtY);
28865   ConvertProgram;
28866 end;
28867 
28868 procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
28869 begin
28870   Converter.Options:=Converter.Options-[coNoTypeInfo];
28871   StartProgram(false);
28872   Add('type');
28873   Add('  TObject = class');
28874   Add('  published');
28875   Add('    procedure Proc; external name ''foo'';');
28876   Add('  end;');
28877   Add('begin');
28878   SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
28879     nPublishedNameMustMatchExternal);
28880   ConvertProgram;
28881 end;
28882 
28883 procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
28884 begin
28885   Converter.Options:=Converter.Options-[coNoTypeInfo];
28886   StartProgram(false);
28887   Add('type');
28888   Add('  TObject = class');
28889   Add('    class var FA: longint;');
28890   Add('  published');
28891   Add('    class property A: longint read FA;');
28892   Add('  end;');
28893   Add('begin');
28894   SetExpectedPasResolverError('Invalid published property modifier "class"',
28895     nInvalidXModifierY);
28896   ConvertProgram;
28897 end;
28898 
28899 procedure TTestModule.TestRTTI_PublishedClassFieldFail;
28900 begin
28901   Converter.Options:=Converter.Options-[coNoTypeInfo];
28902   StartProgram(false);
28903   Add('type');
28904   Add('  TObject = class');
28905   Add('  published');
28906   Add('    class var FA: longint;');
28907   Add('  end;');
28908   Add('begin');
28909   SetExpectedPasResolverError(sSymbolCannotBePublished,
28910     nSymbolCannotBePublished);
28911   ConvertProgram;
28912 end;
28913 
28914 procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
28915 begin
28916   Converter.Options:=Converter.Options-[coNoTypeInfo];
28917   StartProgram(false);
28918   Add('{$modeswitch externalclass}');
28919   Add('type');
28920   Add('  TObject = class');
28921   Add('  published');
28922   Add('    V: longint; external name ''foo'';');
28923   Add('  end;');
28924   Add('begin');
28925   SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
28926     nPublishedNameMustMatchExternal);
28927   ConvertProgram;
28928 end;
28929 
28930 procedure TTestModule.TestRTTI_Class_Field;
28931 begin
28932   Converter.Options:=Converter.Options-[coNoTypeInfo];
28933   StartProgram(false);
28934   Add('{$modeswitch externalclass}');
28935   Add('type');
28936   Add('  TObject = class');
28937   Add('  private');
28938   Add('    FPropA: string;');
28939   Add('  published');
28940   Add('    VarLI: longint;');
28941   Add('    VarC: char;');
28942   Add('    VarS: string;');
28943   Add('    VarD: double;');
28944   Add('    VarB: boolean;');
28945   Add('    VarLW: longword;');
28946   Add('    VarSmI: smallint;');
28947   Add('    VarW: word;');
28948   Add('    VarShI: shortint;');
28949   Add('    VarBy: byte;');
28950   Add('    VarExt: longint external name ''VarExt'';');
28951   Add('    ArrA, ArrB: array of byte;');
28952   Add('  end;');
28953   Add('var p: pointer;');
28954   Add('  Obj: tobject;');
28955   Add('begin');
28956   Add('  p:=typeinfo(tobject);');
28957   Add('  p:=typeinfo(p);');
28958   Add('  p:=typeinfo(obj);');
28959   ConvertProgram;
28960   CheckSource('TestRTTI_Class_Field',
28961     LinesToStr([ // statements
28962     'rtl.createClass($mod, "TObject", null, function () {',
28963     '  this.$init = function () {',
28964     '    this.FPropA = "";',
28965     '    this.VarLI = 0;',
28966     '    this.VarC = "";',
28967     '    this.VarS = "";',
28968     '    this.VarD = 0.0;',
28969     '    this.VarB = false;',
28970     '    this.VarLW = 0;',
28971     '    this.VarSmI = 0;',
28972     '    this.VarW = 0;',
28973     '    this.VarShI = 0;',
28974     '    this.VarBy = 0;',
28975     '    this.ArrA = [];',
28976     '    this.ArrB = [];',
28977     '  };',
28978     '  this.$final = function () {',
28979     '    this.ArrA = undefined;',
28980     '    this.ArrB = undefined;',
28981     '  };',
28982     '  var $r = this.$rtti;',
28983     '  $r.addField("VarLI", rtl.longint);',
28984     '  $r.addField("VarC", rtl.char);',
28985     '  $r.addField("VarS", rtl.string);',
28986     '  $r.addField("VarD", rtl.double);',
28987     '  $r.addField("VarB", rtl.boolean);',
28988     '  $r.addField("VarLW", rtl.longword);',
28989     '  $r.addField("VarSmI", rtl.smallint);',
28990     '  $r.addField("VarW", rtl.word);',
28991     '  $r.addField("VarShI", rtl.shortint);',
28992     '  $r.addField("VarBy", rtl.byte);',
28993     '  $r.addField("VarExt", rtl.longint);',
28994     '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
28995     '    eltype: rtl.byte',
28996     '  });',
28997     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
28998     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
28999     '});',
29000     'this.p = null;',
29001     'this.Obj = null;',
29002     '']),
29003     LinesToStr([ // $mod.$main
29004     '$mod.p = $mod.$rtti["TObject"];',
29005     '$mod.p = rtl.pointer;',
29006     '$mod.p = $mod.Obj.$rtti;',
29007     '']));
29008 end;
29009 
29010 procedure TTestModule.TestRTTI_Class_Method;
29011 begin
29012   Converter.Options:=Converter.Options-[coNoTypeInfo];
29013   StartProgram(false);
29014   Add('type');
29015   Add('  TObject = class');
29016   Add('  private');
29017   Add('    procedure Internal; external name ''$intern'';');
29018   Add('  published');
29019   Add('    procedure Click; virtual; abstract;');
29020   Add('    procedure Notify(Sender: TObject); virtual; abstract;');
29021   Add('    function GetNotify: boolean; external name ''GetNotify'';');
29022   Add('    procedure Println(a,b: longint); varargs; virtual; abstract;');
29023   Add('  end;');
29024   Add('begin');
29025   ConvertProgram;
29026   CheckSource('TestRTTI_Class_Method',
29027     LinesToStr([ // statements
29028     'rtl.createClass($mod, "TObject", null, function () {',
29029     '  this.$init = function () {',
29030     '  };',
29031     '  this.$final = function () {',
29032     '  };',
29033     '  var $r = this.$rtti;',
29034     '  $r.addMethod("Click", 0, null);',
29035     '  $r.addMethod("Notify", 0, [["Sender", $r]]);',
29036     '  $r.addMethod("GetNotify", 1, null, rtl.boolean,{flags: 4});',
29037     '  $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
29038     '    flags: 2',
29039     '  });',
29040     '});',
29041     '']),
29042     LinesToStr([ // $mod.$main
29043     '']));
29044 end;
29045 
29046 procedure TTestModule.TestRTTI_Class_MethodArgFlags;
29047 begin
29048   Converter.Options:=Converter.Options-[coNoTypeInfo];
29049   StartProgram(false);
29050   Add('type');
29051   Add('  TObject = class');
29052   Add('  published');
29053   Add('    procedure OpenArray(const Args: array of string); virtual; abstract;');
29054   Add('    procedure ByRef(var Value: longint; out Item: longint); virtual; abstract;');
29055   Add('    procedure Untyped(var Value; out Item); virtual; abstract;');
29056   Add('  end;');
29057   Add('begin');
29058   ConvertProgram;
29059   CheckSource('TestRTTI_Class_MethodOpenArray',
29060     LinesToStr([ // statements
29061     'rtl.createClass($mod, "TObject", null, function () {',
29062     '  this.$init = function () {',
29063     '  };',
29064     '  this.$final = function () {',
29065     '  };',
29066     '  var $r = this.$rtti;',
29067     '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
29068     '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
29069     '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
29070     '});',
29071     '']),
29072     LinesToStr([ // $mod.$main
29073     '']));
29074 end;
29075 
29076 procedure TTestModule.TestRTTI_Class_Property;
29077 begin
29078   Converter.Options:=Converter.Options-[coNoTypeInfo];
29079   StartProgram(false);
29080   Add('{$modeswitch externalclass}');
29081   Add('type');
29082   Add('  TObject = class');
29083   Add('  private');
29084   Add('    FColor: longint;');
29085   Add('    FColorStored: boolean;');
29086   Add('    procedure SetColor(Value: longint); virtual; abstract;');
29087   Add('    function GetColor: longint; virtual; abstract;');
29088   Add('    function GetColorStored: boolean; virtual; abstract;');
29089   Add('    FExtSize: longint external name ''$extSize'';');
29090   Add('    FExtSizeStored: boolean external name ''$extSizeStored'';');
29091   Add('    procedure SetExtSize(Value: longint); external name ''$setSize'';');
29092   Add('    function GetExtSize: longint; external name ''$getSize'';');
29093   Add('    function GetExtSizeStored: boolean; external name ''$getExtSizeStored'';');
29094   Add('  published');
29095   Add('    property ColorA: longint read FColor;');
29096   Add('    property ColorB: longint write FColor;');
29097   Add('    property ColorC: longint read GetColor write SetColor;');
29098   Add('    property ColorD: longint read FColor write FColor stored FColorStored;');
29099   Add('    property ExtSizeA: longint read FExtSize write FExtSize;');
29100   Add('    property ExtSizeB: longint read GetExtSize write SetExtSize stored FExtSizeStored;');
29101   Add('    property ExtSizeC: longint read FExtSize write FExtSize stored GetExtSizeStored;');
29102   Add('  end;');
29103   Add('begin');
29104   ConvertProgram;
29105   CheckSource('TestRTTI_Class_Property',
29106     LinesToStr([ // statements
29107     'rtl.createClass($mod, "TObject", null, function () {',
29108     '  this.$init = function () {',
29109     '    this.FColor = 0;',
29110     '    this.FColorStored = false;',
29111     '  };',
29112     '  this.$final = function () {',
29113     '  };',
29114     '  var $r = this.$rtti;',
29115     '  $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
29116     '  $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
29117     '  $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
29118     '  $r.addProperty(',
29119     '    "ColorD",',
29120     '    8,',
29121     '    rtl.longint,',
29122     '    "FColor",',
29123     '    "FColor",',
29124     '    {',
29125     '      stored: "FColorStored"',
29126     '    }',
29127     '  );',
29128     '  $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
29129     '  $r.addProperty(',
29130     '    "ExtSizeB",',
29131     '    11,',
29132     '    rtl.longint,',
29133     '    "$getSize",',
29134     '    "$setSize",',
29135     '    {',
29136     '      stored: "$extSizeStored"',
29137     '    }',
29138     '  );',
29139     '  $r.addProperty(',
29140     '    "ExtSizeC",',
29141     '    12,',
29142     '    rtl.longint,',
29143     '    "$extSize",',
29144     '    "$extSize",',
29145     '    {',
29146     '      stored: "$getExtSizeStored"',
29147     '    }',
29148     '  );',
29149     '});',
29150     '']),
29151     LinesToStr([ // $mod.$main
29152     '']));
29153 end;
29154 
29155 procedure TTestModule.TestRTTI_Class_PropertyParams;
29156 begin
29157   Converter.Options:=Converter.Options-[coNoTypeInfo];
29158   StartProgram(false);
29159   Add('{$modeswitch externalclass}');
29160   Add('type');
29161   Add('  integer = longint;');
29162   Add('  TObject = class');
29163   Add('  private');
29164   Add('    function GetItems(i: integer): tobject; virtual; abstract;');
29165   Add('    procedure SetItems(i: integer; value: tobject); virtual; abstract;');
29166   Add('    function GetValues(const i: integer; var b: boolean): char; virtual; abstract;');
29167   Add('    procedure SetValues(const i: integer; var b: boolean; value: char); virtual; abstract;');
29168   Add('  published');
29169   Add('    property Items[Index: integer]: tobject read getitems write setitems;');
29170   Add('    property Values[const keya: integer; var keyb: boolean]: char read getvalues write setvalues;');
29171   Add('  end;');
29172   Add('begin');
29173   ConvertProgram;
29174   CheckSource('TestRTTI_Class_PropertyParams',
29175     LinesToStr([ // statements
29176     'rtl.createClass($mod, "TObject", null, function () {',
29177     '  this.$init = function () {',
29178     '  };',
29179     '  this.$final = function () {',
29180     '  };',
29181     '  var $r = this.$rtti;',
29182     '  $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
29183     '  $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
29184     '});',
29185     '']),
29186     LinesToStr([ // $mod.$main
29187     '']));
29188 end;
29189 
29190 procedure TTestModule.TestRTTI_Class_OtherUnit_TypeAlias;
29191 begin
29192   Converter.Options:=Converter.Options-[coNoTypeInfo];
29193   AddModuleWithIntfImplSrc('unit1.pas',
29194     'type TColor = -5..5;',
29195     '');
29196 
29197   StartProgram(true);
29198   Add([
29199   'uses unit1;',
29200   'type',
29201   '  TColorAlias = TColor;',
29202   '  TColorTypeAlias = type TColor;',
29203   '  TObject = class',
29204   '  private',
29205   '    fColor: TColor;',
29206   '    fAlias: TColorAlias;',
29207   '    fTypeAlias: TColorTypeAlias;',
29208   '  published',
29209   '    property Color: TColor read fcolor;',
29210   '    property Alias: TColorAlias read falias;',
29211   '    property TypeAlias: TColorTypeAlias read ftypealias;',
29212   '  end;',
29213   'begin',
29214   '']);
29215   ConvertProgram;
29216   CheckSource('TestRTTI_Class_OtherUnit_TypeAlias',
29217     LinesToStr([ // statements
29218     '$mod.$rtti.$inherited("TColorTypeAlias", pas.unit1.$rtti["TColor"], {});',
29219     'rtl.createClass($mod, "TObject", null, function () {',
29220     '  this.$init = function () {',
29221     '    this.fColor = 0;',
29222     '    this.fAlias = 0;',
29223     '    this.fTypeAlias = 0;',
29224     '  };',
29225     '  this.$final = function () {',
29226     '  };',
29227     '  var $r = this.$rtti;',
29228     '  $r.addProperty("Color", 0, pas.unit1.$rtti["TColor"], "fColor", "");',
29229     '  $r.addProperty("Alias", 0, pas.unit1.$rtti["TColor"], "fAlias", "");',
29230     '  $r.addProperty("TypeAlias", 0, $mod.$rtti["TColorTypeAlias"], "fTypeAlias", "");',
29231     '});',
29232     '']),
29233     LinesToStr([ // $mod.$main
29234     '']));
29235 end;
29236 
29237 procedure TTestModule.TestRTTI_Class_OmitRTTI;
29238 begin
29239   Converter.Options:=Converter.Options-[coNoTypeInfo];
29240   StartProgram(false);
29241   Add([
29242   '{$modeswitch omitrtti}',
29243   'type',
29244   '  TObject = class',
29245   '  private',
29246   '    FA: byte;',
29247   '  published',
29248   '    property A: byte read FA write FA;',
29249   '  end;',
29250   'begin']);
29251   ConvertProgram;
29252   CheckSource('TestRTTI_Class_OmitRTTI',
29253     LinesToStr([ // statements
29254     'rtl.createClass($mod, "TObject", null, function () {',
29255     '  this.$init = function () {',
29256     '    this.FA = 0;',
29257     '  };',
29258     '  this.$final = function () {',
29259     '  };',
29260     '});',
29261     '']),
29262     LinesToStr([ // $mod.$main
29263     '']));
29264 end;
29265 
29266 procedure TTestModule.TestRTTI_IndexModifier;
29267 begin
29268   Converter.Options:=Converter.Options-[coNoTypeInfo];
29269   StartProgram(false);
29270   Add([
29271   'type',
29272   '  TEnum = (red, blue);',
29273   '  TObject = class',
29274   '    FB: boolean;',
29275   '    procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
29276   '    function GetBoolBool(Index: boolean): boolean; virtual; abstract;',
29277   '    procedure SetBoolBool(Index: boolean; b: boolean); virtual; abstract;',
29278   '    function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
29279   '    function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
29280   '    procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
29281   '  published',
29282   '    property B1: boolean index 1 read FB write SetIntBool;',
29283   '    property B2: boolean index TEnum.blue read GetEnumBool write FB;',
29284   '    property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
29285   '  end;',
29286   'begin']);
29287   ConvertProgram;
29288   CheckSource('TestRTTI_IndexModifier',
29289     LinesToStr([ // statements
29290     'this.TEnum = {',
29291     '  "0": "red",',
29292     '  red: 0,',
29293     '  "1": "blue",',
29294     '  blue: 1',
29295     '};',
29296     '$mod.$rtti.$Enum("TEnum", {',
29297     '  minvalue: 0,',
29298     '  maxvalue: 1,',
29299     '  ordtype: 1,',
29300     '  enumtype: this.TEnum',
29301     '});',
29302     'rtl.createClass($mod, "TObject", null, function () {',
29303     '  this.$init = function () {',
29304     '    this.FB = false;',
29305     '  };',
29306     '  this.$final = function () {',
29307     '  };',
29308     '  var $r = this.$rtti;',
29309     '  $r.addProperty(',
29310     '    "B1",',
29311     '    18,',
29312     '    rtl.boolean,',
29313     '    "FB",',
29314     '    "SetIntBool",',
29315     '    {',
29316     '      index: 1',
29317     '    }',
29318     '  );',
29319     '  $r.addProperty(',
29320     '    "B2",',
29321     '    17,',
29322     '    rtl.boolean,',
29323     '    "GetEnumBool",',
29324     '    "FB",',
29325     '    {',
29326     '      index: $mod.TEnum.blue',
29327     '    }',
29328     '  );',
29329     '  $r.addProperty(',
29330     '    "I1",',
29331     '    19,',
29332     '    rtl.boolean,',
29333     '    "GetStrIntBool",',
29334     '    "SetStrIntBool",',
29335     '    {',
29336     '      index: 2',
29337     '    }',
29338     '  );',
29339     '});',
29340     '']),
29341     LinesToStr([ // $mod.$main
29342     '']));
29343 end;
29344 
29345 procedure TTestModule.TestRTTI_StoredModifier;
29346 begin
29347   Converter.Options:=Converter.Options-[coNoTypeInfo];
29348   StartProgram(false);
29349   Add([
29350   'const',
29351   '  ConstB = true;',
29352   'type',
29353   '  TObject = class',
29354   '  private',
29355   '    FB: boolean;',
29356   '    function IsBStored: boolean; virtual; abstract;',
29357   '  published',
29358   '    property BoolA: boolean read FB stored true;',
29359   '    property BoolB: boolean read FB stored false;',
29360   '    property BoolC: boolean read FB stored FB;',
29361   '    property BoolD: boolean read FB stored ConstB;',
29362   '    property BoolE: boolean read FB stored IsBStored;',
29363   '  end;',
29364   'begin']);
29365   ConvertProgram;
29366   CheckSource('TestRTTI_StoredModifier',
29367     LinesToStr([ // statements
29368     'this.ConstB = true;',
29369     'rtl.createClass($mod, "TObject", null, function () {',
29370     '  this.$init = function () {',
29371     '    this.FB = false;',
29372     '  };',
29373     '  this.$final = function () {',
29374     '  };',
29375     '  var $r = this.$rtti;',
29376     '  $r.addProperty("BoolA", 0, rtl.boolean, "FB", "");',
29377     '  $r.addProperty("BoolB", 4, rtl.boolean, "FB", "");',
29378     '  $r.addProperty(',
29379     '    "BoolC",',
29380     '    8,',
29381     '    rtl.boolean,',
29382     '    "FB",',
29383     '    "",',
29384     '    {',
29385     '      stored: "FB"',
29386     '    }',
29387     '  );',
29388     '  $r.addProperty("BoolD", 0, rtl.boolean, "FB", "");',
29389     '  $r.addProperty(',
29390     '    "BoolE",',
29391     '    12,',
29392     '    rtl.boolean,',
29393     '    "FB",',
29394     '    "",',
29395     '    {',
29396     '      stored: "IsBStored"',
29397     '    }',
29398     '  );',
29399     '});',
29400     '']),
29401     LinesToStr([ // $mod.$main
29402     '']));
29403 end;
29404 
29405 procedure TTestModule.TestRTTI_DefaultValue;
29406 begin
29407   Converter.Options:=Converter.Options-[coNoTypeInfo];
29408   StartProgram(false);
29409   Add([
29410   'type',
29411   '  TEnum = (red, blue);',
29412   'const',
29413   '  CB = true or false;',
29414   '  CI = 1+2;',
29415   'type',
29416   '  TObject = class',
29417   '    FB: boolean;',
29418   '    FI: longint;',
29419   '    FE: TEnum;',
29420   '  published',
29421   '    property B1: boolean read FB default true;',
29422   '    property B2: boolean read FB default CB;',
29423   '    property B3: boolean read FB default test1.cb;',
29424   '    property I1: longint read FI default 2;',
29425   '    property I2: longint read FI default CI;',
29426   '    property E1: TEnum read FE default red;',
29427   '    property E2: TEnum read FE default TEnum.blue;',
29428   '  end;',
29429   'begin']);
29430   ConvertProgram;
29431   CheckSource('TestRTTI_DefaultValue',
29432     LinesToStr([ // statements
29433     'this.TEnum = {',
29434     '  "0": "red",',
29435     '  red: 0,',
29436     '  "1": "blue",',
29437     '  blue: 1',
29438     '};',
29439     '$mod.$rtti.$Enum("TEnum", {',
29440     '  minvalue: 0,',
29441     '  maxvalue: 1,',
29442     '  ordtype: 1,',
29443     '  enumtype: this.TEnum',
29444     '});',
29445     'this.CB = true || false;',
29446     'this.CI = 1 + 2;',
29447     'rtl.createClass($mod, "TObject", null, function () {',
29448     '  this.$init = function () {',
29449     '    this.FB = false;',
29450     '    this.FI = 0;',
29451     '    this.FE = 0;',
29452     '  };',
29453     '  this.$final = function () {',
29454     '  };',
29455     '  var $r = this.$rtti;',
29456     '  $r.addProperty(',
29457     '    "B1",',
29458     '    0,',
29459     '    rtl.boolean,',
29460     '    "FB",',
29461     '    "",',
29462     '    {',
29463     '      Default: true',
29464     '    }',
29465     '  );',
29466     '  $r.addProperty(',
29467     '    "B2",',
29468     '    0,',
29469     '    rtl.boolean,',
29470     '    "FB",',
29471     '    "",',
29472     '    {',
29473     '      Default: true',
29474     '    }',
29475     '  );',
29476     '  $r.addProperty(',
29477     '    "B3",',
29478     '    0,',
29479     '    rtl.boolean,',
29480     '    "FB",',
29481     '    "",',
29482     '    {',
29483     '      Default: true',
29484     '    }',
29485     '  );',
29486     '  $r.addProperty(',
29487     '    "I1",',
29488     '    0,',
29489     '    rtl.longint,',
29490     '    "FI",',
29491     '    "",',
29492     '    {',
29493     '      Default: 2',
29494     '    }',
29495     '  );',
29496     '  $r.addProperty(',
29497     '    "I2",',
29498     '    0,',
29499     '    rtl.longint,',
29500     '    "FI",',
29501     '    "",',
29502     '    {',
29503     '      Default: 3',
29504     '    }',
29505     '  );',
29506     '  $r.addProperty(',
29507     '    "E1",',
29508     '    0,',
29509     '    $mod.$rtti["TEnum"],',
29510     '    "FE",',
29511     '    "",',
29512     '    {',
29513     '      Default: $mod.TEnum.red',
29514     '    }',
29515     '  );',
29516     '  $r.addProperty(',
29517     '    "E2",',
29518     '    0,',
29519     '    $mod.$rtti["TEnum"],',
29520     '    "FE",',
29521     '    "",',
29522     '    {',
29523     '      Default: $mod.TEnum.blue',
29524     '    }',
29525     '  );',
29526     '});',
29527     '']),
29528     LinesToStr([ // $mod.$main
29529     '']));
29530 end;
29531 
29532 procedure TTestModule.TestRTTI_DefaultValueSet;
29533 begin
29534   Converter.Options:=Converter.Options-[coNoTypeInfo];
29535   StartProgram(false);
29536   Add([
29537   'type',
29538   '  TEnum = (red, blue);',
29539   '  TSet = set of TEnum;',
29540   'const',
29541   '  CSet = [red,blue];',
29542   'type',
29543   '  TObject = class',
29544   '    FSet: TSet;',
29545   '  published',
29546   '    property Set1: TSet read FSet default [];',
29547   '    property Set2: TSet read FSet default [red];',
29548   '    property Set3: TSet read FSet default [red,blue];',
29549   '    property Set4: TSet read FSet default CSet;',
29550   '  end;',
29551   'begin']);
29552   ConvertProgram;
29553   CheckSource('TestRTTI_DefaultValueSet',
29554     LinesToStr([ // statements
29555     'this.TEnum = {',
29556     '  "0": "red",',
29557     '  red: 0,',
29558     '  "1": "blue",',
29559     '  blue: 1',
29560     '};',
29561     '$mod.$rtti.$Enum("TEnum", {',
29562     '  minvalue: 0,',
29563     '  maxvalue: 1,',
29564     '  ordtype: 1,',
29565     '  enumtype: this.TEnum',
29566     '});',
29567     '$mod.$rtti.$Set("TSet", {',
29568     '  comptype: $mod.$rtti["TEnum"]',
29569     '});',
29570     'this.CSet = rtl.createSet($mod.TEnum.red, $mod.TEnum.blue);',
29571     'rtl.createClass($mod, "TObject", null, function () {',
29572     '  this.$init = function () {',
29573     '    this.FSet = {};',
29574     '  };',
29575     '  this.$final = function () {',
29576     '    this.FSet = undefined;',
29577     '  };',
29578     '  var $r = this.$rtti;',
29579     '  $r.addProperty(',
29580     '    "Set1",',
29581     '    0,',
29582     '    $mod.$rtti["TSet"],',
29583     '    "FSet",',
29584     '    "",',
29585     '    {',
29586     '      Default: {}',
29587     '    }',
29588     '  );',
29589     '  $r.addProperty(',
29590     '    "Set2",',
29591     '    0,',
29592     '    $mod.$rtti["TSet"],',
29593     '    "FSet",',
29594     '    "",',
29595     '    {',
29596     '      Default: rtl.createSet($mod.TEnum.red)',
29597     '    }',
29598     '  );',
29599     '  $r.addProperty(',
29600     '    "Set3",',
29601     '    0,',
29602     '    $mod.$rtti["TSet"],',
29603     '    "FSet",',
29604     '    "",',
29605     '    {',
29606     '      Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
29607     '    }',
29608     '  );',
29609     '  $r.addProperty(',
29610     '    "Set4",',
29611     '    0,',
29612     '    $mod.$rtti["TSet"],',
29613     '    "FSet",',
29614     '    "",',
29615     '    {',
29616     '      Default: $mod.CSet',
29617     '    }',
29618     '  );',
29619     '});',
29620     '']),
29621     LinesToStr([ // $mod.$main
29622     '']));
29623 end;
29624 
29625 procedure TTestModule.TestRTTI_DefaultValueRangeType;
29626 begin
29627   Converter.Options:=Converter.Options-[coNoTypeInfo];
29628   StartProgram(false);
29629   Add([
29630   'type',
29631   '  TRg = -1..1;',
29632   'const',
29633   '  l = low(TRg);',
29634   '  h = high(TRg);',
29635   'type',
29636   '  TObject = class',
29637   '    FV: TRg;',
29638   '  published',
29639   '    property V1: TRg read FV default -1;',
29640   '  end;',
29641   'begin']);
29642   ConvertProgram;
29643   CheckSource('TestRTTI_DefaultValueRangeType',
29644     LinesToStr([ // statements
29645     '$mod.$rtti.$Int("TRg", {',
29646     '  minvalue: -1,',
29647     '  maxvalue: 1,',
29648     '  ordtype: 0',
29649     '});',
29650     'this.l = -1;',
29651     'this.h = 1;',
29652     'rtl.createClass($mod, "TObject", null, function () {',
29653     '  this.$init = function () {',
29654     '    this.FV = 0;',
29655     '  };',
29656     '  this.$final = function () {',
29657     '  };',
29658     '  var $r = this.$rtti;',
29659     '  $r.addProperty(',
29660     '    "V1",',
29661     '    0,',
29662     '    $mod.$rtti["TRg"],',
29663     '    "FV",',
29664     '    "",',
29665     '    {',
29666     '      Default: -1',
29667     '    }',
29668     '  );',
29669     '});',
29670     '']),
29671     LinesToStr([ // $mod.$main
29672     '']));
29673 end;
29674 
29675 procedure TTestModule.TestRTTI_DefaultValueInherit;
29676 begin
29677   Converter.Options:=Converter.Options-[coNoTypeInfo];
29678   StartProgram(false);
29679   Add([
29680   'type',
29681   '  TObject = class',
29682   '    FA, FB: byte;',
29683   '    property A: byte read FA default 1;',
29684   '    property B: byte read FB default 2;',
29685   '  end;',
29686   '  TBird = class',
29687   '  published',
29688   '    property A;',
29689   '    property B nodefault;',
29690   '  end;',
29691   'begin']);
29692   ConvertProgram;
29693   CheckSource('TestRTTI_DefaultValueInherit',
29694     LinesToStr([ // statements
29695     'rtl.createClass($mod, "TObject", null, function () {',
29696     '  this.$init = function () {',
29697     '    this.FA = 0;',
29698     '    this.FB = 0;',
29699     '  };',
29700     '  this.$final = function () {',
29701     '  };',
29702     '});',
29703     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
29704     '  var $r = this.$rtti;',
29705     '  $r.addProperty(',
29706     '    "A",',
29707     '    0,',
29708     '    rtl.byte,',
29709     '    "FA",',
29710     '    "",',
29711     '    {',
29712     '      Default: 1',
29713     '    }',
29714     '  );',
29715     '  $r.addProperty("B", 0, rtl.byte, "FB", "");',
29716     '});',
29717     '']),
29718     LinesToStr([ // $mod.$main
29719     '']));
29720 end;
29721 
29722 procedure TTestModule.TestRTTI_OverrideMethod;
29723 begin
29724   Converter.Options:=Converter.Options-[coNoTypeInfo];
29725   StartProgram(false);
29726   Add('type');
29727   Add('  TObject = class');
29728   Add('  published');
29729   Add('    procedure DoIt; virtual; abstract;');
29730   Add('  end;');
29731   Add('  TSky = class');
29732   Add('  published');
29733   Add('    procedure DoIt; override;');
29734   Add('  end;');
29735   Add('procedure TSky.DoIt; begin end;');
29736   Add('begin');
29737   ConvertProgram;
29738   CheckSource('TestRTTI_OverrideMethod',
29739     LinesToStr([ // statements
29740     'rtl.createClass($mod, "TObject", null, function () {',
29741     '  this.$init = function () {',
29742     '  };',
29743     '  this.$final = function () {',
29744     '  };',
29745     '  var $r = this.$rtti;',
29746     '  $r.addMethod("DoIt", 0, null);',
29747     '});',
29748     'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
29749     '  this.DoIt = function () {',
29750     '  };',
29751     '});',
29752     '']),
29753     LinesToStr([ // $mod.$main
29754     '']));
29755 end;
29756 
29757 procedure TTestModule.TestRTTI_ReintroduceMethod;
29758 begin
29759   Converter.Options:=Converter.Options-[coNoTypeInfo];
29760   StartProgram(false);
29761   Add([
29762   'type',
29763   '  TObject = class',
29764   '  published',
29765   '    procedure DoIt;',
29766   '  end;',
29767   '  TSky = class',
29768   '  published',
29769   '    procedure DoIt; reintroduce;',
29770   '  end;',
29771   'procedure TObject.DoIt; begin end;',
29772   'procedure TSky.DoIt;',
29773   'begin',
29774   '  inherited DoIt;',
29775   'end;',
29776   'begin']);
29777   ConvertProgram;
29778   CheckSource('TestRTTI_ReintroduceMethod',
29779     LinesToStr([ // statements
29780     'rtl.createClass($mod, "TObject", null, function () {',
29781     '  this.$init = function () {',
29782     '  };',
29783     '  this.$final = function () {',
29784     '  };',
29785     '  this.DoIt = function () {',
29786     '  };',
29787     '  var $r = this.$rtti;',
29788     '  $r.addMethod("DoIt", 0, null);',
29789     '});',
29790     'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
29791     '  this.DoIt = function () {',
29792     '    $mod.TObject.DoIt.call(this);',
29793     '  };',
29794     '  var $r = this.$rtti;',
29795     '  $r.addMethod("DoIt", 0, null);',
29796     '});',
29797     '']),
29798     LinesToStr([ // $mod.$main
29799     '']));
29800 end;
29801 
29802 procedure TTestModule.TestRTTI_OverloadProperty;
29803 begin
29804   Converter.Options:=Converter.Options-[coNoTypeInfo];
29805   StartProgram(false);
29806   Add('type');
29807   Add('  TObject = class');
29808   Add('  protected');
29809   Add('    FFlag: longint;');
29810   Add('  published');
29811   Add('    property Flag: longint read fflag;');
29812   Add('  end;');
29813   Add('  TSky = class');
29814   Add('  published');
29815   Add('    property FLAG: longint write fflag;');
29816   Add('  end;');
29817   Add('begin');
29818   ConvertProgram;
29819   CheckSource('TestRTTI_OverrideMethod',
29820     LinesToStr([ // statements
29821     'rtl.createClass($mod, "TObject", null, function () {',
29822     '  this.$init = function () {',
29823     '    this.FFlag = 0;',
29824     '  };',
29825     '  this.$final = function () {',
29826     '  };',
29827     '  var $r = this.$rtti;',
29828     '  $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
29829     '});',
29830     'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
29831     '  var $r = this.$rtti;',
29832     '  $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
29833     '});',
29834     '']),
29835     LinesToStr([ // $mod.$main
29836     '']));
29837 end;
29838 
29839 procedure TTestModule.TestRTTI_ClassForward;
29840 begin
29841   Converter.Options:=Converter.Options-[coNoTypeInfo];
29842   StartProgram(false);
29843   Add('type');
29844   Add('  TObject = class end;');
29845   Add('  tbridge = class;');
29846   Add('  TProc = function: tbridge;');
29847   Add('  TOger = class');
29848   Add('  published');
29849   Add('    FBridge: tbridge;');
29850   Add('    procedure SetBridge(Value: tbridge); virtual; abstract;');
29851   Add('    property Bridge: tbridge read fbridge write setbridge;');
29852   Add('  end;');
29853   Add('  TBridge = class');
29854   Add('    FOger: toger;');
29855   Add('  end;');
29856   Add('var p: Pointer;');
29857   Add(' b: tbridge;');
29858   Add('begin');
29859   Add('  p:=typeinfo(tbridge);');
29860   Add('  p:=typeinfo(b);');
29861   ConvertProgram;
29862   CheckSource('TestRTTI_ClassForward',
29863     LinesToStr([ // statements
29864     'rtl.createClass($mod, "TObject", null, function () {',
29865     '  this.$init = function () {',
29866     '  };',
29867     '  this.$final = function () {',
29868     '  };',
29869     '});',
29870     '$mod.$rtti.$Class("TBridge");',
29871     '$mod.$rtti.$ProcVar("TProc", {',
29872     '  procsig: rtl.newTIProcSig(null, $mod.$rtti["TBridge"])',
29873     '});',
29874     'rtl.createClass($mod, "TOger", $mod.TObject, function () {',
29875     '  this.$init = function () {',
29876     '    $mod.TObject.$init.call(this);',
29877     '    this.FBridge = null;',
29878     '  };',
29879     '  this.$final = function () {',
29880     '    this.FBridge = undefined;',
29881     '    $mod.TObject.$final.call(this);',
29882     '  };',
29883     '  var $r = this.$rtti;',
29884     '  $r.addField("FBridge", $mod.$rtti["TBridge"]);',
29885     '  $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
29886     '  $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
29887     '});',
29888     'rtl.createClass($mod, "TBridge", $mod.TObject, function () {',
29889     '  this.$init = function () {',
29890     '    $mod.TObject.$init.call(this);',
29891     '    this.FOger = null;',
29892     '  };',
29893     '  this.$final = function () {',
29894     '    this.FOger = undefined;',
29895     '    $mod.TObject.$final.call(this);',
29896     '  };',
29897     '});',
29898     'this.p = null;',
29899     'this.b = null;',
29900     '']),
29901     LinesToStr([ // $mod.$main
29902     '$mod.p = $mod.$rtti["TBridge"];',
29903     '$mod.p = $mod.b.$rtti;',
29904     '']));
29905 end;
29906 
29907 procedure TTestModule.TestRTTI_ClassOf;
29908 begin
29909   Converter.Options:=Converter.Options-[coNoTypeInfo];
29910   StartProgram(false);
29911   Add('type');
29912   Add('  TClass = class of tobject;');
29913   Add('  TProcA = function: TClass;');
29914   Add('  TObject = class');
29915   Add('  published');
29916   Add('    C: tclass;');
29917   Add('  end;');
29918   Add('  tfox = class;');
29919   Add('  TBird = class end;');
29920   Add('  TBirds = class of tbird;');
29921   Add('  TFox = class end;');
29922   Add('  TFoxes = class of tfox;');
29923   Add('  TCows = class of TCow;');
29924   Add('  TCow = class;');
29925   Add('  TCow = class end;');
29926   Add('begin');
29927   ConvertProgram;
29928   CheckSource('TestRTTI_ClassOf',
29929     LinesToStr([ // statements
29930     '$mod.$rtti.$Class("TObject");',
29931     '$mod.$rtti.$ClassRef("TClass", {',
29932     '  instancetype: $mod.$rtti["TObject"]',
29933     '});',
29934     '$mod.$rtti.$ProcVar("TProcA", {',
29935     '  procsig: rtl.newTIProcSig(null, $mod.$rtti["TClass"])',
29936     '});',
29937     'rtl.createClass($mod, "TObject", null, function () {',
29938     '  this.$init = function () {',
29939     '    this.C = null;',
29940     '  };',
29941     '  this.$final = function () {',
29942     '    this.C = undefined;',
29943     '  };',
29944     '  var $r = this.$rtti;',
29945     '  $r.addField("C", $mod.$rtti["TClass"]);',
29946     '});',
29947     '$mod.$rtti.$Class("TFox");',
29948     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
29949     '});',
29950     '$mod.$rtti.$ClassRef("TBirds", {',
29951     '  instancetype: $mod.$rtti["TBird"]',
29952     '});',
29953     'rtl.createClass($mod, "TFox", $mod.TObject, function () {',
29954     '});',
29955     '$mod.$rtti.$ClassRef("TFoxes", {',
29956     '  instancetype: $mod.$rtti["TFox"]',
29957     '});',
29958     '$mod.$rtti.$Class("TCow");',
29959     '$mod.$rtti.$ClassRef("TCows", {',
29960     '  instancetype: $mod.$rtti["TCow"]',
29961     '});',
29962     'rtl.createClass($mod, "TCow", $mod.TObject, function () {',
29963     '});',
29964     '']),
29965     LinesToStr([ // $mod.$main
29966     '']));
29967 end;
29968 
29969 procedure TTestModule.TestRTTI_Record;
29970 begin
29971   Converter.Options:=Converter.Options-[coNoTypeInfo];
29972   StartProgram(false);
29973   Add('type');
29974   Add('  integer = longint;');
29975   Add('  TPoint = record');
29976   Add('    x,y: integer;');
29977   Add('  end;');
29978   Add('var p: pointer;');
29979   Add('  r: tpoint;');
29980   Add('begin');
29981   Add('  p:=typeinfo(tpoint);');
29982   Add('  p:=typeinfo(r);');
29983   Add('  p:=typeinfo(r.x);');
29984   ConvertProgram;
29985   CheckSource('TestRTTI_Record',
29986     LinesToStr([ // statements
29987     'rtl.recNewT($mod, "TPoint", function () {',
29988     '  this.x = 0;',
29989     '  this.y = 0;',
29990     '  this.$eq = function (b) {',
29991     '    return (this.x === b.x) && (this.y === b.y);',
29992     '  };',
29993     '  this.$assign = function (s) {',
29994     '    this.x = s.x;',
29995     '    this.y = s.y;',
29996     '    return this;',
29997     '  };',
29998     '  var $r = $mod.$rtti.$Record("TPoint", {});',
29999     '  $r.addField("x", rtl.longint);',
30000     '  $r.addField("y", rtl.longint);',
30001     '});',
30002     'this.p = null;',
30003     'this.r = $mod.TPoint.$new();',
30004     '']),
30005     LinesToStr([ // $mod.$main
30006     '$mod.p = $mod.$rtti["TPoint"];',
30007     '$mod.p = $mod.$rtti["TPoint"];',
30008     '$mod.p = rtl.longint;',
30009     '']));
30010 end;
30011 
30012 procedure TTestModule.TestRTTI_RecordAnonymousArray;
30013 begin
30014   Converter.Options:=Converter.Options-[coNoTypeInfo];
30015   StartProgram(false);
30016   Add('type');
30017   Add('  TFloatRec = record');
30018   Add('    c,d: array of char;');
30019   // Add('    i: array of array of longint;');
30020   Add('  end;');
30021   Add('var p: pointer;');
30022   Add('  r: tfloatrec;');
30023   Add('begin');
30024   Add('  p:=typeinfo(tfloatrec);');
30025   Add('  p:=typeinfo(r);');
30026   Add('  p:=typeinfo(r.d);');
30027   ConvertProgram;
30028   CheckSource('TestRTTI_Record',
30029     LinesToStr([ // statements
30030     'rtl.recNewT($mod, "TFloatRec", function () {',
30031     '  this.$new = function () {',
30032     '    var r = Object.create(this);',
30033     '    r.c = [];',
30034     '    r.d = [];',
30035     '    return r;',
30036     '  };',
30037     '  this.$eq = function (b) {',
30038     '    return (this.c === b.c) && (this.d === b.d);',
30039     '  };',
30040     '  this.$assign = function (s) {',
30041     '    this.c = rtl.arrayRef(s.c);',
30042     '    this.d = rtl.arrayRef(s.d);',
30043     '    return this;',
30044     '  };',
30045     '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
30046     '    eltype: rtl.char',
30047     '  });',
30048     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
30049     '  $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
30050     '  $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',
30051     '});',
30052     'this.p = null;',
30053     'this.r = $mod.TFloatRec.$new();',
30054     '']),
30055     LinesToStr([ // $mod.$main
30056     '$mod.p = $mod.$rtti["TFloatRec"];',
30057     '$mod.p = $mod.$rtti["TFloatRec"];',
30058     '$mod.p = $mod.$rtti["TFloatRec.d$a"];',
30059     '']));
30060 end;
30061 
30062 procedure TTestModule.TestRTTI_LocalTypes;
30063 begin
30064   Converter.Options:=Converter.Options-[coNoTypeInfo];
30065   StartProgram(false);
30066   Add([
30067   'procedure DoIt;',
30068   'type',
30069   '  integer = longint;',
30070   '  TPoint = record',
30071   '    x,y: integer;',
30072   '  end;',
30073   'var p: TPoint;',
30074   'begin',
30075   'end;',
30076   'begin']);
30077   ConvertProgram;
30078   CheckSource('TestRTTI_LocalTypes',
30079     LinesToStr([ // statements
30080     'var TPoint = rtl.recNewT(null, "", function () {',
30081     '  this.x = 0;',
30082     '  this.y = 0;',
30083     '  this.$eq = function (b) {',
30084     '    return (this.x === b.x) && (this.y === b.y);',
30085     '  };',
30086     '  this.$assign = function (s) {',
30087     '    this.x = s.x;',
30088     '    this.y = s.y;',
30089     '    return this;',
30090     '  };',
30091     '});',
30092     'this.DoIt = function () {',
30093     '  var p = TPoint.$new();',
30094     '};',
30095     '']),
30096     LinesToStr([ // $mod.$main
30097     '']));
30098 end;
30099 
30100 procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
30101 begin
30102   Converter.Options:=Converter.Options-[coNoTypeInfo];
30103   StartProgram(false);
30104   Add([
30105   'type',
30106   '  TCaption = string;',
30107   '  TYesNo = boolean;',
30108   '  TLetter = char;',
30109   '  TFloat = double;',
30110   '  TPtr = pointer;',
30111   '  TShortInt = shortint;',
30112   '  TByte = byte;',
30113   '  TSmallInt = smallint;',
30114   '  TWord = word;',
30115   '  TInt32 = longint;',
30116   '  TDWord = longword;',
30117   '  TValue = jsvalue;',
30118   'var p: TPtr;',
30119   'begin',
30120   '  p:=typeinfo(string);',
30121   '  p:=typeinfo(tcaption);',
30122   '  p:=typeinfo(boolean);',
30123   '  p:=typeinfo(tyesno);',
30124   '  p:=typeinfo(char);',
30125   '  p:=typeinfo(tletter);',
30126   '  p:=typeinfo(double);',
30127   '  p:=typeinfo(tfloat);',
30128   '  p:=typeinfo(pointer);',
30129   '  p:=typeinfo(tptr);',
30130   '  p:=typeinfo(shortint);',
30131   '  p:=typeinfo(tshortint);',
30132   '  p:=typeinfo(byte);',
30133   '  p:=typeinfo(tbyte);',
30134   '  p:=typeinfo(smallint);',
30135   '  p:=typeinfo(tsmallint);',
30136   '  p:=typeinfo(word);',
30137   '  p:=typeinfo(tword);',
30138   '  p:=typeinfo(longword);',
30139   '  p:=typeinfo(tdword);',
30140   '  p:=typeinfo(jsvalue);',
30141   '  p:=typeinfo(tvalue);',
30142   '']);
30143   ConvertProgram;
30144   CheckSource('TestRTTI_TypeInfo_BaseTypes',
30145     LinesToStr([ // statements
30146     'this.p = null;',
30147     '']),
30148     LinesToStr([ // $mod.$main
30149     '$mod.p = rtl.string;',
30150     '$mod.p = rtl.string;',
30151     '$mod.p = rtl.boolean;',
30152     '$mod.p = rtl.boolean;',
30153     '$mod.p = rtl.char;',
30154     '$mod.p = rtl.char;',
30155     '$mod.p = rtl.double;',
30156     '$mod.p = rtl.double;',
30157     '$mod.p = rtl.pointer;',
30158     '$mod.p = rtl.pointer;',
30159     '$mod.p = rtl.shortint;',
30160     '$mod.p = rtl.shortint;',
30161     '$mod.p = rtl.byte;',
30162     '$mod.p = rtl.byte;',
30163     '$mod.p = rtl.smallint;',
30164     '$mod.p = rtl.smallint;',
30165     '$mod.p = rtl.word;',
30166     '$mod.p = rtl.word;',
30167     '$mod.p = rtl.longword;',
30168     '$mod.p = rtl.longword;',
30169     '$mod.p = rtl.jsvalue;',
30170     '$mod.p = rtl.jsvalue;',
30171     '']));
30172 end;
30173 
30174 procedure TTestModule.TestRTTI_TypeInfo_Type_BaseTypes;
30175 begin
30176   Converter.Options:=Converter.Options-[coNoTypeInfo];
30177   StartProgram(false);
30178   Add([
30179   'type',
30180   '  TCaption = type string;',
30181   '  TYesNo = type boolean;',
30182   '  TLetter = type char;',
30183   '  TFloat = type double;',
30184   '  TPtr = type pointer;',
30185   '  TShortInt = type shortint;',
30186   '  TByte = type byte;',
30187   '  TSmallInt = type smallint;',
30188   '  TWord = type word;',
30189   '  TInt32 = type longint;',
30190   '  TDWord = type longword;',
30191   '  TValue = type jsvalue;',
30192   '  TAliasValue = type TValue;',
30193   'var',
30194   '  p: TPtr;',
30195   '  a: TAliasValue;',
30196   'begin',
30197   '  p:=typeinfo(tcaption);',
30198   '  p:=typeinfo(tyesno);',
30199   '  p:=typeinfo(tletter);',
30200   '  p:=typeinfo(tfloat);',
30201   '  p:=typeinfo(tptr);',
30202   '  p:=typeinfo(tshortint);',
30203   '  p:=typeinfo(tbyte);',
30204   '  p:=typeinfo(tsmallint);',
30205   '  p:=typeinfo(tword);',
30206   '  p:=typeinfo(tdword);',
30207   '  p:=typeinfo(tvalue);',
30208   '  p:=typeinfo(taliasvalue);',
30209   '  p:=typeinfo(a);',
30210   '']);
30211   ConvertProgram;
30212   CheckSource('TestRTTI_TypeInfo_Type_BaseTypes',
30213     LinesToStr([ // statements
30214     '$mod.$rtti.$inherited("TCaption", rtl.string, {});',
30215     '$mod.$rtti.$inherited("TYesNo", rtl.boolean, {});',
30216     '$mod.$rtti.$inherited("TLetter", rtl.char, {});',
30217     '$mod.$rtti.$inherited("TFloat", rtl.double, {});',
30218     '$mod.$rtti.$inherited("TPtr", rtl.pointer, {});',
30219     '$mod.$rtti.$inherited("TShortInt", rtl.shortint, {});',
30220     '$mod.$rtti.$inherited("TByte", rtl.byte, {});',
30221     '$mod.$rtti.$inherited("TSmallInt", rtl.smallint, {});',
30222     '$mod.$rtti.$inherited("TWord", rtl.word, {});',
30223     '$mod.$rtti.$inherited("TInt32", rtl.longint, {});',
30224     '$mod.$rtti.$inherited("TDWord", rtl.longword, {});',
30225     '$mod.$rtti.$inherited("TValue", rtl.jsvalue, {});',
30226     '$mod.$rtti.$inherited("TAliasValue", $mod.$rtti["TValue"], {});',
30227     'this.p = null;',
30228     'this.a = undefined;',
30229     '']),
30230     LinesToStr([ // $mod.$main
30231     '$mod.p = $mod.$rtti["TCaption"];',
30232     '$mod.p = $mod.$rtti["TYesNo"];',
30233     '$mod.p = $mod.$rtti["TLetter"];',
30234     '$mod.p = $mod.$rtti["TFloat"];',
30235     '$mod.p = $mod.$rtti["TPtr"];',
30236     '$mod.p = $mod.$rtti["TShortInt"];',
30237     '$mod.p = $mod.$rtti["TByte"];',
30238     '$mod.p = $mod.$rtti["TSmallInt"];',
30239     '$mod.p = $mod.$rtti["TWord"];',
30240     '$mod.p = $mod.$rtti["TDWord"];',
30241     '$mod.p = $mod.$rtti["TValue"];',
30242     '$mod.p = $mod.$rtti["TAliasValue"];',
30243     '$mod.p = $mod.$rtti["TAliasValue"];',
30244     '']));
30245 end;
30246 
30247 procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
30248 begin
30249   Converter.Options:=Converter.Options-[coNoTypeInfo];
30250   StartProgram(false);
30251   Add('procedure DoIt;');
30252   Add('type');
30253   Add('  integer = longint;');
30254   Add('  TPoint = record');
30255   Add('    x,y: integer;');
30256   Add('  end;');
30257   Add('var p: pointer;');
30258   Add('begin');
30259   Add('  p:=typeinfo(tpoint);');
30260   Add('end;');
30261   Add('begin');
30262   SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
30263   ConvertProgram;
30264 end;
30265 
30266 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
30267 begin
30268   Converter.Options:=Converter.Options-[coNoTypeInfo];
30269   StartProgram(true,[supTypeInfo]);
30270   Add([
30271   '{$modeswitch externalclass}',
30272   'type',
30273   '  TFlag = (up,down);',
30274   '  TFlags = set of TFlag;',
30275   'var',
30276   '  ti: TTypeInfo;',
30277   '  tiInt: TTypeInfoInteger;',
30278   '  tiEnum: TTypeInfoEnum;',
30279   '  tiSet: TTypeInfoSet;',
30280   'begin',
30281   '  ti:=typeinfo(string);',
30282   '  ti:=typeinfo(boolean);',
30283   '  ti:=typeinfo(char);',
30284   '  ti:=typeinfo(double);',
30285   '  tiInt:=typeinfo(shortint);',
30286   '  tiInt:=typeinfo(byte);',
30287   '  tiInt:=typeinfo(smallint);',
30288   '  tiInt:=typeinfo(word);',
30289   '  tiInt:=typeinfo(longint);',
30290   '  tiInt:=typeinfo(longword);',
30291   '  ti:=typeinfo(jsvalue);',
30292   '  tiEnum:=typeinfo(tflag);',
30293   '  tiSet:=typeinfo(tflags);']);
30294   ConvertProgram;
30295   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses1',
30296     LinesToStr([ // statements
30297     'this.TFlag = {',
30298     '  "0": "up",',
30299     '  up: 0,',
30300     '  "1": "down",',
30301     '  down: 1',
30302     '};',
30303     '$mod.$rtti.$Enum("TFlag", {',
30304     '  minvalue: 0,',
30305     '  maxvalue: 1,',
30306     '  ordtype: 1,',
30307     '  enumtype: this.TFlag',
30308     '});',
30309     '$mod.$rtti.$Set("TFlags", {',
30310     '  comptype: $mod.$rtti["TFlag"]',
30311     '});',
30312     'this.ti = null;',
30313     'this.tiInt = null;',
30314     'this.tiEnum = null;',
30315     'this.tiSet = null;',
30316     '']),
30317     LinesToStr([ // $mod.$main
30318     '$mod.ti = rtl.string;',
30319     '$mod.ti = rtl.boolean;',
30320     '$mod.ti = rtl.char;',
30321     '$mod.ti = rtl.double;',
30322     '$mod.tiInt = rtl.shortint;',
30323     '$mod.tiInt = rtl.byte;',
30324     '$mod.tiInt = rtl.smallint;',
30325     '$mod.tiInt = rtl.word;',
30326     '$mod.tiInt = rtl.longint;',
30327     '$mod.tiInt = rtl.longword;',
30328     '$mod.ti = rtl.jsvalue;',
30329     '$mod.tiEnum = $mod.$rtti["TFlag"];',
30330     '$mod.tiSet = $mod.$rtti["TFlags"];',
30331     '']));
30332 end;
30333 
30334 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
30335 begin
30336   Converter.Options:=Converter.Options-[coNoTypeInfo];
30337   StartProgram(true,[supTypeInfo]);
30338   Add('{$modeswitch externalclass}');
30339   Add('type');
30340   Add('  TStaticArr = array[boolean] of string;');
30341   Add('  TDynArr = array of string;');
30342   Add('  TProc = procedure;');
30343   Add('  TMethod = procedure of object;');
30344   Add('var');
30345   Add('  StaticArray: TStaticArr;');
30346   Add('  tiStaticArray: TTypeInfoStaticArray;');
30347   Add('  DynArray: TDynArr;');
30348   Add('  tiDynArray: TTypeInfoDynArray;');
30349   Add('  ProcVar: TProc;');
30350   Add('  tiProcVar: TTypeInfoProcVar;');
30351   Add('  MethodVar: TMethod;');
30352   Add('  tiMethodVar: TTypeInfoMethodVar;');
30353   Add('begin');
30354   Add('  tiStaticArray:=typeinfo(StaticArray);');
30355   Add('  tiStaticArray:=typeinfo(TStaticArr);');
30356   Add('  tiDynArray:=typeinfo(DynArray);');
30357   Add('  tiDynArray:=typeinfo(TDynArr);');
30358   Add('  tiProcVar:=typeinfo(ProcVar);');
30359   Add('  tiProcVar:=typeinfo(TProc);');
30360   Add('  tiMethodVar:=typeinfo(MethodVar);');
30361   Add('  tiMethodVar:=typeinfo(TMethod);');
30362   ConvertProgram;
30363   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
30364     LinesToStr([ // statements
30365     '$mod.$rtti.$StaticArray("TStaticArr", {',
30366     '  dims: [2],',
30367     '  eltype: rtl.string',
30368     '});',
30369     '$mod.$rtti.$DynArray("TDynArr", {',
30370     '  eltype: rtl.string',
30371     '});',
30372     '$mod.$rtti.$ProcVar("TProc", {',
30373     '  procsig: rtl.newTIProcSig(null)',
30374     '});',
30375     '$mod.$rtti.$MethodVar("TMethod", {',
30376     '  procsig: rtl.newTIProcSig(null),',
30377     '  methodkind: 0',
30378     '});',
30379     'this.StaticArray = rtl.arraySetLength(null,"",2);',
30380     'this.tiStaticArray = null;',
30381     'this.DynArray = [];',
30382     'this.tiDynArray = null;',
30383     'this.ProcVar = null;',
30384     'this.tiProcVar = null;',
30385     'this.MethodVar = null;',
30386     'this.tiMethodVar = null;',
30387     '']),
30388     LinesToStr([ // $mod.$main
30389     '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
30390     '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
30391     '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
30392     '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
30393     '$mod.tiProcVar = $mod.$rtti["TProc"];',
30394     '$mod.tiProcVar = $mod.$rtti["TProc"];',
30395     '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
30396     '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
30397     '']));
30398 end;
30399 
30400 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
30401 begin
30402   Converter.Options:=Converter.Options-[coNoTypeInfo];
30403   StartProgram(true,[supTypeInfo]);
30404   Add('{$modeswitch externalclass}');
30405   Add('type');
30406   Add('  TRec = record end;');
30407   // ToDo: ^PRec
30408   Add('  TObject = class end;');
30409   Add('  TClass = class of tobject;');
30410   Add('var');
30411   Add('  Rec: trec;');
30412   Add('  tiRecord: ttypeinforecord;');
30413   Add('  Obj: tobject;');
30414   Add('  tiClass: ttypeinfoclass;');
30415   Add('  aClass: tclass;');
30416   Add('  tiClassRef: ttypeinfoclassref;');
30417   // ToDo: ^PRec
30418   Add('  tiPointer: ttypeinfopointer;');
30419   Add('begin');
30420   Add('  tirecord:=typeinfo(trec);');
30421   Add('  tirecord:=typeinfo(trec);');
30422   Add('  ticlass:=typeinfo(obj);');
30423   Add('  ticlass:=typeinfo(tobject);');
30424   Add('  ticlass:=typeinfo(aclass);');
30425   Add('  ticlassref:=typeinfo(tclass);');
30426   ConvertProgram;
30427   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
30428     LinesToStr([ // statements
30429     'rtl.recNewT($mod, "TRec", function () {',
30430     '  this.$eq = function (b) {',
30431     '    return true;',
30432     '  };',
30433     '  this.$assign = function (s) {',
30434     '    return this;',
30435     '  };',
30436     '  $mod.$rtti.$Record("TRec", {});',
30437     '});',
30438     'rtl.createClass($mod, "TObject", null, function () {',
30439     '  this.$init = function () {',
30440     '  };',
30441     '  this.$final = function () {',
30442     '  };',
30443     '});',
30444     '$mod.$rtti.$ClassRef("TClass", {',
30445     '  instancetype: $mod.$rtti["TObject"]',
30446     '});',
30447     'this.Rec = $mod.TRec.$new();',
30448     'this.tiRecord = null;',
30449     'this.Obj = null;',
30450     'this.tiClass = null;',
30451     'this.aClass = null;',
30452     'this.tiClassRef = null;',
30453     'this.tiPointer = null;',
30454     '']),
30455     LinesToStr([ // $mod.$main
30456     '$mod.tiRecord = $mod.$rtti["TRec"];',
30457     '$mod.tiRecord = $mod.$rtti["TRec"];',
30458     '$mod.tiClass = $mod.Obj.$rtti;',
30459     '$mod.tiClass = $mod.$rtti["TObject"];',
30460     '$mod.tiClass = $mod.aClass.$rtti;',
30461     '$mod.tiClassRef = $mod.$rtti["TClass"];',
30462     '']));
30463 end;
30464 
30465 procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
30466 begin
30467   Converter.Options:=Converter.Options-[coNoTypeInfo];
30468   StartProgram(true,[supTypeInfo]);
30469   Add([
30470   '{$modeswitch externalclass}',
30471   'type',
30472   '  TClass = class of tobject;',
30473   '  TObject = class',
30474   '    function MyClass: TClass;',
30475   '    class function ClassType: TClass;',
30476   '  end;',
30477   'function TObject.MyClass: TClass;',
30478   'var t: TTypeInfoClass;',
30479   'begin',
30480   '  t:=TypeInfo(Self);',
30481   '  t:=TypeInfo(Result);',
30482   '  t:=TypeInfo(TObject);',
30483   'end;',
30484   'class function TObject.ClassType: TClass;',
30485   'var t: TTypeInfoClass;',
30486   'begin',
30487   '  t:=TypeInfo(Self);',
30488   '  t:=TypeInfo(Result);',
30489   'end;',
30490   'var',
30491   '  Obj: TObject;',
30492   '  t: TTypeInfoClass;',
30493   'begin',
30494   '  t:=TypeInfo(TObject.ClassType);',
30495   '  t:=TypeInfo(Obj.ClassType);',
30496   '  t:=TypeInfo(Obj.MyClass);',
30497   '']);
30498   ConvertProgram;
30499   CheckSource('TestRTTI_TypeInfo_FunctionClassType',
30500     LinesToStr([ // statements
30501     '$mod.$rtti.$Class("TObject");',
30502     '$mod.$rtti.$ClassRef("TClass", {',
30503     '  instancetype: $mod.$rtti["TObject"]',
30504     '});',
30505     'rtl.createClass($mod, "TObject", null, function () {',
30506     '  this.$init = function () {',
30507     '  };',
30508     '  this.$final = function () {',
30509     '  };',
30510     '  this.MyClass = function () {',
30511     '    var Result = null;',
30512     '    var t = null;',
30513     '    t = this.$rtti;',
30514     '    t = Result.$rtti;',
30515     '    t = $mod.$rtti["TObject"];',
30516     '    return Result;',
30517     '  };',
30518     '  this.ClassType = function () {',
30519     '    var Result = null;',
30520     '    var t = null;',
30521     '    t = this.$rtti;',
30522     '    t = Result.$rtti;',
30523     '    return Result;',
30524     '  };',
30525     '});',
30526     'this.Obj = null;',
30527     'this.t = null;',
30528     '']),
30529     LinesToStr([ // $mod.$main
30530     '$mod.t = $mod.TObject.ClassType().$rtti;',
30531     '$mod.t = $mod.Obj.$class.ClassType().$rtti;',
30532     '$mod.t = $mod.Obj.MyClass().$rtti;',
30533     '']));
30534 end;
30535 
30536 procedure TTestModule.TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
30537 begin
30538   Converter.Options:=Converter.Options-[coNoTypeInfo];
30539   AddModuleWithIntfImplSrc('typinfo.pas',
30540     LinesToStr([
30541     '{$modeswitch externalclass}',
30542     'type',
30543     '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
30544     '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;',
30545     '']),
30546     '');
30547   AddModuleWithIntfImplSrc('unit2.pas',
30548     LinesToStr([
30549     'uses typinfo;',
30550     'type PTypeInfo = TTypeInfo;', // delphi compatibility code
30551     'procedure DoPtr(p: PTypeInfo);',
30552     'procedure DoInfo(t: TTypeInfo);',
30553     'procedure DoInt(t: TTypeInfoInteger);',
30554     '']),
30555     LinesToStr([
30556     'procedure DoPtr(p: PTypeInfo);',
30557     'begin end;',
30558     'procedure DoInfo(t: TTypeInfo);',
30559     'begin end;',
30560     'procedure DoInt(t: TTypeInfoInteger);',
30561     'begin end;',
30562     '']));
30563   StartUnit(true);
30564   Add([
30565   'interface',
30566   'uses unit2;', // does not use unit typinfo
30567   'implementation',
30568   'var',
30569   '  i: byte;',
30570   '  p: pointer;',
30571   '  t: PTypeInfo;',
30572   'initialization',
30573   '  p:=typeinfo(i);',
30574   '  t:=typeinfo(i);',
30575   '  if p=t then ;',
30576   '  if p=typeinfo(i) then ;',
30577   '  if typeinfo(i)=p then ;',
30578   '  if t=typeinfo(i) then ;',
30579   '  if typeinfo(i)=t then ;',
30580   '  DoPtr(p);',
30581   '  DoPtr(t);',
30582   '  DoPtr(typeinfo(i));',
30583   '  DoInfo(p);',
30584   '  DoInfo(t);',
30585   '  DoInfo(typeinfo(i));',
30586   '  DoInt(typeinfo(i));',
30587   '']);
30588   ConvertUnit;
30589   CheckSource('TestRTTI_TypeInfo_MixedUnits_PointerAndClass',
30590     LinesToStr([ // statements
30591     'var $impl = $mod.$impl;',
30592     '']),
30593     LinesToStr([ // this.$init
30594     '$impl.p = rtl.byte;',
30595     '$impl.t = rtl.byte;',
30596     'if ($impl.p === $impl.t) ;',
30597     'if ($impl.p === rtl.byte) ;',
30598     'if (rtl.byte === $impl.p) ;',
30599     'if ($impl.t === rtl.byte) ;',
30600     'if (rtl.byte === $impl.t) ;',
30601     'pas.unit2.DoPtr($impl.p);',
30602     'pas.unit2.DoPtr($impl.t);',
30603     'pas.unit2.DoPtr(rtl.byte);',
30604     'pas.unit2.DoInfo($impl.p);',
30605     'pas.unit2.DoInfo($impl.t);',
30606     'pas.unit2.DoInfo(rtl.byte);',
30607     'pas.unit2.DoInt(rtl.byte);',
30608     '']),
30609     LinesToStr([ // implementation
30610     '$impl.i = 0;',
30611     '$impl.p = null;',
30612     '$impl.t = null;',
30613     '']) );
30614 end;
30615 
30616 procedure TTestModule.TestRTTI_Interface_Corba;
30617 begin
30618   Converter.Options:=Converter.Options-[coNoTypeInfo];
30619   StartProgram(true,[supTypeInfo]);
30620   Add([
30621   '{$interfaces corba}',
30622   '{$modeswitch externalclass}',
30623   'type',
30624   '  IUnknown = interface',
30625   '  end;',
30626   '  IBird = interface',
30627   '    function GetItem: longint;',
30628   '    procedure SetItem(Value: longint);',
30629   '    property Item: longint read GetItem write SetItem;',
30630   '  end;',
30631   'procedure DoIt(t: TTypeInfoInterface); begin end;',
30632   'var',
30633   '  i: IBird;',
30634   '  t: TTypeInfoInterface;',
30635   'begin',
30636   '  t:=TypeInfo(IBird);',
30637   '  t:=TypeInfo(i);',
30638   '  DoIt(t);',
30639   '  DoIt(TypeInfo(IBird));',
30640   '']);
30641   ConvertProgram;
30642   CheckSource('TestRTTI_Interface_Corba',
30643     LinesToStr([ // statements
30644     'rtl.createInterface(',
30645     '  $mod,',
30646     '  "IUnknown",',
30647     '  "{B92D5841-758A-322B-B800-000000000000}",',
30648     '  [],',
30649     '  null,',
30650     '  function () {',
30651     '  }',
30652     ');',
30653     'rtl.createInterface(',
30654     '  $mod,',
30655     '  "IBird",',
30656     '  "{D32D5841-6264-3AE3-A2C9-B91CE922C9B9}",',
30657     '  ["GetItem", "SetItem"],',
30658     '  null,',
30659     '  function () {',
30660     '    var $r = this.$rtti;',
30661     '    $r.addMethod("GetItem", 1, null, rtl.longint);',
30662     '    $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
30663     '    $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
30664     '  }',
30665     ');',
30666     'this.DoIt = function (t) {',
30667     '};    ',
30668     'this.i = null;',
30669     'this.t = null;',
30670     '']),
30671     LinesToStr([ // $mod.$main
30672     '$mod.t = $mod.$rtti["IBird"];',
30673     '$mod.t = $mod.i.$rtti;',
30674     '$mod.DoIt($mod.t);',
30675     '$mod.DoIt($mod.$rtti["IBird"]);',
30676     '']));
30677 end;
30678 
30679 procedure TTestModule.TestRTTI_Interface_COM;
30680 begin
30681   Converter.Options:=Converter.Options-[coNoTypeInfo];
30682   StartProgram(true,[supTypeInfo]);
30683   Add([
30684   '{$interfaces com}',
30685   '{$modeswitch externalclass}',
30686   'type',
30687   '  TGuid = record end;',
30688   '  integer = longint;',
30689   '  IUnknown = interface',
30690   '    function QueryInterface(const iid: TGuid; out obj): Integer;',
30691   '    function _AddRef: Integer;',
30692   '    function _Release: Integer;',
30693   '  end;',
30694   '  IBird = interface',
30695   '    function GetItem: longint;',
30696   '    procedure SetItem(Value: longint);',
30697   '    property Item: longint read GetItem write SetItem;',
30698   '  end;',
30699   'var',
30700   '  i: IBird;',
30701   '  t: TTypeInfoInterface;',
30702   'begin',
30703   '  t:=TypeInfo(IBird);',
30704   '  t:=TypeInfo(i);',
30705   '']);
30706   ConvertProgram;
30707   CheckSource('TestRTTI_Interface_COM',
30708     LinesToStr([ // statements
30709     'rtl.recNewT($mod, "TGuid", function () {',
30710     '  this.$eq = function (b) {',
30711     '    return true;',
30712     '  };',
30713     '  this.$assign = function (s) {',
30714     '    return this;',
30715     '  };',
30716     '  $mod.$rtti.$Record("TGuid", {});',
30717     '});',
30718     'rtl.createInterface(',
30719     '  $mod,',
30720     '  "IUnknown",',
30721     '  "{D7ADB00D-1A9B-3EDC-B123-730E661DDFA9}",',
30722     '  ["QueryInterface", "_AddRef", "_Release"],',
30723     '  null,',
30724     '  function () {',
30725     '    this.$kind = "com";',
30726     '    var $r = this.$rtti;',
30727     '    $r.addMethod("QueryInterface", 1, [["iid", $mod.$rtti["TGuid"], 2], ["obj", null, 4]], rtl.longint);',
30728     '    $r.addMethod("_AddRef", 1, null, rtl.longint);',
30729     '    $r.addMethod("_Release", 1, null, rtl.longint);',
30730     '  }',
30731     ');',
30732     'rtl.createInterface(',
30733     '  $mod,',
30734     '  "IBird",',
30735     '  "{9CC77572-0E45-3594-9A88-9E8D865C9E0A}",',
30736     '  ["GetItem", "SetItem"],',
30737     '  $mod.IUnknown,',
30738     '  function () {',
30739     '    var $r = this.$rtti;',
30740     '    $r.addMethod("GetItem", 1, null, rtl.longint);',
30741     '    $r.addMethod("SetItem", 0, [["Value", rtl.longint]]);',
30742     '    $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
30743     '  }',
30744     ');',
30745     'this.i = null;',
30746     'this.t = null;',
30747     '']),
30748     LinesToStr([ // $mod.$main
30749     '$mod.t = $mod.$rtti["IBird"];',
30750     '$mod.t = $mod.i.$rtti;',
30751     '']));
30752 end;
30753 
30754 procedure TTestModule.TestRTTI_ClassHelper;
30755 begin
30756   Converter.Options:=Converter.Options-[coNoTypeInfo];
30757   StartProgram(true,[supTypeInfo]);
30758   Add([
30759   '{$interfaces com}',
30760   '{$modeswitch externalclass}',
30761   'type',
30762   '  TObject = class',
30763   '  end;',
30764   '  THelper = class helper for TObject',
30765   '  published',
30766   '    function GetItem: longint;',
30767   '    property Item: longint read GetItem;',
30768   '  end;',
30769   'function THelper.GetItem: longint;',
30770   'begin',
30771   'end;',
30772   'var',
30773   '  t: TTypeInfoHelper;',
30774   'begin',
30775   '  t:=TypeInfo(THelper);',
30776   '']);
30777   ConvertProgram;
30778   CheckSource('TestRTTI_ClassHelper',
30779     LinesToStr([ // statements
30780     'rtl.createClass($mod, "TObject", null, function () {',
30781     '  this.$init = function () {',
30782     '  };',
30783     '  this.$final = function () {',
30784     '  };',
30785     '});',
30786     'rtl.createHelper($mod, "THelper", null, function () {',
30787     '  this.GetItem = function () {',
30788     '    var Result = 0;',
30789     '    return Result;',
30790     '  };',
30791     '  var $r = this.$rtti;',
30792     '  $r.addMethod("GetItem", 1, null, rtl.longint);',
30793     '  $r.addProperty("Item", 1, rtl.longint, "GetItem", "");',
30794     '});',
30795     'this.t = null;',
30796     '']),
30797     LinesToStr([ // $mod.$main
30798     '$mod.t = $mod.$rtti["THelper"];',
30799     '']));
30800 end;
30801 
30802 procedure TTestModule.TestRTTI_ExternalClass;
30803 begin
30804   Converter.Options:=Converter.Options-[coNoTypeInfo];
30805   StartProgram(true,[supTypeInfo]);
30806   Add([
30807   '{$modeswitch externalclass}',
30808   'type',
30809   '  TJSObject = class external name ''Object''',
30810   '  end;',
30811   '  TJSArray = class external name ''Array'' (TJSObject)',
30812   '  end;',
30813   'var',
30814   '  p: Pointer;',
30815   '  tc: TTypeInfoExtClass;',
30816   'begin',
30817   '  p:=typeinfo(TJSArray);']);
30818   ConvertProgram;
30819   CheckSource('TestRTTI_ExternalClass',
30820     LinesToStr([ // statements
30821     '$mod.$rtti.$ExtClass("TJSObject", {',
30822     '  jsclass: "Object"',
30823     '});',
30824     '$mod.$rtti.$ExtClass("TJSArray", {',
30825     '  ancestor: $mod.$rtti["TJSObject"],',
30826     '  jsclass: "Array"',
30827     '});',
30828     'this.p = null;',
30829     'this.tc = null;',
30830     '']),
30831     LinesToStr([ // $mod.$main
30832     '$mod.p = $mod.$rtti["TJSArray"];',
30833     '']));
30834 end;
30835 
30836 procedure TTestModule.TestResourcestringProgram;
30837 begin
30838   AddModuleWithIntfImplSrc('unit2.pas',
30839     LinesToStr([
30840     'resourcestring Title = ''Nice'';',
30841     '']),
30842     '');
30843   StartProgram(true);
30844   Add([
30845   'uses unit2;',
30846   'const Bar = ''bar'';',
30847   'resourcestring',
30848   '  Red = ''red'';',
30849   '  Foobar = ''fOo''+bar;',
30850   'var s: string;',
30851   '  c: char;',
30852   'begin',
30853   '  s:=red;',
30854   '  s:=test1.red;',
30855   '  s:=Title;',
30856   '  c:=red[1];',
30857   '  c:=test1.red[2];',
30858   '  if red=foobar then ;',
30859   '  if red[3]=red[4] then ;']);
30860   ConvertProgram;
30861   CheckSource('TestResourcestringProgram',
30862     LinesToStr([ // statements
30863     'this.Bar = "bar";',
30864     'this.s = "";',
30865     'this.c = "";',
30866     '$mod.$resourcestrings = {',
30867     '  Red: {',
30868     '      org: "red"',
30869     '    },',
30870     '  Foobar: {',
30871     '      org: "fOobar"',
30872     '    }',
30873     '};',
30874     '']),
30875     LinesToStr([ // $mod.$main
30876     '$mod.s = rtl.getResStr($mod, "Red");',
30877     '$mod.s = rtl.getResStr($mod, "Red");',
30878     '$mod.s = rtl.getResStr(pas.unit2, "Title");',
30879     '$mod.c = rtl.getResStr($mod, "Red").charAt(0);',
30880     '$mod.c = rtl.getResStr($mod, "Red").charAt(1);',
30881     'if (rtl.getResStr($mod, "Red") === rtl.getResStr($mod, "Foobar")) ;',
30882     'if (rtl.getResStr($mod, "Red").charAt(2) === rtl.getResStr($mod, "Red").charAt(3)) ;',
30883     '']));
30884 end;
30885 
30886 procedure TTestModule.TestResourcestringUnit;
30887 begin
30888   AddModuleWithIntfImplSrc('unit2.pas',
30889     LinesToStr([
30890     'resourcestring Title = ''Nice'';',
30891     '']),
30892     '');
30893   StartUnit(true);
30894   Add([
30895   'interface',
30896   'uses unit2;',
30897   'const Red = ''rEd'';',
30898   'resourcestring',
30899   '  Blue = ''blue'';',
30900   '  NotRed = ''not''+Red;',
30901   'var s: string;',
30902   'implementation',
30903   'resourcestring',
30904   '  ImplGreen = ''green'';',
30905   'initialization',
30906   '  s:=blue+ImplGreen;',
30907   '  s:=test1.blue+test1.implgreen;',
30908   '  s:=blue[1]+implgreen[2];',
30909   '  s:=Title;',
30910   '']);
30911   ConvertUnit;
30912   CheckSource('TestResourcestringUnit',
30913     LinesToStr([ // statements
30914     'this.Red = "rEd";',
30915     'this.s = "";',
30916     '$mod.$resourcestrings = {',
30917     '  Blue: {',
30918     '      org: "blue"',
30919     '    },',
30920     '  NotRed: {',
30921     '      org: "notrEd"',
30922     '    },',
30923     '  ImplGreen: {',
30924     '      org: "green"',
30925     '    }',
30926     '};',
30927     '']),
30928     LinesToStr([ // $mod.$main
30929     '$mod.s = rtl.getResStr($mod, "Blue") + rtl.getResStr($mod, "ImplGreen");',
30930     '$mod.s = rtl.getResStr($mod, "Blue") + rtl.getResStr($mod, "ImplGreen");',
30931     '$mod.s = rtl.getResStr($mod, "Blue").charAt(0) + rtl.getResStr($mod, "ImplGreen").charAt(1);',
30932     '$mod.s = rtl.getResStr(pas.unit2, "Title");',
30933     '']));
30934 end;
30935 
30936 procedure TTestModule.TestResourcestringImplementation;
30937 begin
30938   StartUnit(false);
30939   Add([
30940   'interface',
30941   'implementation',
30942   'resourcestring',
30943   '  ImplRed = ''red'';']);
30944   ConvertUnit;
30945   CheckSource('TestResourcestringImplementation',
30946     LinesToStr([ // intf statements
30947     'var $impl = $mod.$impl;']),
30948     LinesToStr([ // $mod.$init
30949     '']),
30950     LinesToStr([ // impl statements
30951     '$mod.$resourcestrings = {',
30952     '  ImplRed: {',
30953     '      org: "red"',
30954     '    }',
30955     '};',
30956     '']));
30957 end;
30958 
30959 procedure TTestModule.TestAttributes_Members;
30960 begin
30961   Converter.Options:=Converter.Options-[coNoTypeInfo];
30962   StartProgram(false);
30963   Add([
30964   '{$modeswitch PrefixedAttributes}',
30965   'type',
30966   '  TObject = class',
30967   '    constructor Create;',
30968   '  end;',
30969   '  TCustomAttribute = class',
30970   '    constructor Create(Id: word);',
30971   '  end;',
30972   '  [Missing]',
30973   '  TBird = class',
30974   '  published',
30975   '    [Tcustom]',
30976   '    FField: word;',
30977   '    [tcustom(14)]',
30978   '    property Size: word read FField;',
30979   '    [Tcustom(15)]',
30980   '    procedure Fly; virtual; abstract;',
30981   '  end;',
30982   '  TRec = record',
30983   '    [Tcustom,tcustom(14)]',
30984   '    Size: word;',
30985   '  end;',
30986   'constructor TObject.Create; begin end;',
30987   'constructor TCustomAttribute.Create(Id: word); begin end;',
30988   'begin',
30989   '']);
30990   ConvertProgram;
30991   CheckSource('TestAttributes_Members',
30992     LinesToStr([ // statements
30993     'rtl.createClass($mod, "TObject", null, function () {',
30994     '  this.$init = function () {',
30995     '  };',
30996     '  this.$final = function () {',
30997     '  };',
30998     '  this.Create = function () {',
30999     '    return this;',
31000     '  };',
31001     '});',
31002     'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
31003     '  this.Create$1 = function (Id) {',
31004     '    return this;',
31005     '  };',
31006     '});',
31007     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
31008     '  this.$init = function () {',
31009     '    $mod.TObject.$init.call(this);',
31010     '    this.FField = 0;',
31011     '  };',
31012     '  var $r = this.$rtti;',
31013     '  $r.addField("FField", rtl.word, {',
31014     '    attr: [$mod.TCustomAttribute, "Create"]',
31015     '  });',
31016     '  $r.addProperty(',
31017     '    "Size",',
31018     '    0,',
31019     '    rtl.word,',
31020     '    "FField",',
31021     '    "",',
31022     '    {',
31023     '      attr: [$mod.TCustomAttribute, "Create$1", [14]]',
31024     '    }',
31025     '  );',
31026     '  $r.addMethod("Fly", 0, null, null, {',
31027     '    attr: [$mod.TCustomAttribute, "Create$1", [15]]',
31028     '  });',
31029     '});',
31030     'rtl.recNewT($mod, "TRec", function () {',
31031     '  this.Size = 0;',
31032     '  this.$eq = function (b) {',
31033     '    return this.Size === b.Size;',
31034     '  };',
31035     '  this.$assign = function (s) {',
31036     '    this.Size = s.Size;',
31037     '    return this;',
31038     '  };',
31039     '  var $r = $mod.$rtti.$Record("TRec", {});',
31040     '  $r.addField("Size", rtl.word, {',
31041     '    attr: [',
31042     '        $mod.TCustomAttribute,',
31043     '        "Create",',
31044     '        $mod.TCustomAttribute,',
31045     '        "Create$1",',
31046     '        [14]',
31047     '      ]',
31048     '  });',
31049     '});',
31050     '']),
31051     LinesToStr([ // $mod.$main
31052     '']));
31053 end;
31054 
31055 procedure TTestModule.TestAttributes_Types;
31056 begin
31057   Converter.Options:=Converter.Options-[coNoTypeInfo];
31058   StartProgram(false);
31059   Add([
31060   '{$modeswitch PrefixedAttributes}',
31061   'type',
31062   '  TObject = class',
31063   '    constructor Create(Id: word);',
31064   '  end;',
31065   '  TCustomAttribute = class',
31066   '  end;',
31067   '  [TCustom(1)]',
31068   '  TMyClass = class',
31069   '  end;',
31070   '  [TCustom(2)]',
31071   '  TRec = record',
31072   '  end;',
31073   '  [TCustom(3)]',
31074   '  TInt = type word;',
31075   'constructor TObject.Create(Id: word);',
31076   'begin',
31077   'end;',
31078   'var p: pointer;',
31079   'begin',
31080   '  p:=typeinfo(TMyClass);',
31081   '  p:=typeinfo(TRec);',
31082   '  p:=typeinfo(TInt);',
31083   '']);
31084   ConvertProgram;
31085   CheckSource('TestAttributes_Types',
31086     LinesToStr([ // statements
31087     'rtl.createClass($mod, "TObject", null, function () {',
31088     '  this.$init = function () {',
31089     '  };',
31090     '  this.$final = function () {',
31091     '  };',
31092     '  this.Create = function (Id) {',
31093     '    return this;',
31094     '  };',
31095     '});',
31096     'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
31097     '});',
31098     'rtl.createClass($mod, "TMyClass", $mod.TObject, function () {',
31099     '  var $r = this.$rtti;',
31100     '  $r.attr = [$mod.TCustomAttribute, "Create", [1]];',
31101     '});',
31102     'rtl.recNewT($mod, "TRec", function () {',
31103     '  this.$eq = function (b) {',
31104     '    return true;',
31105     '  };',
31106     '  this.$assign = function (s) {',
31107     '    return this;',
31108     '  };',
31109     '  $mod.$rtti.$Record("TRec", {',
31110     '    attr: [$mod.TCustomAttribute, "Create", [2]]',
31111     '  });',
31112     '});',
31113     '$mod.$rtti.$inherited("TInt", rtl.word, {',
31114     '  attr: [$mod.TCustomAttribute, "Create", [3]]',
31115     '});',
31116     'this.p = null;',
31117     '']),
31118     LinesToStr([ // $mod.$main
31119     '$mod.p = $mod.$rtti["TMyClass"];',
31120     '$mod.p = $mod.$rtti["TRec"];',
31121     '$mod.p = $mod.$rtti["TInt"];',
31122     '']));
31123 end;
31124 
31125 procedure TTestModule.TestAttributes_HelperConstructor_Fail;
31126 begin
31127   Converter.Options:=Converter.Options-[coNoTypeInfo];
31128   StartProgram(false);
31129   Add([
31130   '{$modeswitch PrefixedAttributes}',
31131   'type',
31132   '  TObject = class',
31133   '    constructor Create;',
31134   '  end;',
31135   '  TCustomAttribute = class',
31136   '  end;',
31137   '  THelper = class helper for TCustomAttribute',
31138   '    constructor Create(Id: word);',
31139   '  end;',
31140   '  [TCustom(3)]',
31141   '  TMyInt = word;',
31142   'constructor TObject.Create; begin end;',
31143   'constructor THelper.Create(Id: word); begin end;',
31144   'begin',
31145   '  if typeinfo(TMyInt)=nil then ;']);
31146   ConvertProgram;
31147 end;
31148 
31149 procedure TTestModule.TestAssert;
31150 begin
31151   StartProgram(false);
31152   Add([
31153   'procedure DoIt;',
31154   'var',
31155   '  b: boolean;',
31156   '  s: string;',
31157   'begin',
31158   '  {$Assertions on}',
31159   '  Assert(b);',
31160   'end;',
31161   'begin',
31162   '  DoIt;',
31163   '']);
31164   ConvertProgram;
31165   CheckSource('TestAssert',
31166     LinesToStr([ // statements
31167     'this.DoIt = function () {',
31168     '  var b = false;',
31169     '  var s = "";',
31170     '  if (!b) throw "assert failed";',
31171     '};',
31172     '']),
31173     LinesToStr([ // $mod.$main
31174     '$mod.DoIt();',
31175     '']));
31176 end;
31177 
31178 procedure TTestModule.TestAssert_SysUtils;
31179 begin
31180   AddModuleWithIntfImplSrc('SysUtils.pas',
31181     LinesToStr([
31182     'type',
31183     '  TObject = class',
31184     '    constructor Create;',
31185     '  end;',
31186     '  EAssertionFailed = class',
31187     '    constructor Create(s: string);',
31188     '  end;',
31189     '']),
31190     LinesToStr([
31191     'constructor TObject.Create;',
31192     'begin end;',
31193     'constructor EAssertionFailed.Create(s: string);',
31194     'begin end;',
31195     '']) );
31196 
31197   StartProgram(true);
31198   Add([
31199   'uses sysutils;',
31200   'procedure DoIt;',
31201   'var',
31202   '  b: boolean;',
31203   '  s: string;',
31204   'begin',
31205   '  {$Assertions on}',
31206   '  Assert(b);',
31207   '  Assert(b,''msg'');',
31208   'end;',
31209   'begin',
31210   '  DoIt;',
31211   '']);
31212   ConvertProgram;
31213   CheckSource('TestAssert_SysUtils',
31214     LinesToStr([ // statements
31215     'this.DoIt = function () {',
31216     '  var b = false;',
31217     '  var s = "";',
31218     '  if (!b) throw pas.SysUtils.EAssertionFailed.$create("Create");',
31219     '  if (!b) throw pas.SysUtils.EAssertionFailed.$create("Create$1", ["msg"]);',
31220     '};',
31221     '']),
31222     LinesToStr([ // $mod.$main
31223     '$mod.DoIt();',
31224     '']));
31225 end;
31226 
31227 procedure TTestModule.TestObjectChecks;
31228 begin
31229   Scanner.CurrentBoolSwitches:=Scanner.CurrentBoolSwitches+[bsObjectChecks];
31230   StartProgram(false);
31231   Add([
31232   'type',
31233   '  TObject = class',
31234   '    procedure DoIt;',
31235   '  end;',
31236   '  TClass = class of tobject;',
31237   '  TBird = class',
31238   '  end;',
31239   '  TBirdClass = class of TBird;',
31240   'var',
31241   '  o : TObject;',
31242   '  c: TClass;',
31243   '  b: TBird;',
31244   '  bc: TBirdClass;',
31245   'procedure TObject.DoIt;',
31246   'begin',
31247   '  b:=TBird(o);',
31248   'end;',
31249   'begin',
31250   '  o.DoIt;',
31251   '  b:=TBird(o);',
31252   '  bc:=TBirdClass(c);',
31253   '']);
31254   ConvertProgram;
31255   CheckSource('TestCheckMethodCall',
31256     LinesToStr([ // statements
31257     'rtl.createClass($mod, "TObject", null, function () {',
31258     '  this.$init = function () {',
31259     '  };',
31260     '  this.$final = function () {',
31261     '  };',
31262     '  this.DoIt = function () {',
31263     '    rtl.checkMethodCall(this,$mod.TObject);',
31264     '    $mod.b = rtl.asExt($mod.o, $mod.TBird, 1);',
31265     '  };',
31266     '});',
31267     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
31268     '});',
31269     'this.o = null;',
31270     'this.c = null;',
31271     'this.b = null;',
31272     'this.bc = null;',
31273     '']),
31274     LinesToStr([ // $mod.$main
31275     '$mod.o.DoIt();',
31276     '$mod.b = rtl.asExt($mod.o,$mod.TBird, 1);',
31277     '$mod.bc = rtl.asExt($mod.c, $mod.TBird, 2);',
31278     '']));
31279 end;
31280 
31281 procedure TTestModule.TestOverflowChecks_Int;
31282 begin
31283   Scanner.CurrentBoolSwitches:=Scanner.CurrentBoolSwitches+[bsOverflowChecks];
31284   StartProgram(false);
31285   Add([
31286   'procedure DoIt;',
31287   'var',
31288   '  b: byte;',
31289   '  n: nativeint;',
31290   '  u: nativeuint;',
31291   '  c: currency;',
31292   'begin',
31293   '  n:=n+n;',
31294   '  n:=n-n;',
31295   '  n:=n+b;',
31296   '  n:=b-n;',
31297   '  n:=n*n;',
31298   '  n:=n*u;',
31299   '  c:=c+b;',
31300   '  c:=b+c;',
31301   '  c:=c*b;',
31302   '  c:=b*c;',
31303   'end;',
31304   'begin',
31305   '']);
31306   ConvertProgram;
31307   CheckSource('TestOverflowChecks_Int',
31308     LinesToStr([ // statements
31309     'this.DoIt = function () {',
31310     '  var b = 0;',
31311     '  var n = 0;',
31312     '  var u = 0;',
31313     '  var c = 0;',
31314     '  n = rtl.oc(n + n);',
31315     '  n = rtl.oc(n - n);',
31316     '  n = rtl.oc(n + b);',
31317     '  n = rtl.oc(b - n);',
31318     '  n = rtl.oc(n * n);',
31319     '  n = rtl.oc(n * u);',
31320     '  c = rtl.oc(c + (b * 10000));',
31321     '  c = rtl.oc((b * 10000) + c);',
31322     '  c = rtl.oc(c * b);',
31323     '  c = rtl.oc(b * c);',
31324     '};',
31325     '']),
31326     LinesToStr([ // $mod.$main
31327     '']));
31328 end;
31329 
31330 procedure TTestModule.TestRangeChecks_AssignInt;
31331 begin
31332   Scanner.Options:=Scanner.Options+[po_CAssignments];
31333   StartProgram(false);
31334   Add([
31335   '{$R+}',
31336   'var',
31337   '  b: byte = 2;',
31338   '  w: word = 3;',
31339   'procedure DoIt(p: byte);',
31340   'begin',
31341   '  b:=w;',
31342   '  b+=w;',
31343   '  b:=1;',
31344   'end;',
31345   '{$R-}',
31346   'procedure DoSome;',
31347   'begin',
31348   '  DoIt(w);',
31349   '  b:=w;',
31350   '  b:=2;',
31351   'end;',
31352   'begin',
31353   '{$R+}',
31354   '']);
31355   ConvertProgram;
31356   CheckSource('TestRangeChecks_AssignInt',
31357     LinesToStr([ // statements
31358     'this.b = 2;',
31359     'this.w = 3;',
31360     'this.DoIt = function (p) {',
31361     '  rtl.rc(p, 0, 255);',
31362     '  $mod.b = rtl.rc($mod.w,0,255);',
31363     '  rtl.rc($mod.b += $mod.w, 0, 255);',
31364     '  $mod.b = 1;',
31365     '};',
31366     'this.DoSome = function () {',
31367     '  $mod.DoIt($mod.w);',
31368     '  $mod.b = $mod.w;',
31369     '  $mod.b = 2;',
31370     '};',
31371     '']),
31372     LinesToStr([ // $mod.$main
31373     '']));
31374 end;
31375 
31376 procedure TTestModule.TestRangeChecks_AssignIntRange;
31377 begin
31378   Scanner.Options:=Scanner.Options+[po_CAssignments];
31379   StartProgram(false);
31380   Add([
31381   '{$R+}',
31382   'type Ten = 1..10;',
31383   'var',
31384   '  b: Ten = 2;',
31385   '  w: Ten = 3;',
31386   'procedure DoIt(p: Ten);',
31387   'begin',
31388   '  b:=w;',
31389   '  b+=w;',
31390   '  b:=1;',
31391   'end;',
31392   '{$R-}',
31393   'procedure DoSome;',
31394   'begin',
31395   '  DoIt(w);',
31396   '  b:=w;',
31397   '  b:=2;',
31398   'end;',
31399   'begin',
31400   '{$R+}',
31401   '']);
31402   ConvertProgram;
31403   CheckSource('TestRangeChecks_AssignIntRange',
31404     LinesToStr([ // statements
31405     'this.b = 2;',
31406     'this.w = 3;',
31407     'this.DoIt = function (p) {',
31408     '  rtl.rc(p, 1, 10);',
31409     '  $mod.b = rtl.rc($mod.w, 1, 10);',
31410     '  rtl.rc($mod.b += $mod.w, 1, 10);',
31411     '  $mod.b = 1;',
31412     '};',
31413     'this.DoSome = function () {',
31414     '  $mod.DoIt($mod.w);',
31415     '  $mod.b = $mod.w;',
31416     '  $mod.b = 2;',
31417     '};',
31418     '']),
31419     LinesToStr([ // $mod.$main
31420     '']));
31421 end;
31422 
31423 procedure TTestModule.TestRangeChecks_AssignEnum;
31424 begin
31425   StartProgram(false);
31426   Add([
31427   '{$R+}',
31428   'type TEnum = (red,green);',
31429   'var',
31430   '  e: TEnum = red;',
31431   'procedure DoIt(p: TEnum);',
31432   'begin',
31433   '  e:=p;',
31434   '  p:=TEnum(0);',
31435   '  p:=succ(e);',
31436   'end;',
31437   '{$R-}',
31438   'procedure DoSome;',
31439   'begin',
31440   '  DoIt(e);',
31441   '  e:=TEnum(1);',
31442   '  e:=pred(e);',
31443   'end;',
31444   'begin',
31445   '{$R+}',
31446   '']);
31447   ConvertProgram;
31448   CheckSource('TestRangeChecks_AssignEnum',
31449     LinesToStr([ // statements
31450     'this.TEnum = {',
31451     '  "0": "red",',
31452     '  red: 0,',
31453     '  "1": "green",',
31454     '  green: 1',
31455     '};',
31456     'this.e = $mod.TEnum.red;',
31457     'this.DoIt = function (p) {',
31458     '  rtl.rc(p, 0, 1);',
31459     '  $mod.e = rtl.rc(p, 0, 1);',
31460     '  p = 0;',
31461     '  p = rtl.rc($mod.e + 1, 0, 1);',
31462     '};',
31463     'this.DoSome = function () {',
31464     '  $mod.DoIt($mod.e);',
31465     '  $mod.e = 1;',
31466     '  $mod.e = $mod.e - 1;',
31467     '};',
31468     '']),
31469     LinesToStr([ // $mod.$main
31470     '']));
31471 end;
31472 
31473 procedure TTestModule.TestRangeChecks_AssignEnumRange;
31474 begin
31475   StartProgram(false);
31476   Add([
31477   '{$R+}',
31478   'type',
31479   '  TEnum = (red,green);',
31480   '  TEnumRg = red..green;',
31481   'var',
31482   '  e: TEnumRg = red;',
31483   'procedure DoIt(p: TEnumRg);',
31484   'begin',
31485   '  e:=p;',
31486   '  p:=TEnumRg(0);',
31487   '  p:=succ(e);',
31488   'end;',
31489   '{$R-}',
31490   'procedure DoSome;',
31491   'begin',
31492   '  DoIt(e);',
31493   '  e:=TEnum(1);',
31494   '  e:=pred(e);',
31495   'end;',
31496   'begin',
31497   '{$R+}',
31498   '']);
31499   ConvertProgram;
31500   CheckSource('TestRangeChecks_AssignEnumRange',
31501     LinesToStr([ // statements
31502     'this.TEnum = {',
31503     '  "0": "red",',
31504     '  red: 0,',
31505     '  "1": "green",',
31506     '  green: 1',
31507     '};',
31508     'this.e = $mod.TEnum.red;',
31509     'this.DoIt = function (p) {',
31510     '  rtl.rc(p, 0, 1);',
31511     '  $mod.e = rtl.rc(p, 0, 1);',
31512     '  p = 0;',
31513     '  p = rtl.rc($mod.e + 1, 0, 1);',
31514     '};',
31515     'this.DoSome = function () {',
31516     '  $mod.DoIt($mod.e);',
31517     '  $mod.e = 1;',
31518     '  $mod.e = $mod.e - 1;',
31519     '};',
31520     '']),
31521     LinesToStr([ // $mod.$main
31522     '']));
31523 end;
31524 
31525 procedure TTestModule.TestRangeChecks_AssignChar;
31526 begin
31527   StartProgram(false);
31528   Add([
31529   '{$R+}',
31530   'type',
31531   '  TLetter = char;',
31532   'var',
31533   '  b: TLetter = ''2'';',
31534   '  w: TLetter = ''3'';',
31535   'procedure DoIt(p: TLetter);',
31536   'begin',
31537   '  b:=w;',
31538   '  b:=''1'';',
31539   'end;',
31540   '{$R-}',
31541   'procedure DoSome;',
31542   'begin',
31543   '  DoIt(w);',
31544   '  b:=w;',
31545   '  b:=''2'';',
31546   'end;',
31547   'begin',
31548   '{$R+}',
31549   '']);
31550   ConvertProgram;
31551   CheckSource('TestRangeChecks_AssignChar',
31552     LinesToStr([ // statements
31553     'this.b = "2";',
31554     'this.w = "3";',
31555     'this.DoIt = function (p) {',
31556     '  rtl.rcc(p, 0, 65535);',
31557     '  $mod.b = rtl.rcc($mod.w, 0, 65535);',
31558     '  $mod.b = "1";',
31559     '};',
31560     'this.DoSome = function () {',
31561     '  $mod.DoIt($mod.w);',
31562     '  $mod.b = $mod.w;',
31563     '  $mod.b = "2";',
31564     '};',
31565     '']),
31566     LinesToStr([ // $mod.$main
31567     '']));
31568 end;
31569 
31570 procedure TTestModule.TestRangeChecks_AssignCharRange;
31571 begin
31572   StartProgram(false);
31573   Add([
31574   '{$R+}',
31575   'type TDigit = ''0''..''9'';',
31576   'var',
31577   '  b: TDigit = ''2'';',
31578   '  w: TDigit = ''3'';',
31579   'procedure DoIt(p: TDigit);',
31580   'begin',
31581   '  b:=w;',
31582   '  b:=''1'';',
31583   'end;',
31584   '{$R-}',
31585   'procedure DoSome;',
31586   'begin',
31587   '  DoIt(w);',
31588   '  b:=w;',
31589   '  b:=''2'';',
31590   'end;',
31591   'begin',
31592   '{$R+}',
31593   '']);
31594   ConvertProgram;
31595   CheckSource('TestRangeChecks_AssignCharRange',
31596     LinesToStr([ // statements
31597     'this.b = "2";',
31598     'this.w = "3";',
31599     'this.DoIt = function (p) {',
31600     '  rtl.rcc(p, 48, 57);',
31601     '  $mod.b = rtl.rcc($mod.w, 48, 57);',
31602     '  $mod.b = "1";',
31603     '};',
31604     'this.DoSome = function () {',
31605     '  $mod.DoIt($mod.w);',
31606     '  $mod.b = $mod.w;',
31607     '  $mod.b = "2";',
31608     '};',
31609     '']),
31610     LinesToStr([ // $mod.$main
31611     '']));
31612 end;
31613 
31614 procedure TTestModule.TestRangeChecks_ArrayIndex;
31615 begin
31616   StartProgram(false);
31617   Add([
31618   '{$R+}',
31619   'type',
31620   '  Ten = 1..10;',
31621   '  TArr = array of Ten;',
31622   '  TArrArr = array of TArr;',
31623   '  TArrByte = array[byte] of Ten;',
31624   '  TArrChar = array[''0''..''9''] of Ten;',
31625   '  TArrByteChar = array[byte,''0''..''9''] of Ten;',
31626   '  TObject = class',
31627   '    A: TArr;',
31628   '  end;',
31629   'procedure DoIt;',
31630   'var',
31631   '  Arr: TArr;',
31632   '  ArrArr: TArrArr;',
31633   '  ArrByte: TArrByte;',
31634   '  ArrChar: TArrChar;',
31635   '  ArrByteChar: TArrByteChar;',
31636   '  i: Ten;',
31637   '  c: char;',
31638   '  o: tobject;',
31639   'begin',
31640   '  i:=Arr[1];',
31641   '  i:=ArrByteChar[1,''2''];',
31642   '  Arr[1]:=Arr[1];',
31643   '  Arr[i]:=Arr[i];',
31644   '  ArrByte[3]:=ArrByte[3];',
31645   '  ArrByte[i]:=ArrByte[i];',
31646   '  ArrChar[''5'']:=ArrChar[''5''];',
31647   '  ArrChar[c]:=ArrChar[c];',
31648   '  ArrByteChar[7,''7'']:=ArrByteChar[7,''7''];',
31649   '  ArrByteChar[i,c]:=ArrByteChar[i,c];',
31650   '  o.a[i]:=o.a[i];',
31651   'end;',
31652   'begin',
31653   '']);
31654   ConvertProgram;
31655   CheckSource('TestRangeChecks_ArrayIndex',
31656     LinesToStr([ // statements
31657     'rtl.createClass($mod, "TObject", null, function () {',
31658     '  this.$init = function () {',
31659     '    this.A = [];',
31660     '  };',
31661     '  this.$final = function () {',
31662     '    this.A = undefined;',
31663     '  };',
31664     '});',
31665     'this.DoIt = function () {',
31666     '  var Arr = [];',
31667     '  var ArrArr = [];',
31668     '  var ArrByte = rtl.arraySetLength(null, 0, 256);',
31669     '  var ArrChar = rtl.arraySetLength(null, 0, 10);',
31670     '  var ArrByteChar = rtl.arraySetLength(null, 0, 256, 10);',
31671     '  var i = 0;',
31672     '  var c = "";',
31673     '  var o = null;',
31674     '  i = rtl.rc(Arr[1], 1, 10);',
31675     '  i = rtl.rc(ArrByteChar[1][2], 1, 10);',
31676     '  Arr[1] = rtl.rc(Arr[1], 1, 10);',
31677     '  rtl.rcArrW(Arr, i, rtl.rcArrR(Arr, i));',
31678     '  ArrByte[3] = rtl.rc(ArrByte[3], 1, 10);',
31679     '  rtl.rcArrW(ArrByte, i, rtl.rcArrR(ArrByte, i));',
31680     '  ArrChar[5] = rtl.rc(ArrChar[5], 1, 10);',
31681     '  rtl.rcArrW(ArrChar, c.charCodeAt() - 48, rtl.rcArrR(ArrChar, c.charCodeAt() - 48));',
31682     '  ArrByteChar[7][7] = rtl.rc(ArrByteChar[7][7], 1, 10);',
31683     '  rtl.rcArrW(ArrByteChar, i, c.charCodeAt() - 48, rtl.rcArrR(ArrByteChar, i, c.charCodeAt() - 48));',
31684     '  rtl.rcArrW(o.A, i, rtl.rcArrR(o.A, i));',
31685     '};',
31686     '']),
31687     LinesToStr([ // $mod.$main
31688     '']));
31689 end;
31690 
31691 procedure TTestModule.TestRangeChecks_ArrayOfRecIndex;
31692 begin
31693   StartProgram(false);
31694   Add([
31695   '{$R+}',
31696   'type',
31697   '  Ten = 1..10;',
31698   '  TRec = record x: Ten end;',
31699   '  TArr = array of TRec;',
31700   '  TArrArr = array of TArr;',
31701   '  TObject = class',
31702   '    A: TArr;',
31703   '  end;',
31704   'procedure DoIt;',
31705   'var',
31706   '  Arr: TArr;',
31707   '  ArrArr: TArrArr;',
31708   '  i: Ten;',
31709   '  o: tobject;',
31710   'begin',
31711   '  Arr[1]:=Arr[1];',
31712   '  Arr[i]:=Arr[i+1];',
31713   '  o.a[i]:=o.a[i+2];',
31714   'end;',
31715   'begin',
31716   '']);
31717   ConvertProgram;
31718   CheckSource('TestRangeChecks_ArrayOfRecIndex',
31719     LinesToStr([ // statements
31720     'rtl.recNewT($mod, "TRec", function () {',
31721     '  this.x = 0;',
31722     '  this.$eq = function (b) {',
31723     '    return this.x === b.x;',
31724     '  };',
31725     '  this.$assign = function (s) {',
31726     '    this.x = s.x;',
31727     '    return this;',
31728     '  };',
31729     '});',
31730     'rtl.createClass($mod, "TObject", null, function () {',
31731     '  this.$init = function () {',
31732     '    this.A = [];',
31733     '  };',
31734     '  this.$final = function () {',
31735     '    this.A = undefined;',
31736     '  };',
31737     '});',
31738     'this.DoIt = function () {',
31739     '  var Arr = [];',
31740     '  var ArrArr = [];',
31741     '  var i = 0;',
31742     '  var o = null;',
31743     '  Arr[1].$assign(Arr[1]);',
31744     '  rtl.rcArrR(Arr, i).$assign(rtl.rcArrR(Arr, i + 1));',
31745     '  rtl.rcArrR(o.A, i).$assign(rtl.rcArrR(o.A, i + 2));',
31746     '};',
31747     '']),
31748     LinesToStr([ // $mod.$main
31749     '']));
31750 end;
31751 
31752 procedure TTestModule.TestRangeChecks_StringIndex;
31753 begin
31754   StartProgram(false);
31755   Add([
31756   'type',
31757   '  TObject = class',
31758   '    S: string;',
31759   '  end;',
31760   '{$R+}',
31761   'procedure DoIt(var h: string);',
31762   'var',
31763   '  s: string;',
31764   '  i: longint;',
31765   '  c: char;',
31766   '  o: tobject;',
31767   'begin',
31768   '  c:=s[1];',
31769   '  s[i]:=s[i];',
31770   '  h[i]:=h[i];',
31771   '  c:=o.s[i];',
31772   '  o.s[i]:=c;',
31773   'end;',
31774   'begin',
31775   '']);
31776   ConvertProgram;
31777   CheckSource('TestRangeChecks_StringIndex',
31778     LinesToStr([ // statements
31779     'rtl.createClass($mod, "TObject", null, function () {',
31780     '  this.$init = function () {',
31781     '    this.S = "";',
31782     '  };',
31783     '  this.$final = function () {',
31784     '  };',
31785     '});',
31786     'this.DoIt = function (h) {',
31787     '  var s = "";',
31788     '  var i = 0;',
31789     '  var c = "";',
31790     '  var o = null;',
31791     '  c = rtl.rcc(rtl.rcCharAt(s, 0), 0, 65535);',
31792     '  s = rtl.rcSetCharAt(s, i - 1, rtl.rcCharAt(s, i - 1));',
31793     '  h.set(rtl.rcSetCharAt(h.get(), i - 1, rtl.rcCharAt(h.get(), i - 1)));',
31794     '  c = rtl.rcc(rtl.rcCharAt(o.S, i - 1), 0, 65535);',
31795     '  o.S = rtl.rcSetCharAt(o.S, i - 1, c);',
31796     '};',
31797     '']),
31798     LinesToStr([ // $mod.$main
31799     '']));
31800 end;
31801 
31802 procedure TTestModule.TestRangeChecks_TypecastInt;
31803 begin
31804   StartProgram(false);
31805   Add([
31806   '{$R+}',
31807   'var',
31808   '  i: nativeint;',
31809   '  b: byte;',
31810   '  sh: shortint;',
31811   '  w: word;',
31812   '  sm: smallint;',
31813   '  lw: longword;',
31814   '  li: longint;',
31815   'begin',
31816   '  b:=12+byte(i);',
31817   '  sh:=12+shortint(i);',
31818   '  w:=12+word(i);',
31819   '  sm:=12+smallint(i);',
31820   '  lw:=12+longword(i);',
31821   '  li:=12+longint(i);',
31822   '']);
31823   ConvertProgram;
31824   CheckSource('TestRangeChecks_TypecastInt',
31825     LinesToStr([
31826     'this.i = 0;',
31827     'this.b = 0;',
31828     'this.sh = 0;',
31829     'this.w = 0;',
31830     'this.sm = 0;',
31831     'this.lw = 0;',
31832     'this.li = 0;',
31833     '']),
31834     LinesToStr([
31835     '$mod.b = rtl.rc(12 + rtl.rc($mod.i, 0, 255), 0, 255);',
31836     '$mod.sh = rtl.rc(12 + rtl.rc($mod.i, -128, 127), -128, 127);',
31837     '$mod.w = rtl.rc(12 + rtl.rc($mod.i, 0, 65535), 0, 65535);',
31838     '$mod.sm = rtl.rc(12 + rtl.rc($mod.i, -32768, 32767), -32768, 32767);',
31839     '$mod.lw = rtl.rc(12 + rtl.rc($mod.i, 0, 4294967295), 0, 4294967295);',
31840     '$mod.li = rtl.rc(12 + rtl.rc($mod.i, -2147483648, 2147483647), -2147483648, 2147483647);',
31841     '']));
31842 end;
31843 
31844 procedure TTestModule.TestRangeChecks_TypeHelperInt;
31845 begin
31846   Scanner.Options:=Scanner.Options+[po_CAssignments];
31847   StartProgram(false);
31848   Add([
31849   '{$modeswitch typehelpers}',
31850   '{$R+}',
31851   'type',
31852   '  TObject = class',
31853   '    FSize: byte;',
31854   '    property Size: byte read FSize;',
31855   '  end;',
31856   '  THelper = type helper for byte',
31857   '    procedure SetIt(w: word);',
31858   '  end;',
31859   'procedure THelper.SetIt(w: word);',
31860   'begin',
31861   '  Self:=w;',
31862   'end;',
31863   'function GetIt: byte;',
31864   'begin',
31865   '  Result.SetIt(2);',
31866   'end;',
31867   'var',
31868   '  b: byte = 3;',
31869   '  o: TObject;',
31870   'begin',
31871   '  b.SetIt(14);',
31872   '  with b do SetIt(15);',
31873   '  o.Size.SetIt(16);',
31874   '']);
31875   ConvertProgram;
31876   CheckSource('TestRangeChecks_AssignInt',
31877     LinesToStr([ // statements
31878     'rtl.createClass($mod, "TObject", null, function () {',
31879     '  this.$init = function () {',
31880     '    this.FSize = 0;',
31881     '  };',
31882     '  this.$final = function () {',
31883     '  };',
31884     '});',
31885     'rtl.createHelper($mod, "THelper", null, function () {',
31886     '  this.SetIt = function (w) {',
31887     '    rtl.rc(w, 0, 65535);',
31888     '    this.set(w);',
31889     '  };',
31890     '});',
31891     'this.GetIt = function () {',
31892     '  var Result = 0;',
31893     '  $mod.THelper.SetIt.call({',
31894     '    get: function () {',
31895     '        return Result;',
31896     '      },',
31897     '    set: function (v) {',
31898     '        rtl.rc(v, 0, 255);',
31899     '        Result = v;',
31900     '      }',
31901     '  }, 2);',
31902     '  return Result;',
31903     '};',
31904     'this.b = 3;',
31905     'this.o = null;',
31906     '']),
31907     LinesToStr([ // $mod.$main
31908     '$mod.THelper.SetIt.call({',
31909     '  p: $mod,',
31910     '  get: function () {',
31911     '      return this.p.b;',
31912     '    },',
31913     '  set: function (v) {',
31914     '      rtl.rc(v, 0, 255);',
31915     '      this.p.b = v;',
31916     '    }',
31917     '}, 14);',
31918     'var $with = $mod.b;',
31919     '$mod.THelper.SetIt.call({',
31920     '  get: function () {',
31921     '      return $with;',
31922     '    },',
31923     '  set: function (v) {',
31924     '      rtl.rc(v, 0, 255);',
31925     '      $with = v;',
31926     '    }',
31927     '}, 15);',
31928     '$mod.THelper.SetIt.call({',
31929     '  p: $mod.o,',
31930     '  get: function () {',
31931     '      return this.p.FSize;',
31932     '    },',
31933     '  set: function (v) {',
31934     '      rtl.rc(v, 0, 255);',
31935     '      this.p.FSize = v;',
31936     '    }',
31937     '}, 16);',
31938     '']));
31939 end;
31940 
31941 procedure TTestModule.TestAsync_Proc;
31942 begin
31943   StartProgram(false);
31944   Add([
31945   'procedure Fly(w: word = 1); async; forward;',
31946   'procedure Run(w: word = 2); async;',
31947   'begin',
31948   '  Fly(w);',
31949   '  Fly;',
31950   '  await(Fly(w));',
31951   '  await(Fly);',
31952   'end;',
31953   'procedure Fly(w: word); ',
31954   'begin',
31955   'end;',
31956   'begin',
31957   '  Run;',
31958   '  Run(3);',
31959   '']);
31960   ConvertProgram;
31961   CheckSource('TestAsync_Proc',
31962     LinesToStr([ // statements
31963     'this.Run = async function (w) {',
31964     '  $mod.Fly(w);',
31965     '  $mod.Fly(1);',
31966     '  await $mod.Fly(w);',
31967     '  await $mod.Fly(1);',
31968     '};',
31969     'this.Fly = async function (w) {',
31970     '};',
31971     '']),
31972     LinesToStr([
31973     '$mod.Run(2);',
31974     '$mod.Run(3);',
31975     '']));
31976 end;
31977 
31978 procedure TTestModule.TestAsync_CallResultIsPromise;
31979 begin
31980   StartProgram(false);
31981   Add([
31982   '{$modeswitch externalclass}',
31983   'type',
31984   '  TObject = class',
31985   '  end;',
31986   '  TJSPromise = class external name ''Promise''',
31987   '  end;',
31988   '  TBird = class',
31989   '    function Fly: word; async; ',
31990   '  end;',
31991   'function TBird.Fly: word; async; ',
31992   'begin',
31993   '  Result:=3;',
31994   '  Fly:=4+Result;',
31995   '  if Result=5 then ;',
31996   '  exit(6);',
31997   'end;',
31998   'function Run: word; async;',
31999   'begin',
32000   '  Result:=11+Result;',
32001   '  inc(Result);',
32002   'end;',
32003   'var',
32004   '  p: TJSPromise;',
32005   '  o: TBird;',
32006   'begin',
32007   '  p:=Run;',
32008   '  p:=Run();',
32009   '  if Run=p then ;',
32010   '  if p=Run then ;',
32011   '  if Run()=p then ;',
32012   '  if p=Run() then ;',
32013   '  p:=o.Fly;',
32014   '  p:=o.Fly();',
32015   '  if o.Fly=p then ;',
32016   '  if o.Fly()=p then ;',
32017   '  with o do begin',
32018   '    p:=Fly;',
32019   '    p:=Fly();',
32020   '    if Fly=p then ;',
32021   '    if Fly()=p then ;',
32022   '  end;',
32023   '']);
32024   ConvertProgram;
32025   CheckSource('TestAsync_CallResultIsPromise',
32026     LinesToStr([ // statements
32027     'rtl.createClass($mod, "TObject", null, function () {',
32028     '  this.$init = function () {',
32029     '  };',
32030     '  this.$final = function () {',
32031     '  };',
32032     '});',
32033     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
32034     '  this.Fly = async function () {',
32035     '    var Result = 0;',
32036     '    Result = 3;',
32037     '    Result = 4 + Result;',
32038     '    if (Result === 5) ;',
32039     '    return 6;',
32040     '    return Result;',
32041     '  };',
32042     '});',
32043     'this.Run = async function () {',
32044     '  var Result = 0;',
32045     '  Result = 11 + Result;',
32046     '  Result += 1;',
32047     '  return Result;',
32048     '};',
32049     'this.p = null;',
32050     'this.o = null;',
32051     '']),
32052     LinesToStr([
32053     '$mod.p = $mod.Run();',
32054     '$mod.p = $mod.Run();',
32055     'if ($mod.Run() === $mod.p) ;',
32056     'if ($mod.p === $mod.Run()) ;',
32057     'if ($mod.Run() === $mod.p) ;',
32058     'if ($mod.p === $mod.Run()) ;',
32059     '$mod.p = $mod.o.Fly();',
32060     '$mod.p = $mod.o.Fly();',
32061     'if ($mod.o.Fly() === $mod.p) ;',
32062     'if ($mod.o.Fly() === $mod.p) ;',
32063     'var $with = $mod.o;',
32064     '$mod.p = $with.Fly();',
32065     '$mod.p = $with.Fly();',
32066     'if ($with.Fly() === $mod.p) ;',
32067     'if ($with.Fly() === $mod.p) ;',
32068     '']));
32069 end;
32070 
32071 procedure TTestModule.TestAsync_ConstructorFail;
32072 begin
32073   StartProgram(false);
32074   Add([
32075   'type',
32076   '  TObject = class',
32077   '  end;',
32078   '  TBird = class',
32079   '    constructor Create; async;',
32080   '  end;',
32081   'constructor TBird.Create; async;',
32082   'begin',
32083   'end;',
32084   'begin',
32085   '']);
32086   SetExpectedPasResolverError('Invalid constructor modifier async',nInvalidXModifierY);
32087   ConvertProgram;
32088 end;
32089 
32090 procedure TTestModule.TestAsync_PropertyGetterFail;
32091 begin
32092   StartProgram(false);
32093   Add([
32094   'type',
32095   '  TObject = class',
32096   '  end;',
32097   '  TBird = class',
32098   '    function GetSize: word; async;',
32099   '    property Size: word read GetSize;',
32100   '  end;',
32101   'function TBird.GetSize: word; async;',
32102   'begin',
32103   'end;',
32104   'begin',
32105   '']);
32106   SetExpectedPasResolverError('Invalid property getter modifier async',nInvalidXModifierY);
32107   ConvertProgram;
32108 end;
32109 
32110 procedure TTestModule.TestAwait_NonPromiseWithTypeFail;
32111 begin
32112   StartProgram(false);
32113   Add([
32114   'procedure Run; async;',
32115   'begin',
32116   '  await(word,1);',
32117   'end;',
32118   'begin',
32119   '']);
32120   SetExpectedPasResolverError('Incompatible type arg no. 2: Got "Longint", expected "TJSPromise"',nIncompatibleTypeArgNo);
32121   ConvertProgram;
32122 end;
32123 
32124 procedure TTestModule.TestAWait_OutsideAsyncFail;
32125 begin
32126   StartProgram(false);
32127   Add([
32128   'procedure Crawl(w: double); ',
32129   'begin',
32130   'end;',
32131   'procedure Run(w: double);',
32132   'begin',
32133   '  await(Crawl(w));',
32134   'end;',
32135   'begin',
32136   '  Run(1);']);
32137   SetExpectedPasResolverError(sAWaitOnlyInAsyncProcedure,nAWaitOnlyInAsyncProcedure);
32138   ConvertProgram;
32139 end;
32140 
32141 procedure TTestModule.TestAWait_Result;
32142 begin
32143   StartProgram(false);
32144   Add([
32145   '{$modeswitch externalclass}',
32146   'type',
32147   '  TJSPromise = class external name ''Promise''',
32148   '  end;',
32149   'function Crawl(d: double = 1.3): word; ',
32150   'begin',
32151   'end;',
32152   'function Run(d: double = 1.6): word; async;',
32153   'begin',
32154   '  Result:=await(1);',
32155   '  Result:=await(Crawl);',
32156   '  Result:=await(Crawl(4.5));',
32157   '  Result:=await(Run);',
32158   '  Result:=await(Run(6.7));',
32159   'end;',
32160   'begin',
32161   '  Run(1);']);
32162   ConvertProgram;
32163   CheckSource('TestAWait_Result',
32164     LinesToStr([ // statements
32165     'this.Crawl = function (d) {',
32166     '  var Result = 0;',
32167     '  return Result;',
32168     '};',
32169     'this.Run = async function (d) {',
32170     '  var Result = 0;',
32171     '  Result = await 1;',
32172     '  Result = await $mod.Crawl(1.3);',
32173     '  Result = await $mod.Crawl(4.5);',
32174     '  Result = await $mod.Run(1.6);',
32175     '  Result = await $mod.Run(6.7);',
32176     '  return Result;',
32177     '};',
32178     '']),
32179     LinesToStr([
32180     '$mod.Run(1);'
32181     ]));
32182 end;
32183 
32184 procedure TTestModule.TestAWait_ExternalClassPromise;
32185 begin
32186   StartProgram(false);
32187   Add([
32188   '{$modeswitch externalclass}',
32189   'type',
32190   '  TJSPromise = class external name ''Promise''',
32191   '  end;',
32192   'function Fly(w: word): TJSPromise; async;',
32193   'begin',
32194   'end;',
32195   'function Jump(w: word): word; async;',
32196   'begin',
32197   'end;',
32198   'function Run(d: double): word; async;',
32199   'var',
32200   '  p: TJSPromise;',
32201   'begin',
32202   '  Result:=await(word,p);', // promise needs type
32203   '  Result:=await(word,Fly(3));', // promise needs type
32204   '  Result:=await(Jump(4));', // async non promise must omit the type
32205   'end;',
32206   'begin',
32207   '']);
32208   ConvertProgram;
32209   CheckSource('TestAWait_ExternalClassPromise',
32210     LinesToStr([ // statements
32211     'this.Fly = async function (w) {',
32212     '  var Result = null;',
32213     '  return Result;',
32214     '};',
32215     'this.Jump = async function (w) {',
32216     '  var Result = 0;',
32217     '  return Result;',
32218     '};',
32219     'this.Run = async function (d) {',
32220     '  var Result = 0;',
32221     '  var p = null;',
32222     '  Result = await p;',
32223     '  Result = await $mod.Fly(3);',
32224     '  Result = await $mod.Jump(4);',
32225     '  return Result;',
32226     '};',
32227     '']),
32228     LinesToStr([
32229     ]));
32230 end;
32231 
32232 procedure TTestModule.TestAsync_AnonymousProc;
32233 begin
32234   StartProgram(false);
32235   Add([
32236   '{$modeswitch externalclass}',
32237   'type',
32238   '  TJSPromise = class external name ''Promise''',
32239   '  end;',
32240   '{$mode objfpc}',
32241   'type',
32242   '  TFunc = reference to function(x: double): word; async;',
32243   'function Crawl(d: double = 1.3): word; async;',
32244   'begin',
32245   'end;',
32246   'var Func: TFunc;',
32247   'begin',
32248   '  Func:=function(c:double):word async begin',
32249   '    Result:=await(Crawl(c));',
32250   '  end;',
32251   '  Func:=function(c:double):word async assembler asm',
32252   '  end;',
32253   '  ']);
32254   ConvertProgram;
32255   CheckSource('TestAsync_AnonymousProc',
32256     LinesToStr([ // statements
32257     'this.Crawl = async function (d) {',
32258     '  var Result = 0;',
32259     '  return Result;',
32260     '};',
32261     'this.Func = null;',
32262     '']),
32263     LinesToStr([
32264     '$mod.Func = async function (c) {',
32265     '  var Result = 0;',
32266     '  Result = await $mod.Crawl(c);',
32267     '  return Result;',
32268     '};',
32269     '$mod.Func = async function (c) {',
32270     '};',
32271     '']));
32272 end;
32273 
32274 procedure TTestModule.TestAsync_ProcType;
32275 begin
32276   StartProgram(false);
32277   Add([
32278   '{$mode objfpc}',
32279   'type',
32280   '  TRefFunc = reference to function(x: double = 1.3): word; async;',
32281   '  TFunc = function(x: double = 1.1): word; async;',
32282   '  TProc = procedure(x: longint = 7); async;',
32283   'function Crawl(d: double): word; async;',
32284   'begin',
32285   'end;',
32286   'procedure Run(e:longint); async;',
32287   'begin',
32288   'end;',
32289   'var',
32290   '  RefFunc: TRefFunc;',
32291   '  Func: TFunc;',
32292   '  Proc, ProcB: TProc;',
32293   'begin',
32294   '  Func:=@Crawl;',
32295   '  RefFunc:=@Crawl;',
32296   '  RefFunc:=function(c:double):word async begin',
32297   '    Result:=await(RefFunc);',
32298   '    Result:=await(RefFunc());',
32299   '    Result:=await(Func);',
32300   '    Result:=await(Func());',
32301   '    await(Proc);',
32302   '    await(Proc());',
32303   '    await(Proc(13));',
32304   '  end;',
32305   '  Proc:=@Run;',
32306   '  if Proc=ProcB then ;',
32307   '  ']);
32308   ConvertProgram;
32309   CheckSource('TestAsync_ProcType',
32310     LinesToStr([ // statements
32311     'this.Crawl = async function (d) {',
32312     '  var Result = 0;',
32313     '  return Result;',
32314     '};',
32315     'this.Run = async function (e) {',
32316     '};',
32317     'this.RefFunc = null;',
32318     'this.Func = null;',
32319     'this.Proc = null;',
32320     'this.ProcB = null;',
32321     '']),
32322     LinesToStr([
32323     '$mod.Func = $mod.Crawl;',
32324     '$mod.RefFunc = $mod.Crawl;',
32325     '$mod.RefFunc = async function (c) {',
32326     '  var Result = 0;',
32327     '  Result = await $mod.RefFunc(1.3);',
32328     '  Result = await $mod.RefFunc(1.3);',
32329     '  Result = await $mod.Func(1.1);',
32330     '  Result = await $mod.Func(1.1);',
32331     '  await $mod.Proc(7);',
32332     '  await $mod.Proc(7);',
32333     '  await $mod.Proc(13);',
32334     '  return Result;',
32335     '};',
32336     '$mod.Proc = $mod.Run;',
32337     'if (rtl.eqCallback($mod.Proc, $mod.ProcB)) ;',
32338     '']));
32339 end;
32340 
32341 procedure TTestModule.TestAsync_ProcTypeAsyncModMismatchFail;
32342 begin
32343   StartProgram(false);
32344   Add([
32345   '{$mode objfpc}',
32346   'type',
32347   '  TRefFunc = reference to function(x: double = 1.3): word;',
32348   'function Crawl(d: double): word; async;',
32349   'begin',
32350   'end;',
32351   'var',
32352   '  RefFunc: TRefFunc;',
32353   'begin',
32354   '  RefFunc:=@Crawl;',
32355   '  ']);
32356   SetExpectedPasResolverError('procedure type modifier "async" mismatch',nXModifierMismatchY);
32357   ConvertProgram;
32358 end;
32359 
32360 procedure TTestModule.TestAsync_Inherited;
32361 begin
32362   StartProgram(false);
32363   Add([
32364   '{$mode objfpc}',
32365   '{$modeswitch externalclass}',
32366   'type',
32367   '  TJSPromise = class external name ''Promise''',
32368   '  end;',
32369   '  TObject = class',
32370   '    function Run(w: word = 3): word; async; virtual;',
32371   '  end;',
32372   '  TBird = class',
32373   '    function Run(w: word = 3): word; async; override;',
32374   '  end;',
32375   'function TObject.Run(w: word = 3): word; async;',
32376   'begin',
32377   'end;',
32378   'function TBird.Run(w: word = 3): word; async;',
32379   'var p: TJSPromise;',
32380   'begin',
32381   '  p:=inherited;',
32382   '  p:=inherited Run;',
32383   '  p:=inherited Run();',
32384   '  p:=inherited Run(4);',
32385   '  exit(p);',
32386   '  exit(inherited);',
32387   '  exit(inherited Run);',
32388   '  exit(inherited Run(5));',
32389   '  exit(6);',
32390   'end;',
32391   'begin',
32392   '  ']);
32393   ConvertProgram;
32394   CheckSource('TestAsync_Inherited',
32395     LinesToStr([ // statements
32396     'rtl.createClass($mod, "TObject", null, function () {',
32397     '  this.$init = function () {',
32398     '  };',
32399     '  this.$final = function () {',
32400     '  };',
32401     '  this.Run = async function (w) {',
32402     '    var Result = 0;',
32403     '    return Result;',
32404     '  };',
32405     '});',
32406     'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
32407     '  this.Run = async function (w) {',
32408     '    var Result = 0;',
32409     '    var p = null;',
32410     '    p = $mod.TObject.Run.apply(this, arguments);',
32411     '    p = $mod.TObject.Run.call(this, 3);',
32412     '    p = $mod.TObject.Run.call(this, 3);',
32413     '    p = $mod.TObject.Run.call(this, 4);',
32414     '    return p;',
32415     '    return $mod.TObject.Run.apply(this, arguments);',
32416     '    return $mod.TObject.Run.call(this, 3);',
32417     '    return $mod.TObject.Run.call(this, 5);',
32418     '    return 6;',
32419     '    return Result;',
32420     '  };',
32421     '});',
32422     '']),
32423     LinesToStr([
32424     '']));
32425 end;
32426 
32427 
32428 Initialization
32429   RegisterTests([TTestModule]);
32430 end.
32431 
32432