Browse Source

* Patch from Mattias Gaertner:
- ability to omit declarations
- removed obsolete code
+ Test unit for optimizations

git-svn-id: trunk@35615 -

michael 8 years ago
parent
commit
b517ab7906

+ 1 - 0
.gitattributes

@@ -6663,6 +6663,7 @@ packages/pastojs/fpmake.pp svneol=native#text/plain
 packages/pastojs/src/fppas2js.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
+packages/pastojs/tests/tcoptimizations.pas svneol=native#text/plain
 packages/pastojs/tests/testpas2js.lpi svneol=native#text/plain
 packages/pastojs/tests/testpas2js.pp svneol=native#text/plain
 packages/pastojs/todo.txt svneol=native#text/plain

+ 140 - 432
packages/pastojs/src/fppas2js.pp

@@ -154,9 +154,10 @@ Works:
 
 ToDos:
 - function str, procedure str
+- try raise E1 except on E: E2 end;
 
 Not in Version 1.0:
-- writeln
+- write, writeln
 - arrays
   - static array: non 0 start index, length
   - array of static array: setlength
@@ -541,6 +542,8 @@ type
     );
   TPasToJsConverterOptions = set of TPasToJsConverterOption;
 
+  TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object;
+
   TPasToJsProcessor = (
     pECMAScript5,
     pECMAScript6
@@ -611,6 +614,7 @@ type
     FFuncNameSet_Reference: String;
     FFuncNameSet_SymDiffSet: String;
     FFuncNameSet_Union: String;
+    FOnIsElementUsed: TPas2JSIsElementUsedEvent;
     FOptions: TPasToJsConverterOptions;
     FTargetProcessor: TPasToJsProcessor;
     FVarNameImplementation: String;
@@ -619,7 +623,6 @@ type
     FVarNameRTL: String;
     FVarNameWith: String;
     Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent;
-    Function CreateConstDecl(El: TPasConst; AContext: TConvertContext): TJSElement;
     Function CreateDeclNameExpression(El: TPasElement; const Name: string;
       AContext: TConvertContext): TJSPrimaryExpressionIdent;
     function CreateElementData(DataClass: TPas2JsElementDataClass;
@@ -636,12 +639,6 @@ type
     procedure SetUseEnumNumbers(const AValue: boolean);
     procedure SetUseLowerCase(const AValue: boolean);
     procedure SetUseSwitchStatement(const AValue: boolean);
-    {$IFDEF EnableOldClass}
-    Function ConvertClassConstructor(El: TPasConstructor; AContext: TConvertContext): TJSElement; virtual;
-    Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: TJSString; inunary: boolean): TJSFunctionDeclarationStatement;
-    Function GetFunctionUnaryName(var je: TJSElement;out fundec: TJSFunctionDeclarationStatement): TJSString;
-    Procedure AddProcedureToClass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure);
-    {$ENDIF}
   protected
     // Error functions
     Procedure DoError(Id: int64; Const Msg : String);
@@ -656,21 +653,14 @@ type
     Function ComputeConst(Expr: TPasExpr; AContext: TConvertContext): TJSValue; virtual;
     Function TransFormStringLiteral(El: TPasElement; AContext: TConvertContext; const S: String): TJSString; virtual;
     // Name mangling
-    {$IFDEF EnableOldClass}
-    Function TransformIdent(El: TJSPrimaryExpressionIdent): TJSPrimaryExpressionIdent;virtual;
-    {$ENDIF}
     Function TransformVariableName(El: TPasElement; Const AName: String; AContext : TConvertContext): String; virtual;
     Function TransformVariableName(El: TPasElement; AContext : TConvertContext) : String; virtual;
     Function TransformModuleName(El: TPasModule; AContext : TConvertContext) : String; virtual;
     Function IsPreservedWord(aName: string): boolean; virtual;
     Function GetExceptionObjectName(AContext: TConvertContext) : string;
     // Never create an element manually, always use the below functions
+    Function IsElementUsed(El: TPasElement): boolean; virtual;
     Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual;
-    {$IFDEF EnableOldClass}
-    Function CreateCallStatement(const JSCallName: string; JSArgs: array of string): TJSCallExpression;
-    Function CreateCallStatement(const FunNameEx: TJSElement; JSArgs: array of string): TJSCallExpression;
-    Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement;
-    {$ENDIF}
     Function CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
       AContext : TConvertContext): TJSCallExpression; virtual;
     Function CreateFunction(El: TPasElement; WithBody: boolean = true): TJSFunctionDeclarationStatement;
@@ -688,7 +678,7 @@ type
     Function CreateUsesList(UsesSection: TPasSection; AContext : TConvertContext): TJSArrayLiteral;
     Procedure AddToStatementList(var First, Last: TJSStatementList;
       Add: TJSElement; Src: TPasElement);
-    Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;virtual;
+    Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
     Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
     Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
     Function CreateLiteralString(El: TPasElement; const s: string): TJSLiteral; virtual;
@@ -702,10 +692,10 @@ type
       El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
     Function CreateReferencePath(El: TPasElement; AContext : TConvertContext;
       Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
-    Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext; Full: boolean = false; Ref: TResolvedReference = nil): TJSPrimaryExpressionIdent;virtual;
+    Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext; Full: boolean = false; Ref: TResolvedReference = nil): TJSPrimaryExpressionIdent; virtual;
     Procedure CreateImplementationSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext);
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext);
-    Function CreateDotExpression(aParent: TPasElement; Left, Right: TJSElement): TJSElement;virtual;
+    Function CreateDotExpression(aParent: TPasElement; Left, Right: TJSElement): TJSElement; virtual;
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
     Function CreateCloneRecord(El: TPasElement; ResolvedEl: TPasResolverResult;
       RecordExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
@@ -714,68 +704,67 @@ type
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement; virtual;
-    Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement;virtual;
+    Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertAssignStatement(El: TPasImplAssign; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRaiseStatement(El: TPasImplRaise; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertIfStatement(El: TPasImplIfElse; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertWhileStatement(El: TPasImplWhileDo; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRepeatStatement(El: TPasImplRepeatUntil; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertForStatement(El: TPasImplForLoop; AContext: TConvertContext): TJSElement; virtual;
-    Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement;virtual;
+    Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertExceptOn(El: TPasImplExceptOn; AContext: TConvertContext): TJSElement;
     Function ConvertCaseOfStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
     Function ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement;
     // Expressions
-    Function ConvertArrayValues(El: TArrayValues; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertInheritedExpression(El: TInheritedExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertParamsExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInLength(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInSetLength(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInExcludeInclude(El: TParamsExpr; AContext: TConvertContext; IsInclude: boolean): TJSElement;virtual;
-    Function ConvertBuiltInContinue(El: TPasExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInBreak(El: TPasExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInExit(El: TPasExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInIncDec(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInAssigned(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInOrd(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInLow(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInHigh(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInPred(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBuiltInSucc(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertSubIdentExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertIdentifierExpr(El: TPrimitiveExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertUnaryExpression(El: TUnaryExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertCallExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement;virtual;
+    Function ConvertArrayValues(El: TArrayValues; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertInheritedExpression(El: TInheritedExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertParamsExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInLength(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInSetLength(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInExcludeInclude(El: TParamsExpr; AContext: TConvertContext; IsInclude: boolean): TJSElement; virtual;
+    Function ConvertBuiltInContinue(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInBreak(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInExit(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInIncDec(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInAssigned(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInOrd(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInLow(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInHigh(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInPred(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInSucc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSubIdentExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertIdentifierExpr(El: TPrimitiveExpr; AContext : TConvertContext): TJSElement; virtual;
+    Function ConvertUnaryExpression(El: TUnaryExpr; AContext: TConvertContext): TJSElement; virtual;
     // Convert declarations
     Function ConvertElement(El : TPasElement; AContext: TConvertContext) : TJSElement; virtual;
-    Function ConvertProperty(El: TPasProperty; AContext: TConvertContext ): TJSElement;virtual;
-    Function ConvertCommand(El: TPasImplCommand; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertCommands(El: TPasImplCommands; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertConst(El: TPasConst; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertDeclarations(El: TPasDeclarations; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertExportSymbol(El: TPasExportSymbol; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertExpression(El: TPasExpr; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext ): TJSElement;virtual;
-    Function ConvertLabelMark(El: TPasImplLabelMark; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertLabels(El: TPasLabels; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertModule(El: TPasModule; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertPackage(El: TPasPackage; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertProcedure(El: TPasProcedure; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertResString(El: TPasResString; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertVariable(El: TPasVariable; AContext: TConvertContext): TJSElement;virtual;
+    Function ConvertProperty(El: TPasProperty; AContext: TConvertContext ): TJSElement; virtual;
+    Function ConvertCommand(El: TPasImplCommand; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertCommands(El: TPasImplCommands; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertConst(El: TPasConst; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertDeclarations(El: TPasDeclarations; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExportSymbol(El: TPasExportSymbol; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExpression(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext ): TJSElement; virtual;
+    Function ConvertLabelMark(El: TPasImplLabelMark; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertLabels(El: TPasLabels; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertModule(El: TPasModule; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertPackage(El: TPasPackage; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertProcedure(El: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertResString(El: TPasResString; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertVariable(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRecordType(El: TPasRecordType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertEnumType(El: TPasEnumType; AContext: TConvertContext): TJSElement; virtual;
@@ -790,6 +779,7 @@ type
     Property UseLowerCase: boolean read GetUseLowerCase write SetUseLowerCase default true;
     Property UseSwitchStatement: boolean read GetUseSwitchStatement write SetUseSwitchStatement;// default false, because slower than "if" in many engines
     Property UseEnumNumbers: boolean read GetUseEnumNumbers write SetUseEnumNumbers; // default false
+    Property OnIsElementUsed: TPas2JSIsElementUsedEvent read FOnIsElementUsed write FOnIsElementUsed;
     // names
     Property FuncNameArray_NewMultiDim: String read FFuncNameArray_NewMultiDim write FFuncNameArray_NewMultiDim;
     Property FuncNameArray_SetLength: String read FFuncNameArray_SetLength write FFuncNameArray_SetLength;
@@ -1590,14 +1580,6 @@ begin
   Result:=U;
 end;
 
-function TPasToJSConverter.ConvertCallExpression(El: TParamsExpr;
-  AContext: TConvertContext): TJSElement;
-begin
-  if AContext=nil then ;
-  RaiseNotSupported(El,AContext,20161024191225,'ConvertCallExpression');
-  Result:=nil;
-end;
-
 function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;
   AContext: TConvertContext): TJSType;
 
@@ -1851,9 +1833,6 @@ Var
   ModeSwitches: TModeSwitches;
   NotEl: TJSUnaryNotExpression;
   CmpExpr: TJSBinaryExpression;
-  {$IFDEF EnableOldClass}
-  funname: string;
-  {$ENDIF}
 
 begin
   Result:=Nil;
@@ -2060,31 +2039,6 @@ begin
               DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
             end;
           end;
-        {$IFDEF EnableOldClass}
-        else if (A is TJSPrimaryExpressionIdent) and
-            (TJSPrimaryExpressionIdent(A).Name = '_super') then
-          begin
-          Result := B;
-          funname := String(TJSPrimaryExpressionIdent(TJSCallExpression(b).Expr).Name);
-          TJSCallExpression(b).Args.Elements.AddElement.Expr :=
-                                            CreateBuiltInIdentifierExpr('self');
-          if TJSCallExpression(b).Args.Elements.Count > 1 then
-            TJSCallExpression(b).Args.Elements.Exchange(
-              0, TJSCallExpression(b).Args.Elements.Count - 1);
-          if CompareText(funname, 'Create') = 0 then
-            begin
-            TJSCallExpression(B).Expr :=
-              TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
-            TJSDotMemberExpression(TJSCallExpression(b).Expr).MExpr := A;
-            TJSDotMemberExpression(TJSCallExpression(b).Expr).Name := TJSString(funname);
-            end
-          else
-            begin
-            TJSCallExpression(B).Expr :=
-              CreateMemberExpression(['_super', 'prototype', funname, 'call']);
-            end;
-          end
-        {$ENDIF}
         else
           if C=nil then
             DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
@@ -2146,17 +2100,6 @@ begin
   Result:=CreateDotExpression(El,Left,Right);
 end;
 
-{$IFDEF EnableOldClass}
-function TPasToJSConverter.TransformIdent(El: TJSPrimaryExpressionIdent
-  ): TJSPrimaryExpressionIdent;
-
-begin
-  if UseLowerCase then
-    El.Name:=TJSString(lowercase(El.Name));
-  Result:=El;
-end;
-{$ENDIF}
-
 function TPasToJSConverter.CreateIdentifierExpr(AName: string; El: TPasElement;
   AContext: TConvertContext): TJSPrimaryExpressionIdent;
 
@@ -2520,10 +2463,6 @@ var
   ParamsExpr: TParamsExpr;
 begin
   Result:=nil;
-  {$IFDEF EnableOldClass}
-  if AContext=nil then ;
-  Result := CreateIdentifierExpr('_super',El);
-  {$ELSE}
   if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).OpCode=eopNone)
       and (TBinaryExpr(El.Parent).left=El) then
     begin
@@ -2591,7 +2530,6 @@ begin
     AncestorProc:=Ref.Declaration as TPasProcedure;
     Result:=CreateAncestorCall(El,true,AncestorProc,nil);
     end;
-  {$ENDIF}
 end;
 
 function TPasToJSConverter.ConvertSelfExpression(El: TSelfExpr;
@@ -3861,55 +3799,6 @@ begin
     end;
 end;
 
-function TPasToJSConverter.CreateConstDecl(El: TPasConst;
-  AContext: TConvertContext): TJSElement;
-// Important: returns nil if const was added to higher context
-
-Var
-  AssignSt: TJSSimpleAssignStatement;
-  Obj: TJSObjectLiteral;
-  ObjLit: TJSObjectLiteralElement;
-  ConstContext: TFunctionContext;
-  C: TJSElement;
-  V: TJSVariableStatement;
-  Src: TJSSourceElements;
-begin
-  Result:=nil;
-  if not AContext.IsSingleton then
-    begin
-    // local const are stored in interface/implementation
-    ConstContext:=AContext.GetSingletonFunc;
-    if not (ConstContext.JSElement is TJSSourceElements) then
-      begin
-      {$IFDEF VerbosePas2JS}
-      writeln('TPasToJSConverter.CreateConstDecl ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
-      {$ENDIF}
-      RaiseNotSupported(El,AContext,20170220153216);
-      end;
-    Src:=TJSSourceElements(ConstContext.JSElement);
-    C:=ConvertVariable(El,AContext);
-    V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
-    V.A:=C;
-    AddToSourceElements(Src,V);
-    end
-  else if AContext is TObjectContext then
-    begin
-    // create 'A: initvalue'
-    Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
-    ObjLit:=Obj.Elements.AddElement;
-    ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
-    ObjLit.Expr:=CreateVarInit(El,AContext);
-    end
-  else
-    begin
-    // create 'this.A=initvalue'
-    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-    Result:=AssignSt;
-    AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
-    AssignSt.Expr:=CreateVarInit(El,AContext);
-    end;
-end;
-
 function TPasToJSConverter.CreateSwitchStatement(El: TPasImplCaseOf;
   AContext: TConvertContext): TJSElement;
 var
@@ -4063,11 +3952,13 @@ begin
 
   For I:=0 to El.Declarations.Count-1 do
     begin
-    E:=Nil;
     P:=TPasElement(El.Declarations[i]);
     //writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
+    if not IsElementUsed(P) then continue;
+
+    E:=Nil;
     if P.ClassType=TPasConst then
-      E:=CreateConstDecl(TPasConst(P),aContext) // can be nil
+      E:=ConvertConst(TPasConst(P),aContext) // can be nil
     else if P.ClassType=TPasVariable then
       E:=CreateVarDecl(TPasVariable(P),aContext) // can be nil
     else if P is TPasType then
@@ -4103,80 +3994,6 @@ begin
     AddFunctionResultReturn;
 end;
 
-{$IFDEF EnableOldClass}
-function TPasToJSConverter.ConvertClassType(El: TPasClassType;
-  AContext: TConvertContext): TJSElement;
-var
-  call: TJSCallExpression;
-  asi: TJSSimpleAssignStatement;
-  unary2: TJSUnary;
-  unary: TJSUnary;
-  je: TJSElement;
-  FD: TJSFuncDef;
-  cons: TJSFunctionDeclarationStatement;
-  FS: TJSFunctionDeclarationStatement;
-  aMember: TPasElement;
-  j: integer;
-  ret: TJSReturnStatement;
-  jsName: String;
-  FuncContext: TFunctionContext;
-  Src: TJSSourceElements;
-begin
-  //ctname := El.FullName;
-  jsName:=TransformVariableName(El,AContext);
-  unary := TJSUnary(CreateElement(TJSUnary,El));
-  asi := TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-  unary.A := asi;
-  asi.LHS := CreateIdentifierExpr(El.Name,El);
-  FS := TJSFunctionDeclarationStatement(
-    CreateElement(TJSFunctionDeclarationStatement, El));
-  call := CreateCallStatement(FS, []);
-  asi.Expr := call;
-  Result := unary;
-  FD := TJSFuncDef.Create;
-  FS.AFunction := FD;
-  FD.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El));
-  Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
-  FD.Body.A := Src;
-
-  FuncContext:=TFunctionContext.Create(El,Src,AContext);
-  try
-    if Assigned(El.AncestorType) then
-    begin
-      call.Args := TJSArguments(CreateElement(TJSArguments, El));
-      call.Args.Elements.AddElement.Expr := CreateIdentifierExpr(El.AncestorType.Name,El);
-      FD.Params.Add('_super');
-      unary2 := TJSUnary(CreateElement(TJSUnary, El));
-      call := CreateCallStatement('__extends', [jsName, '_super']);
-      unary2.A := call;
-      TJSSourceElements(FD.Body.A).Statements.AddNode.Node := unary2;
-    end;
-    //create default constructor
-    cons := CreateProcedureDeclaration(El);
-    TJSSourceElements(FD.Body.A).Statements.AddNode.Node := cons;
-    cons.AFunction.Name := TJSString(jsName);
-
-    //convert class members
-    for j := 0 to El.Members.Count - 1 do
-    begin
-      aMember := TPasElement(El.Members[j]);
-      //memname := aMember.FullName;
-      je := ConvertClassMember(aMember, FuncContext);
-      if Assigned(je) then
-        TJSSourceElements(FD.Body.A).Statements.AddNode.Node := je;
-    end;
-  finally
-    FuncContext.Free;
-  end;
-
-  //add return statement
-  ret := TJSReturnStatement(CreateElement(TJSReturnStatement, El));
-  TJSSourceElements(FD.Body.A).Statements.AddNode.Node := ret;
-  ret.Expr := CreateIdentifierExpr(El.Name,El);
-  Result := unary;
-end;
-{$ENDIF}
-
 function TPasToJSConverter.ConvertClassType(El: TPasClassType;
   AContext: TConvertContext): TJSElement;
 (*
@@ -4197,6 +4014,23 @@ const
     '$init',
     '$final'
     );
+var
+  IsTObject: boolean;
+
+  function IsMemberNeeded(aMember: TPasElement): boolean;
+  begin
+    if IsElementUsed(aMember) then exit(true);
+    if IsTObject then
+      begin
+      if aMember is TPasProcedure then
+        begin
+        if (CompareText(aMember.Name,'AfterConstruction')=0)
+            or (CompareText(aMember.Name,'BeforeDestruction')=0) then
+          exit(true);
+        end;
+      end;
+    Result:=false;
+  end;
 
   procedure RaiseVarModifierNotSupported(V: TPasVariable);
   var
@@ -4259,6 +4093,7 @@ const
       For I:=0 to El.Members.Count-1 do
         begin
         P:=TPasElement(El.Members[i]);
+        if not IsMemberNeeded(P) then continue;
         NewEl:=nil;
         if (P.ClassType=TPasVariable)
             and (ClassVarModifiersType*TPasVariable(P).VarModifiers=[]) then
@@ -4334,6 +4169,8 @@ begin
   else
     Scope:=nil;
 
+  IsTObject:=CompareText(El.Name,'TObject')=0;
+
   // create call 'rtl.createClass('
   Call:=CreateCallExpression(El);
   try
@@ -4377,6 +4214,7 @@ begin
         begin
         P:=TPasElement(El.Members[i]);
         //writeln('TPasToJSConverter.ConvertClassType class El[',i,']=',GetObjName(P));
+        if not IsMemberNeeded(P) then continue;
         if P.ClassType=TPasVariable then
           begin
           if TPasVariable(P).VarModifiers-VarModifiersAllowed<>[] then
@@ -4390,7 +4228,7 @@ begin
             continue;
           end
         else if P.ClassType=TPasConst then
-          NewEl:=CreateConstDecl(TPasConst(P),aContext)
+          NewEl:=ConvertConst(TPasConst(P),aContext)
         else if P.ClassType=TPasProperty then
           begin
           NewEl:=ConvertProperty(TPasProperty(P),AContext);
@@ -4417,6 +4255,7 @@ begin
         begin
         P:=TPasElement(El.Members[i]);
         //writeln('TPasToJSConverter.ConvertClassType class El[',i,']=',GetObjName(P));
+        if not IsMemberNeeded(P) then continue;
         if P is TPasProcedure then
           NewEl:=ConvertProcedure(TPasProcedure(P),aContext)
         else
@@ -4505,40 +4344,6 @@ begin
   end;
 end;
 
-{$IFDEF EnableOldClass}
-function TPasToJSConverter.ConvertClassConstructor(El: TPasConstructor;
-  AContext: TConvertContext): TJSElement;
-var
-  FS: TJSFunctionDeclarationStatement;
-  n: integer;
-  Fun1SourceEl: TJSSourceElements;
-  ret: TJSReturnStatement;
-  nmem: TJSNewMemberExpression;
-  Arg: TPasArgument;
-begin
-  if AContext=nil then ;
-  FS := CreateProcedureDeclaration(El);
-  FS.AFunction.Name := TJSString(El.Name);
-  Fs.AFunction.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El.Body));
-  Fun1SourceEl := TJSSourceElements.Create(0, 0, '');
-  fs.AFunction.Body.A := Fun1SourceEl;
-  ret := TJSReturnStatement.Create(0, 0, '');
-  Fun1SourceEl.Statements.AddNode.Node := ret;
-  nmem := TJSNewMemberExpression.Create(0, 0, '');
-  ret.Expr := nmem;
-  nmem.MExpr := CreateIdentifierExpr(El.Parent.FullName,El.Parent,AContext);
-  for n := 0 to El.ProcType.Args.Count - 1 do
-    begin
-    if n = 0 then
-      nmem.Args := TJSArguments.Create(0, 0, '');
-    fs.AFunction.Params.Add(TPasArgument(El.ProcType.Args[n]).Name);
-    Arg := TPasArgument(El.ProcType.Args[n]);
-    nmem.Args.Elements.AddElement.Expr := CreateIdentifierExpr(Arg.Name,Arg,AContext);
-    end;
-  Result := CreateUnary([El.Parent.FullName, TPasProcedure(El).Name], FS);
-end;
-{$ENDIF}
-
 procedure TPasToJSConverter.ForLoop_OnProcBodyElement(El: TPasElement;
   arg: pointer);
 // Called by ConvertForStatement on each element of the current proc body
@@ -5969,45 +5774,18 @@ begin
     Result:=lowercase(Result);
 end;
 
-procedure TPasToJSConverter.RaiseInconsistency(Id: int64);
-begin
-  raise Exception.Create('TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug');
-end;
-
-{$IFDEF EnableOldClass}
-function TPasToJSConverter.CreateCallStatement(const JSCallName: string;
-  JSArgs: array of string): TJSCallExpression;
-var
-  Call: TJSCallExpression;
-  Ident: TJSPrimaryExpressionIdent;
+function TPasToJSConverter.IsElementUsed(El: TPasElement): boolean;
 begin
-  Ident := TJSPrimaryExpressionIdent.Create(0, 0, '');
-  Ident.Name := TJSString(JSCallName);
-  Call := CreateCallStatement(Ident, JSArgs);
-  Result := Call;
+  if Assigned(OnIsElementUsed) then
+    Result:=OnIsElementUsed(Self,El)
+  else
+    Result:=true;
 end;
 
-function TPasToJSConverter.CreateCallStatement(const FunNameEx: TJSElement;
-  JSArgs: array of string): TJSCallExpression;
-var
-  p: string;
-  ArgEx: TJSPrimaryExpressionIdent;
-  Call: TJSCallExpression;
-  ArgArray: TJSArguments;
+procedure TPasToJSConverter.RaiseInconsistency(Id: int64);
 begin
-  Call := TJSCallExpression.Create(0, 0, '');
-  Call.Expr := FunNameEx;
-  ArgArray := TJSArguments.Create(0, 0, '');
-  Call.Args := ArgArray;
-  for p in JSArgs do
-  begin
-    ArgEx := TJSPrimaryExpressionIdent.Create(0, 0, '');
-    ArgEx.Name := TJSString(p);
-    ArgArray.Elements.AddElement.Expr := ArgEx;
-  end;
-  Result := Call;
+  raise Exception.Create('TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug');
 end;
-{$ENDIF}
 
 function TPasToJSConverter.CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
 var
@@ -6054,106 +5832,6 @@ begin
   Result.Args:=TJSArguments(CreateElement(TJSArguments,El));
 end;
 
-{$IFDEF EnableOldClass}
-procedure TPasToJSConverter.AddProcedureToClass(sl: TJSStatementList;
-  E: TJSElement; const P: TPasProcedure);
-var
-  clname, funname: string;
-  classfound: boolean;
-  fundec, fd, main_const: TJSFunctionDeclarationStatement;
-  SL2: TJSStatementList;
-  un1: TJSUnary;
-  asi: TJSAssignStatement;
-  varname: TJSString;
-begin
-  SL2 := TJSStatementList(sl);
-  clname := Copy(p.Name, 1, Pos('.', P.Name) - 1);
-  funname := Copy(p.Name, Pos('.', P.Name) + 1, Length(p.Name) - Pos('.', P.Name));
-  classfound := False;
-  while Assigned(SL2) and (not classfound) do
-  begin
-    if SL2.A is TJSUnary then
-    begin
-      un1 := TJSUnary(SL2.A);
-      asi := TJSAssignStatement(un1.A);
-      varname := TJSPrimaryExpressionIdent(asi.LHS).Name;
-      if varname = TJSString(clname) then
-      begin
-        classfound := True;
-        fd := TJSFunctionDeclarationStatement(TJSCallExpression(asi.Expr).Expr);
-      end;
-    end;
-    SL2 := TJSStatementList(SL2.B);
-  end;
-
-  if not (classfound) then
-    Exit;
-
-  fundec := GetFunctionDefinitionInUnary(fd, TJSString(funname), True);
-  if Assigned(fundec) then
-  begin
-    if (p is TPasConstructor) then
-    begin
-      main_const := GetFunctionDefinitionInUnary(fd, TJSString(clname), False);
-      main_const.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
-      main_const.AFunction.Name := TJSString(clname);
-    end
-    else
-    begin
-      fundec.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
-      fundec.AFunction.Name := '';
-    end;
-  end;
-end;
-
-function TPasToJSConverter.GetFunctionDefinitionInUnary(
-  const fd: TJSFunctionDeclarationStatement; const funname: TJSString;
-  inunary: boolean): TJSFunctionDeclarationStatement;
-var
-  k: integer;
-  fundec: TJSFunctionDeclarationStatement;
-  je: TJSElement;
-  cname: TJSString;
-begin
-  Result := nil;
-  for k := 0 to TJSSourceElements(FD.AFunction.Body.A).Statements.Count - 1 do
-  begin
-    je := TJSSourceElements(FD.AFunction.Body.A).Statements.Nodes[k].Node;
-    if inunary then
-      cname := GetFunctionUnaryName(je, fundec)
-    else
-    begin
-      if je is TJSFunctionDeclarationStatement then
-      begin
-        cname := TJSFunctionDeclarationStatement(je).AFunction.Name;
-        fundec := TJSFunctionDeclarationStatement(je);
-      end;
-    end;
-    if funname = cname then
-      Result := fundec;
-  end;
-end;
-
-function TPasToJSConverter.GetFunctionUnaryName(var je: TJSElement;
-  out fundec: TJSFunctionDeclarationStatement): TJSString;
-var
-  cname: TJSString;
-  asi: TJSAssignStatement;
-  un1: TJSUnary;
-begin
-  fundec:=nil;
-  if not (je is TJSUnary) then
-    Exit;
-  un1 := TJSUnary(je);
-  asi := TJSAssignStatement(un1.A);
-  if not (asi.Expr is TJSFunctionDeclarationStatement) then
-    Exit;
-  fundec := TJSFunctionDeclarationStatement(asi.Expr);
-  cname := TJSDotMemberExpression(asi.LHS).Name;
-  Result := cname;
-end;
-{$ENDIF}
-
 function TPasToJSConverter.CreateUsesList(UsesSection: TPasSection;
   AContext: TConvertContext): TJSArrayLiteral;
 var
@@ -6171,6 +5849,7 @@ begin
       begin
       El:=TPasElement(UsesList[k]);
       if not (El is TPasModule) then continue;
+      if not IsElementUsed(El) then continue;
       anUnitName := TransformVariableName(TPasModule(El),AContext);
       ArgEx := CreateLiteralString(UsesSection,anUnitName);
       ArgArray.Elements.AddElement.Expr := ArgEx;
@@ -6682,22 +6361,6 @@ begin
   Result:=CreateBuiltInIdentifierExpr(Name);
 end;
 
-{$IFDEF EnableOldClass}
-function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement
-  ): TJSFunctionDeclarationStatement;
-var
-  FD: TJSFuncDef;
-  FS: TJSFunctionDeclarationStatement;
-begin
-  FS := TJSFunctionDeclarationStatement(
-    CreateElement(TJSFunctionDeclarationStatement, EL));
-  Result := FS;
-  FD := TJSFuncDef.Create;
-  FS.AFunction := FD;
-  Result := FS;
-end;
-{$ENDIF}
-
 procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
   Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext);
 // create a call, adding call by reference and default values
@@ -7179,9 +6842,51 @@ end;
 
 function TPasToJSConverter.ConvertConst(El: TPasConst; AContext: TConvertContext
   ): TJSElement;
+// Important: returns nil if const was added to higher context
+
+Var
+  AssignSt: TJSSimpleAssignStatement;
+  Obj: TJSObjectLiteral;
+  ObjLit: TJSObjectLiteralElement;
+  ConstContext: TFunctionContext;
+  C: TJSElement;
+  V: TJSVariableStatement;
+  Src: TJSSourceElements;
 begin
   Result:=nil;
-  RaiseNotSupported(El,AContext,20161024193129);
+  if not AContext.IsSingleton then
+    begin
+    // local const are stored in interface/implementation
+    ConstContext:=AContext.GetSingletonFunc;
+    if not (ConstContext.JSElement is TJSSourceElements) then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateConstDecl ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
+      {$ENDIF}
+      RaiseNotSupported(El,AContext,20170220153216);
+      end;
+    Src:=TJSSourceElements(ConstContext.JSElement);
+    C:=ConvertVariable(El,AContext);
+    V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
+    V.A:=C;
+    AddToSourceElements(Src,V);
+    end
+  else if AContext is TObjectContext then
+    begin
+    // create 'A: initvalue'
+    Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
+    ObjLit.Expr:=CreateVarInit(El,AContext);
+    end
+  else
+    begin
+    // create 'this.A=initvalue'
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    Result:=AssignSt;
+    AssignSt.LHS:=CreateDeclNameExpression(El,El.Name,AContext);
+    AssignSt.Expr:=CreateVarInit(El,AContext);
+    end;
 end;
 
 function TPasToJSConverter.ConvertLabelMark(El: TPasImplLabelMark;
@@ -7297,6 +7002,7 @@ const
     for i:=0 to El.Members.Count-1 do
       begin
       PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
       // create 'this.A = s.A;'
       VarAssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PasVar));
       AddToStatementList(First,Last,VarAssignSt,PasVar);
@@ -7339,6 +7045,7 @@ const
     for i:=0 to El.Members.Count-1 do
       begin
       PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
       JSVar:=CreateVarDecl(PasVar,FuncContext);
       AddToStatementList(First,Last,JSVar,PasVar);
       if IfSt.BFalse=nil then
@@ -7408,6 +7115,7 @@ const
     for i:=0 to El.Members.Count-1 do
       begin
       PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
       // "this.member = b.member;"
       VarType:=PasVar.VarType;
       if FuncContext.Resolver<>nil then

+ 53 - 46
packages/pastojs/tests/tcmodules.pas

@@ -62,9 +62,9 @@ type
     property Module: TPasModule read FModule write SetModule;
   end;
 
-  { TTestModule }
+  { TCustomTestModule }
 
-  TTestModule = Class(TTestCase)
+  TCustomTestModule = Class(TTestCase)
   private
     FConverter: TPasToJSConverter;
     FEngine: TTestEnginePasResolver;
@@ -90,28 +90,28 @@ type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
-    Procedure Add(Line: string);
-    Procedure StartParsing;
-    procedure ParseModule;
-    procedure ParseProgram;
-    procedure ParseUnit;
+    Procedure Add(Line: string); virtual;
+    Procedure StartParsing; virtual;
+    procedure ParseModule; virtual;
+    procedure ParseProgram; virtual;
+    procedure ParseUnit; virtual;
   protected
-    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
-    function AddModule(aFilename: string): TTestEnginePasResolver;
-    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
+    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
+    function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
+    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
     function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
-      ImplementationSrc: string): TTestEnginePasResolver;
-    procedure AddSystemUnit;
-    procedure StartProgram(NeedSystemUnit: boolean);
-    procedure StartUnit(NeedSystemUnit: boolean);
-    Procedure ConvertModule;
-    Procedure ConvertProgram;
-    Procedure ConvertUnit;
+      ImplementationSrc: string): TTestEnginePasResolver; virtual;
+    procedure AddSystemUnit; virtual;
+    procedure StartProgram(NeedSystemUnit: boolean); virtual;
+    procedure StartUnit(NeedSystemUnit: boolean); virtual;
+    Procedure ConvertModule; virtual;
+    Procedure ConvertProgram; virtual;
+    Procedure ConvertUnit; virtual;
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
     function GetDottedIdentifier(El: TJSElement): string;
-    procedure CheckSource(Msg,Statements, InitStatements: string);
-    procedure CheckDiff(Msg, Expected, Actual: string);
-    procedure WriteSource(aFilename: string; Row: integer = 0; Col: integer = 0);
+    procedure CheckSource(Msg,Statements, InitStatements: string); virtual;
+    procedure CheckDiff(Msg, Expected, Actual: string); virtual;
+    procedure WriteSource(aFilename: string; Row: integer = 0; Col: integer = 0); virtual;
     property PasProgram: TPasProgram Read FPasProgram;
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
@@ -132,6 +132,11 @@ type
     property FileResolver: TStreamResolver read FFileResolver;
     property Scanner: TPascalScanner read FScanner;
     property Parser: TTestPasParser read FParser;
+  end;
+
+  { TTestModule }
+
+  TTestModule = class(TCustomTestModule)
   Published
     // modules
     Procedure TestEmptyProgram;
@@ -392,20 +397,20 @@ begin
     Result:=OnFindUnit(AName);
 end;
 
-{ TTestModule }
+{ TCustomTestModule }
 
-function TTestModule.GetModuleCount: integer;
+function TCustomTestModule.GetModuleCount: integer;
 begin
   Result:=FModules.Count;
 end;
 
-function TTestModule.GetModules(Index: integer
+function TCustomTestModule.GetModules(Index: integer
   ): TTestEnginePasResolver;
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
 end;
 
-function TTestModule.OnPasResolverFindUnit(const aUnitName: String
+function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
   ): TPasModule;
 var
   i: Integer;
@@ -460,7 +465,7 @@ begin
   raise Exception.Create('can''t find unit "'+aUnitName+'"');
 end;
 
-procedure TTestModule.SetUp;
+procedure TCustomTestModule.SetUp;
 begin
   inherited SetUp;
   FSource:=TStringList.Create;
@@ -478,7 +483,7 @@ begin
   FConverter.UseLowerCase:=false;
 end;
 
-procedure TTestModule.TearDown;
+procedure TCustomTestModule.TearDown;
 begin
   FJSModule:=nil;
   FJSRegModuleCall:=nil;
@@ -508,12 +513,12 @@ begin
   inherited TearDown;
 end;
 
-procedure TTestModule.Add(Line: string);
+procedure TCustomTestModule.Add(Line: string);
 begin
   Source.Add(Line);
 end;
 
-procedure TTestModule.StartParsing;
+procedure TCustomTestModule.StartParsing;
 begin
   FileResolver.AddStream(FileName,TStringStream.Create(Source.Text));
   Scanner.OpenFile(FileName);
@@ -521,7 +526,7 @@ begin
   Writeln(Source.Text);
 end;
 
-procedure TTestModule.ParseModule;
+procedure TCustomTestModule.ParseModule;
 var
   Row, Col: integer;
 begin
@@ -559,7 +564,7 @@ begin
   TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
 end;
 
-procedure TTestModule.ParseProgram;
+procedure TCustomTestModule.ParseProgram;
 begin
   ParseModule;
   AssertEquals('Has program',TPasProgram,Module.ClassType);
@@ -571,7 +576,7 @@ begin
       FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
 end;
 
-procedure TTestModule.ParseUnit;
+procedure TCustomTestModule.ParseUnit;
 begin
   ParseModule;
   AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
@@ -583,7 +588,7 @@ begin
     FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
 end;
 
-function TTestModule.FindModuleWithFilename(aFilename: string
+function TCustomTestModule.FindModuleWithFilename(aFilename: string
   ): TTestEnginePasResolver;
 var
   i: Integer;
@@ -594,7 +599,7 @@ begin
   Result:=nil;
 end;
 
-function TTestModule.AddModule(aFilename: string
+function TCustomTestModule.AddModule(aFilename: string
   ): TTestEnginePasResolver;
 begin
   //writeln('TTestModuleConverter.AddModule ',aFilename);
@@ -607,14 +612,14 @@ begin
   FModules.Add(Result);
 end;
 
-function TTestModule.AddModuleWithSrc(aFilename, Src: string
+function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
   ): TTestEnginePasResolver;
 begin
   Result:=AddModule(aFilename);
   Result.Source:=Src;
 end;
 
-function TTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
   ImplementationSrc: string): TTestEnginePasResolver;
 var
   Src: String;
@@ -631,7 +636,7 @@ begin
   Result:=AddModuleWithSrc(aFilename,Src);
 end;
 
-procedure TTestModule.AddSystemUnit;
+procedure TCustomTestModule.AddSystemUnit;
 begin
   AddModuleWithIntfImplSrc('system.pp',
     // interface
@@ -647,7 +652,7 @@ begin
     ]));
 end;
 
-procedure TTestModule.StartProgram(NeedSystemUnit: boolean);
+procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
 begin
   if NeedSystemUnit then
     AddSystemUnit
@@ -657,7 +662,7 @@ begin
   Add('');
 end;
 
-procedure TTestModule.StartUnit(NeedSystemUnit: boolean);
+procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
 begin
   if NeedSystemUnit then
     AddSystemUnit
@@ -667,7 +672,7 @@ begin
   Add('');
 end;
 
-procedure TTestModule.ConvertModule;
+procedure TCustomTestModule.ConvertModule;
 var
   ModuleNameExpr: TJSLiteral;
   FunDecl, InitFunction: TJSFunctionDeclarationStatement;
@@ -788,21 +793,21 @@ begin
     end;
 end;
 
-procedure TTestModule.ConvertProgram;
+procedure TCustomTestModule.ConvertProgram;
 begin
   Add('end.');
   ParseProgram;
   ConvertModule;
 end;
 
-procedure TTestModule.ConvertUnit;
+procedure TCustomTestModule.ConvertUnit;
 begin
   Add('end.');
   ParseUnit;
   ConvertModule;
 end;
 
-procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
+procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
   DottedName: string);
 begin
   if DottedName='' then
@@ -816,7 +821,7 @@ begin
     end;
 end;
 
-function TTestModule.GetDottedIdentifier(El: TJSElement): string;
+function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
 begin
   if El=nil then
     Result:=''
@@ -828,7 +833,7 @@ begin
     AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
 end;
 
-procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
+procedure TCustomTestModule.CheckSource(Msg, Statements, InitStatements: string);
 var
   ActualSrc, ExpectedSrc, InitName: String;
 begin
@@ -847,7 +852,7 @@ begin
   CheckDiff(Msg,ExpectedSrc,ActualSrc);
 end;
 
-procedure TTestModule.CheckDiff(Msg, Expected, Actual: string);
+procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
 // search diff, ignore changes in spaces
 const
   SpaceChars = [#9,#10,#13,' '];
@@ -951,7 +956,7 @@ begin
   until false;
 end;
 
-procedure TTestModule.WriteSource(aFilename: string; Row: integer; Col: integer
+procedure TCustomTestModule.WriteSource(aFilename: string; Row: integer; Col: integer
   );
 var
   LR: TLineReader;
@@ -979,6 +984,8 @@ begin
     end;
 end;
 
+{ TTestModule }
+
 procedure TTestModule.TestEmptyProgram;
 begin
   StartProgram(false);

+ 738 - 0
packages/pastojs/tests/tcoptimizations.pas

@@ -0,0 +1,738 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2017 by Michael Van Canneyt
+
+    Unit tests for Pascal-to-Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+ Examples:
+   ./testpas2js --suite=TTestOptimizations
+   ./testpas2js --suite=TTestOptimizations.TestOmitLocalVar
+}
+unit tcoptimizations;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fppas2js, pastree,
+  PScanner, PasUseAnalyzer, PasResolver,
+  tcmodules;
+
+type
+
+
+  { TCustomTestOptimizations }
+
+  TCustomTestOptimizations = class(TCustomTestModule)
+  private
+    FAnalyzerModule: TPasAnalyzer;
+    FAnalyzerProgram: TPasAnalyzer;
+    FWholeProgramOptimization: boolean;
+    function OnConverterIsElementUsed(Sender: TObject; El: TPasElement
+      ): boolean;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure ParseModule; override;
+    procedure ParseProgram; override;
+  public
+    property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
+    property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
+    property WholeProgramOptimization: boolean read FWholeProgramOptimization
+        write FWholeProgramOptimization;
+  end;
+
+  { TTestOptimizations }
+
+  TTestOptimizations = class(TCustomTestOptimizations)
+  published
+    // Whole Program Optimization
+    procedure TestWPO_OmitLocalVar;
+    procedure TestWPO_OmitLocalProc;
+    procedure TestWPO_OmitLocalProcForward;
+    procedure TestWPO_OmitProcLocalVar;
+    procedure TestWPO_OmitProcLocalConst;
+    procedure TestWPO_OmitProcLocalType;
+    procedure TestWPO_OmitProcLocalProc;
+    procedure TestWPO_OmitProcLocalForwardProc;
+    procedure TestWPO_OmitRecordMember;
+    procedure TestWPO_OmitNotUsedTObject;
+    procedure TestWPO_TObject;
+    procedure TestWPO_OmitClassField;
+    procedure TestWPO_OmitClassMethod;
+    procedure TestWPO_OmitClassClassMethod;
+    procedure TestWPO_OmitPropertyGetter1;
+    procedure TestWPO_OmitPropertyGetter2;
+    procedure TestWPO_OmitPropertySetter1;
+    procedure TestWPO_OmitPropertySetter2;
+    procedure TestWPO_CallInherited;
+    procedure TestWPO_UseUnit;
+  end;
+
+implementation
+
+{ TCustomTestOptimizations }
+
+function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
+  El: TPasElement): boolean;
+var
+  A: TPasAnalyzer;
+begin
+  if WholeProgramOptimization then
+    A:=AnalyzerProgram
+  else
+    A:=AnalyzerModule;
+  Result:=A.IsUsed(El);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.OnConverterIsElementUsed El=',GetObjName(El),' WPO=',WholeProgramOptimization,' Result=',Result);
+  {$ENDIF}
+end;
+
+procedure TCustomTestOptimizations.SetUp;
+begin
+  inherited SetUp;
+  FWholeProgramOptimization:=false;
+  FAnalyzerModule:=TPasAnalyzer.Create;
+  FAnalyzerModule.Resolver:=Engine;
+  FAnalyzerProgram:=TPasAnalyzer.Create;
+  FAnalyzerProgram.Resolver:=Engine;
+  Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
+end;
+
+procedure TCustomTestOptimizations.TearDown;
+begin
+  FreeAndNil(FAnalyzerProgram);
+  FreeAndNil(FAnalyzerModule);
+  inherited TearDown;
+end;
+
+procedure TCustomTestOptimizations.ParseModule;
+begin
+  inherited ParseModule;
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseModule START');
+  {$ENDIF}
+  AnalyzerModule.AnalyzeModule(Module);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseModule END');
+  {$ENDIF}
+end;
+
+procedure TCustomTestOptimizations.ParseProgram;
+begin
+  WholeProgramOptimization:=true;
+  inherited ParseProgram;
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseProgram START');
+  {$ENDIF}
+  AnalyzerProgram.AnalyzeWholeProgram(Module as TPasProgram);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseProgram START');
+  {$ENDIF}
+end;
+
+{ TTestOptimizations }
+
+procedure TTestOptimizations.TestWPO_OmitLocalVar;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: longint;');
+  Add('  b: longint;');
+  Add('begin');
+  Add('  b:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalVar',
+    'this.b = 0;',
+    'this.b = 3;');
+end;
+
+procedure TTestOptimizations.TestWPO_OmitLocalProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; begin end;');
+  Add('procedure NoIt; begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitLocalProcForward;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; forward;');
+  Add('procedure NoIt; forward;');
+  Add('procedure DoIt; begin end;');
+  Add('procedure NoIt; begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalProcForward',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalVar;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('var');
+  Add('  a: longint;');
+  Add('  b: longint;');
+  Add('begin');
+  Add('  b:=3;');
+  Add('  Result:=b;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalVar',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  var b = 0;',
+    '  b = 3;',
+    '  Result = b;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalConst;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('const');
+  Add('  a = 3;');
+  Add('  b = 4;');
+  Add('  c: longint = 5;');
+  Add('  d: longint = 6;');
+  Add('begin');
+  Add('  Result:=b+d;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalConst',
+    LinesToStr([
+    'var b = 4;',
+    'var d = 6;',
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  Result = b + d;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalType;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('type');
+  Add('  TEnum = (red, green);');
+  Add('  TEnums = set of TEnum;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalType',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  Result = 3;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('  procedure SubProcA; begin end;');
+  Add('  procedure SubProcB; begin end;');
+  Add('begin');
+  Add('  SubProcB;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  function SubProcB() {',
+    '  };',
+    '  SubProcB();',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('  procedure SubProcA; forward;');
+  Add('  procedure SubProcB; forward;');
+  Add('  procedure SubProcA; begin end;');
+  Add('  procedure SubProcB; begin end;');
+  Add('begin');
+  Add('  SubProcB;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalForwardProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  function SubProcB() {',
+    '  };',
+    '  SubProcB();',
+    '};',
+    '']),
+    LinesToStr([
+    'this.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitRecordMember;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    a: longint;');
+  Add('    b: longint;');
+  Add('  end;');
+  Add('var r: TRec;');
+  Add('begin');
+  Add('  r.a:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitRecordMember',
+    LinesToStr([
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.a = s.a;',
+    '  } else {',
+    '    this.a = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.a == b.a;',
+    '  };',
+    '};',
+    'this.r = new this.TRec();',
+    '']),
+    LinesToStr([
+    'this.r.a = 3;',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitNotUsedTObject;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('var o: TObject;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitNotUsedTObject',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_TObject;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure AfterConstruction; virtual;');
+  Add('    procedure BeforeDestruction; virtual;');
+  Add('  end;');
+  Add('procedure TObject.AfterConstruction; begin end;');
+  Add('procedure TObject.BeforeDestruction; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  ConvertProgram;
+  CheckSource('TestWPO_TObject',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.AfterConstruction = function () {',
+    '  };',
+    '  this.BeforeDestruction = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o = null;']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassField;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    a: longint;');
+  Add('    b: longint;');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.a:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassField',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.a = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.a = 3;']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA;');
+  Add('    procedure ProcB;');
+  Add('  end;');
+  Add('procedure TObject.ProcA; begin end;');
+  Add('procedure TObject.ProcB; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.ProcB;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassMethod',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcB = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.ProcB();']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure ProcA;');
+  Add('    class procedure ProcB;');
+  Add('  end;');
+  Add('class procedure TObject.ProcA; begin end;');
+  Add('class procedure TObject.ProcB; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.ProcB;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassMethod',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcB = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.$class.ProcB();']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertyGetter1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    function GetFoo: boolean;');
+  Add('    property Foo: boolean read FFoo;');
+  Add('    property Foo2: boolean read GetFoo;');
+  Add('    FBar: boolean;');
+  Add('    function GetBar: boolean;');
+  Add('    property Bar: boolean read FBar;');
+  Add('    property Bar2: boolean read GetBar;');
+  Add('  end;');
+  Add('function TObject.GetFoo: boolean; begin Result:=FFoo; end;');
+  Add('function TObject.GetBar: boolean; begin Result:=FBar; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o.Foo then;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertyGetter1',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'if (this.o.FFoo){',
+    '};',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertyGetter2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    function GetFoo: boolean;');
+  Add('    property Foo: boolean read FFoo;');
+  Add('    property Foo2: boolean read GetFoo;');
+  Add('  end;');
+  Add('function TObject.GetFoo: boolean; begin Result:=FFoo; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o.Foo2 then;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertyGetter2',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetFoo = function () {',
+    '    var Result = false;',
+    '    Result = this.FFoo;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'if (this.o.GetFoo()){',
+    '};',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertySetter1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    procedure SetFoo(Value: boolean);');
+  Add('    property Foo: boolean write FFoo;');
+  Add('    property Foo2: boolean write SetFoo;');
+  Add('    FBar: boolean;');
+  Add('    procedure SetBar(Value: boolean);');
+  Add('    property Bar: boolean write FBar;');
+  Add('    property Bar2: boolean write SetBar;');
+  Add('  end;');
+  Add('procedure TObject.SetFoo(Value: boolean); begin FFoo:=Value; end;');
+  Add('procedure TObject.SetBar(Value: boolean); begin FBar:=Value; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.Foo:=true;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertySetter1',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.FFoo = true;',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertySetter2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    procedure SetFoo(Value: boolean);');
+  Add('    property Foo: boolean write FFoo;');
+  Add('    property Foo2: boolean write SetFoo;');
+  Add('  end;');
+  Add('procedure TObject.SetFoo(Value: boolean); begin FFoo:=Value; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.Foo2:=true;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertySetter2',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.SetFoo = function (Value) {',
+    '    this.FFoo = Value;',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.SetFoo(true);',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_CallInherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoA;');
+  Add('    procedure DoB;');
+  Add('  end;');
+  Add('  TMobile = class');
+  Add('    procedure DoA;');
+  Add('    procedure DoC;');
+  Add('  end;');
+  Add('procedure TObject.DoA; begin end;');
+  Add('procedure TObject.DoB; begin end;');
+  Add('procedure TMobile.DoA;');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('procedure TMobile.DoC;');
+  Add('begin');
+  Add('  inherited DoB;');
+  Add('end;');
+  Add('var o: TMobile;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o.DoC;');
+  ConvertProgram;
+  CheckSource('TestWPO_CallInherited',
+    LinesToStr([
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoA = function () {',
+    '  };',
+    '  this.DoB = function () {',
+    '  };',
+    '});',
+    ' rtl.createClass(this, "TMobile", this.TObject, function () {',
+    '  this.DoA$1 = function () {',
+    '    pas.program.TObject.DoA.apply(this, arguments);',
+    '  };',
+    '  this.DoC = function () {',
+    '    pas.program.TObject.DoB.call(this);',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'this.o.DoA$1();',
+    'this.o.DoC();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_UseUnit;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var j: longint;',
+    'procedure DoMore;',
+    '']),
+    LinesToStr([
+    'procedure DoMore; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  j:=3;');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system", "unit2"], function () {',
+    '  this.$main = function () {',
+    '    pas.unit2.j = 3;',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
+end;
+
+Initialization
+  RegisterTests([TTestOptimizations]);
+end.
+

+ 20 - 12
packages/pastojs/tests/testpas2js.lpi

@@ -31,7 +31,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="5">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -44,19 +44,26 @@
         <Filename Value="../src/fppas2js.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="tcmodules.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tcoptimizations.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
+    <Target>
+      <Filename Value="testpas2js"/>
+    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../../fcl-js/src;../../fcl-passrc/src;../src"/>
+      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-passrc/src;../../pastojs/tests"/>
+      <UnitOutputDirectory Value="lib"/>
     </SearchPaths>
-    <Parsing>
-      <SyntaxOptions>
-        <AllowLabel Value="False"/>
-      </SyntaxOptions>
-    </Parsing>
     <CodeGeneration>
       <Checks>
         <IOChecks Value="True"/>
@@ -66,11 +73,12 @@
       </Checks>
       <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <TrashVariables Value="True"/>
-      </Debugging>
-    </Linking>
+    <Other>
+      <CustomOptions Value="-dVerbosePas2JS"/>
+      <OtherDefines Count="1">
+        <Define0 Value="VerbosePas2JS"/>
+      </OtherDefines>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

+ 1 - 1
packages/pastojs/tests/testpas2js.pp

@@ -17,7 +17,7 @@ program testpas2js;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tcconverter, tcmodules;
+  Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations;
 
 type