* Patch from Mattias Gaertner:

jswriter: more compact try..catch

pasresolver:
- mark function calls without ()
- "with type do ;"
- constructor call store TPasType
- mark if a constructor call creates a new
  instance or is a normal call
- same for destructor
- fixed checking assign operator types
- more tests

fppas2js:
- convert implicit calls in Pascal to explicit calls in JS
- built in procedure "exit" and "exit(value)"
- if loopvar is used afterwards append  if($loopend>i)i--;
- classes
  - declare using createClass, needs rtl magic
  - constructor
  - destructor
  - vars
  - ancestor
  - virtual, override, abstract
  - "is" operator
  - "as" operator
  - call inherited "inherited;", "inherited funcname;"
- dynamic arrays
  - init as "arr = []"
  - SetLength(arr,newlength)
  - length(arr)
- try..except, on .. do, raise
- insert default values in calls

git-svn-id: trunk@35383 -

packages/fcl-js/src/jswriter.pp

@@ -1051,39 +1051,27 @@ begin
   Indent;
   WriteJS(El.Block);
   Undent;
-  If C then
+  Write('}');
-    Write('} ')
-  else
-    begin
-    Writeln('}');
-    end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
     begin
-    Write('catch ('+El.Ident);
+    Write(' catch');
+    if El.Ident<>'' then Write(' ('+El.Ident+')');
     If C then
-      Write(') {')
+      Write(' {')
     else
-      Writeln(') {');
+      Writeln(' {');
+    FSkipBrackets:=True;
     Indent;
     WriteJS(El.BCatch);
     Undent;
-    If C then
+    Write('}');
-      if (El is TJSTryCatchFinallyStatement) then
-        Write('} ')
-      else
-        Write('}')
-    else
-      begin
-      Writeln('');
-      Writeln('}');
-      end;
     end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then
     begin
     If C then
-      Write('finally {')
+      Write(' finally {')
     else
-      Writeln('finally {');
+      Writeln(' finally {');
     Indent;
     FSkipBrackets:=True;
     WriteJS(El.BFinally);

packages/fcl-passrc/src/pasresolver.pp

@@ -57,7 +57,8 @@
       - defaultexpr
     - is and as operator
     - nil
-    - constructor result type
+    - constructor result type, rrfNewInstance
+    - destructor call type: rrfFreeInstance
     - type cast
     - class of
     - class method, property, var, const
@@ -93,8 +94,10 @@
   - built-in functions high, low for range type and arrays
   - procedure type
   - method type
+  - function without params: mark if call or address, rrfImplicitCallWithoutParams
 
  ToDo:
+  - overloads
   - char constant #0, #10, #13, UTF-8 char
   - const TArrayValues
   - classes - TPasClassType
@@ -102,6 +105,7 @@
      - nested types
   - check if constant is longint or int64
   - for..in..do
+  - class forward and pointer type must check type section before other scopes
   - pointer TPasPointerType
   - records - TPasRecordType,
      - variant - TPasVariant
@@ -127,6 +131,20 @@
 
  Debug flags: -d<x>
    VerbosePasResolver
+
+ Notes:
+   Functions and function types without parameters:
+     property P read f; // use function f, not its result
+     f.  // implicit resolve f once if param less function or function type
+     f[]  // implicit resolve f once if a param less function or function type
+     @f;  use function f, not its result
+     @p.f;  @ operator applies to f, not p
+     @f();  @ operator applies to result of f
+     f(); use f's result
+     FuncVar:=Func; if mode=objfpc: incompatible
+                    if mode=delphi: implicit addr of function f, not yet implemented
+     if f=g then : can implicit resolve each side once, at the moment: always implicit
+     p(f), f as var parameter: always implicit, thus incompatible
 }
 unit PasResolver;
 
@@ -429,11 +447,11 @@ type
     procedure SetElement(AValue: TPasElement);
   public
     Owner: TObject; // e.g. a TPasResolver
-    Next: TResolveData;
+    Next: TResolveData; // TPasResolver uses this for its memory chain
-    CustomData: TObject;
+    CustomData: TObject; // not used by TPasResolver, free for your extension
     constructor Create; virtual;
     destructor Destroy; override;
-    property Element: TPasElement read FElement write SetElement;
+    property Element: TPasElement read FElement write SetElement;// Element.CustomData=Self
   end;
   TResolveDataClass = class of TResolveData;
 
@@ -621,6 +639,7 @@ type
     NeedTmpVar: boolean;
     Expr: TPasExpr;
     Scope: TPasScope;
+    OnlyTypeMembers: boolean;
     class function IsStoredInElement: boolean; override;
     class function FreeOnPop: boolean; override;
     procedure IterateElements(const aName: string; StartScope: TPasScope;
@@ -709,12 +728,19 @@ type
   end;
 
   TResolvedReferenceFlag = (
-    rrfCallWithoutParams, // a TPrimitiveExpr is a call without params
+    rrfDotScope, // found reference via a dot scope (TPasDotIdentifierScope)
-    rrfNewInstance, // constructor call (without it call a constructor as normal method)
+    rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
+    rrfNewInstance, // constructor call (without it call constructor as normal method)
+    rrfFreeInstance, // destructor call (without it call destructor as normal method)
     rrfVMT // use VMT for call
     );
   TResolvedReferenceFlags = set of TResolvedReferenceFlag;
 
+  { TResolvedRefContext }
+
+  TResolvedRefContext = Class
+  end;
+
   { TResolvedReference - CustomData for normal references }
 
   TResolvedReference = Class(TResolveData)
@@ -722,12 +748,20 @@ type
     FDeclaration: TPasElement;
     procedure SetDeclaration(AValue: TPasElement);
   public
-    WithExprScope: TPasWithExprScope;
     Flags: TResolvedReferenceFlags;
+    Context: TResolvedRefContext;
+    WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
     destructor Destroy; override;
     property Declaration: TPasElement read FDeclaration write SetDeclaration;
   end;
 
+  { TResolvedRefCtxConstructor }
+
+  TResolvedRefCtxConstructor = Class(TResolvedRefContext)
+  public
+    Typ: TPasType; // e.g. TPasClassType
+  end;
+
   TPasResolverResultFlag = (
     rrfReadable,
     rrfWritable
@@ -782,10 +816,13 @@ type
     GetCallResult: TOnGetCallResult;
   end;
 
+  { TPRFindData }
+
   TPRFindData = record
     ErrorPosEl: TPasElement;
     Found: TPasElement;
-    ElScope, StartScope: TPasScope;
+    ElScope: TPasScope; // Where Found was found
+    StartScope: TPasScope; // where the searched started
   end;
   PPRFindData = ^TPRFindData;
 
@@ -931,6 +968,7 @@ type
     procedure ConvertRangeToFirstValue(var ResolvedEl: TPasResolverResult);
     function IsCharLiteral(const Value: string): boolean; virtual;
   protected
+    // built-in functions
     function OnGetCallCompatibility_Length(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure OnGetCallResult_Length(Proc: TResElDataBuiltInProc;
@@ -1051,6 +1089,8 @@ type
     function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
     function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
       ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
+    function CheckAssignCompatibility(const LHS, RHS: TPasElement;
+      RaiseOnIncompatible: boolean = true): integer;
     function CheckAssignCompatibility(const LHS, RHS: TPasResolverResult;
       ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
     function CheckEqualCompatibility(const LHS, RHS: TPasResolverResult;
@@ -1065,6 +1105,8 @@ type
     function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
     function ResolveAliasType(aType: TPasType): TPasType;
     function ExprIsAddrTarget(El: TPasExpr): boolean;
+    function GetLastExprIdentifier(El: TPasExpr): TPasExpr;
+    function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
   public
     property BaseType[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseType;
     property BaseTypeStringIndex: TResolverBaseType read FBaseTypeStringIndex write FBaseTypeStringIndex;
@@ -1662,6 +1704,7 @@ end;
 destructor TResolvedReference.Destroy;
 begin
   Declaration:=nil;
+  FreeAndNil(Context);
   inherited Destroy;
 end;
 
@@ -2591,16 +2634,10 @@ begin
 end;
 
 procedure TPasResolver.FinishConstDef(El: TPasConst);
-var
-  TypeResolved, ExprResolved: TPasResolverResult;
 begin
   ResolveExpr(El.Expr);
   if El.VarType<>nil then
-    begin
+    CheckAssignCompatibility(El,El.Expr,true);
-    ComputeElement(El,TypeResolved,[]);
-    ComputeElement(El.Expr,ExprResolved,[rcReturnFuncResult]);
-    CheckAssignCompatibility(TypeResolved,ExprResolved,El.Expr,true)
-    end;
 end;
 
 procedure TPasResolver.FinishProcedure;
@@ -2779,6 +2816,7 @@ begin
   Proc.ProcType.IsOfObject:=true;
   ProcScope:=TopScope as TPasProcedureScope;
   ClassScope:=Scopes[ScopeCount-2] as TPasClassScope;
+  ProcScope.ClassScope:=ClassScope;
   FindData:=Default(TFindOverloadProcData);
   FindData.Proc:=Proc;
   FindData.Args:=Proc.ProcType.Args;
@@ -2971,15 +3009,9 @@ begin
 end;
 
 procedure TPasResolver.FinishVariable(El: TPasVariable);
-var
-  TypeResolved, ExprResolved: TPasResolverResult;
 begin
   if El.Expr<>nil then
-    begin
+    CheckAssignCompatibility(El,El.Expr,true);
-    ComputeElement(El,TypeResolved,[]);
-    ComputeElement(El.Expr,ExprResolved,[rcReturnFuncResult]);
-    CheckAssignCompatibility(TypeResolved,ExprResolved,El.Expr,true);
-    end;
 end;
 
 procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
@@ -3288,15 +3320,9 @@ begin
 end;
 
 procedure TPasResolver.FinishArgument(El: TPasArgument);
-var
-  TypeResolved, ExprResolved: TPasResolverResult;
 begin
   if (El.ArgType<>nil) and (El.ValueExpr<>nil) then
-    begin
+    CheckAssignCompatibility(El,El.ValueExpr,true);
-    ComputeElement(El,TypeResolved,[]);
-    ComputeElement(El.ValueExpr,ExprResolved,[rcReturnFuncResult]);
-    CheckAssignCompatibility(TypeResolved,ExprResolved,El.ValueExpr,true);
-    end;
 end;
 
 procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
@@ -3536,6 +3562,8 @@ var
   WithScope: TPasWithScope;
   WithExprScope: TPasWithExprScope;
   ExprScope: TPasScope;
+  OnlyTypeMembers: Boolean;
+  ClassEl: TPasClassType;
 begin
   OldScopeCount:=ScopeCount;
   WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
@@ -3555,10 +3583,28 @@ begin
       RaiseMsg(nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
         [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
 
+    OnlyTypeMembers:=false;
     if TypeEl.ClassType=TPasRecordType then
-      ExprScope:=TPasRecordType(TypeEl).CustomData as TPasRecordScope
+      begin
+      ExprScope:=TPasRecordType(TypeEl).CustomData as TPasRecordScope;
+      if ExprResolved.IdentEl is TPasType then
+        // e.g. with TPoint do PointInCircle
+        OnlyTypeMembers:=true;
+      end
     else if TypeEl.ClassType=TPasClassType then
-      ExprScope:=TPasClassType(TypeEl).CustomData as TPasClassScope
+      begin
+      ExprScope:=TPasClassType(TypeEl).CustomData as TPasClassScope;
+      if ExprResolved.IdentEl is TPasType then
+        // e.g. with TFPMemoryImage do FindHandlerFromExtension()
+        OnlyTypeMembers:=true;
+      end
+    else if TypeEl.ClassType=TPasClassOfType then
+      begin
+      // e.g. with ImageClass do FindHandlerFromExtension()
+      ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
+      ExprScope:=ClassEl.CustomData as TPasClassScope;
+      OnlyTypeMembers:=true;
+      end
     else
       RaiseMsg(nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
         [TypeEl.ElementTypeName],ErrorEl);
@@ -3568,6 +3614,7 @@ begin
     WithExprScope.Expr:=Expr;
     WithExprScope.Scope:=ExprScope;
     WithExprScope.NeedTmpVar:=not (ExprResolved.IdentEl is TPasType);
+    WithExprScope.OnlyTypeMembers:=OnlyTypeMembers;
     WithScope.ExpressionScopes.Add(WithExprScope);
     PushScope(WithExprScope);
     end;
@@ -3582,6 +3629,7 @@ end;
 procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
 var
   LeftResolved, RightResolved: TPasResolverResult;
+  Flags: TPasResolverComputeFlags;
 begin
   ResolveExpr(El.left);
   ResolveExpr(El.right);
@@ -3592,13 +3640,11 @@ begin
   ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias]);
   CheckCanBeLHS(LeftResolved,true,El.left);
   // compute RHS
-  ComputeElement(El.right,RightResolved,[rcSkipTypeAlias]);
+  Flags:=[rcSkipTypeAlias,rcReturnFuncResult];
-
+  //writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDesc(LeftResolved),' rcReturnFuncResult=',rcReturnFuncResult in Flags);
-  if RightResolved.BaseType=btProc then
+  // ToDo: Delphi also uses left side to decide whether use function reference or function result
-    begin
+  ComputeElement(El.right,RightResolved,Flags);
-    // ToDo: Delphi also uses left side to decide whether use function reference or function result
+  //writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDesc(RightResolved));
-    ComputeProcWithoutParams(RightResolved,El.right);
-    end;
 
   case El.Kind of
   akDefault:
@@ -3661,17 +3707,21 @@ procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
 var
   ResolvedEl: TPasResolverResult;
 begin
-  ResolveExpr(El.ExceptObject);
+  if El.ExceptObject<>nil then
-  ResolveExpr(El.ExceptAddr);
+    begin
-  ComputeElement(El.ExceptObject,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
+    ResolveExpr(El.ExceptObject);
-  if (ResolvedEl.IdentEl=nil) then
+    ComputeElement(El.ExceptObject,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
-    RaiseMsg(nXExpectedButYFound,sXExpectedButYFound,
+    if (ResolvedEl.IdentEl=nil) then
-             ['variable',ResolvedEl.TypeEl.ElementTypeName],El.ExceptObject);
+      RaiseMsg(nXExpectedButYFound,sXExpectedButYFound,
-  if (ResolvedEl.IdentEl.ClassType<>TPasVariable)
+               ['variable',ResolvedEl.TypeEl.ElementTypeName],El.ExceptObject);
-      and (ResolvedEl.IdentEl.ClassType<>TPasArgument) then
+    if (ResolvedEl.IdentEl.ClassType<>TPasVariable)
-    RaiseMsg(nXExpectedButYFound,sXExpectedButYFound,
+        and (ResolvedEl.IdentEl.ClassType<>TPasArgument) then
-             ['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
+      RaiseMsg(nXExpectedButYFound,sXExpectedButYFound,
-  CheckIsClass(El.ExceptObject,ResolvedEl);
+               ['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
+    CheckIsClass(El.ExceptObject,ResolvedEl);
+    end;
+  if El.ExceptAddr<>nil then
+    ResolveExpr(El.ExceptAddr);
 end;
 
 procedure TPasResolver.ResolveExpr(El: TPasExpr);
@@ -3730,6 +3780,8 @@ var
   BuiltInProc: TResElDataBuiltInProc;
 begin
   DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
+  Ref:=CreateReference(DeclEl,El,@FindData);
+  CheckFoundElement(FindData,Ref);
   if DeclEl is TPasProcedure then
     begin
     // identifier is a proc and args brackets are missing
@@ -3755,8 +3807,6 @@ begin
       BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
       end;
     end;
-  Ref:=CreateReference(DeclEl,El,@FindData);
-  CheckFoundElement(FindData,Ref);
 end;
 
 procedure TPasResolver.ResolveInherited(El: TInheritedExpr);
@@ -3766,14 +3816,17 @@ var
   DeclProc, AncestorProc: TPasProcedure;
 begin
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.ResolveInheritedDefault El.Parent=',GetTreeDesc(El.Parent));
+  writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDesc(El.Parent));
   {$ENDIF}
   if (El.Parent.ClassType=TBinaryExpr)
   and (TBinaryExpr(El.Parent).OpCode=eopNone) then
     begin
+    // e.g. 'inherited Proc;'
     ResolveInheritedCall(TBinaryExpr(El.Parent));
     exit;
     end;
+
+  // 'inherited;' without expression
   CheckTopScope(TPasProcedureScope);
   ProcScope:=TPasProcedureScope(TopScope);
   if ProcScope.ClassScope=nil then
@@ -3782,11 +3835,11 @@ begin
   AncestorScope:=ProcScope.ClassScope.AncestorScope;
   if AncestorScope=nil then
     begin
-    // 'inherited;' without ancestor is ignored
+    // 'inherited;' without ancestor class is silently ignored
     exit;
     end;
 
-  // search in ancestor
+  // search ancestor in element, i.e. 'inherited' expression
   DeclProc:=ProcScope.DeclarationProc;
   DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
   AncestorProc:=DeclProcScope.OverriddenProc;
@@ -3799,7 +3852,7 @@ begin
     end
   else
     begin
-    // 'inherited;' without ancestor is ignored
+    // 'inherited;' without ancestor method is silently ignored
     exit;
     end;
 end;
@@ -3942,6 +3995,7 @@ begin
     end
   else if LeftResolved.TypeEl=nil then
     begin
+    // illegal qualifier, see below
     end
   else if LeftResolved.TypeEl.ClassType=TPasClassType then
     begin
@@ -4631,17 +4685,12 @@ begin
     exit;
     end;
 
-  ComputeElement(Bin.left,LeftResolved,Flags);
+  ComputeElement(Bin.left,LeftResolved,Flags+[rcReturnFuncResult]);
-  ComputeElement(Bin.right,RightResolved,Flags);
+  ComputeElement(Bin.right,RightResolved,Flags+[rcReturnFuncResult]);
   // ToDo: check operator overloading
 
   //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDesc(LeftResolved),' Right=',GetResolverResultDesc(RightResolved));
 
-  if LeftResolved.BaseType=btProc then
-    ComputeProcWithoutParams(LeftResolved,Bin.left);
-  if RightResolved.BaseType=btProc then
-    ComputeProcWithoutParams(RightResolved,Bin.right);
-
   if Bin.OpCode in [eopEqual,eopNotEqual] then
     begin
     if CheckEqualCompatibility(LeftResolved,RightResolved,Bin,true)=cIncompatible then
@@ -5112,10 +5161,12 @@ var
   Proc: TPasProcedure;
   aClass: TPasClassType;
   ResolvedTypeEl: TPasResolverResult;
+  Ref: TResolvedReference;
 begin
   if Params.Value.CustomData is TResolvedReference then
     begin
-    DeclEl:=TResolvedReference(Params.Value.CustomData).Declaration;
+    Ref:=TResolvedReference(Params.Value.CustomData);
+    DeclEl:=Ref.Declaration;
     if DeclEl.ClassType=TPasUnresolvedSymbolRef then
       begin
       if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
@@ -5130,7 +5181,7 @@ begin
         end
       else if DeclEl.CustomData.ClassType=TResElDataBaseType then
         begin
-        // type case to base type
+        // type cast to base type
         SetResolverValueExpr(ResolvedEl,
           TResElDataBaseType(DeclEl.CustomData).BaseType,
           TPasUnresolvedSymbolRef(DeclEl),Params.Params[0],[rrfReadable]);
@@ -5140,6 +5191,7 @@ begin
       end
     else
       begin
+      // normal identifier (not built-in)
       ComputeElement(DeclEl,ResolvedEl,Flags-[rcReturnFuncResult]);
       if ResolvedEl.BaseType=btProc then
         begin
@@ -5151,10 +5203,11 @@ begin
         if Proc is TPasFunction then
           // function call => return result
           ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,Flags-[rcReturnFuncResult])
-        else if Proc.ClassType=TPasConstructor then
+        else if (Proc.ClassType=TPasConstructor)
+            and (rrfNewInstance in Ref.Flags) then
           begin
-          // constructor call -> return value of type class
+          // new instance call -> return value of type class
-          aClass:=Proc.Parent as TPasClassType;
+          aClass:=GetReference_NewInstanceClass(Ref);
           SetResolverValueExpr(ResolvedEl,btContext,aClass,Params.Value,[rrfReadable]);
           end
         else
@@ -5208,9 +5261,8 @@ procedure TPasResolver.ComputeProcWithoutParams(
 var
   aClass: TPasClassType;
   Proc: TPasProcedure;
+  Ref: TResolvedReference;
 begin
-  if ExprIsAddrTarget(Expr) then exit;
-
   if ResolvedEl.IdentEl=nil then
     RaiseNotYetImplemented(20160928183455,Expr,GetResolverResultDesc(ResolvedEl));
   if not (ResolvedEl.IdentEl is TPasProcedure) then
@@ -5221,13 +5273,22 @@ begin
     RaiseMsg(nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
       [GetProcDesc(Proc.ProcType)],Expr);
 
+  Expr:=GetLastExprIdentifier(Expr);
+  if ExprIsAddrTarget(Expr) then exit;
+
+  Ref:=nil;
   if Expr.CustomData is TResolvedReference then
-    Include(TResolvedReference(Expr.CustomData).Flags,rrfCallWithoutParams);
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    Include(Ref.Flags,rrfImplicitCallWithoutParams);
+    end;
   if (ResolvedEl.IdentEl is TPasFunction) then
     ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,[])
-  else if ResolvedEl.IdentEl.ClassType=TPasConstructor then
+  else if (ResolvedEl.IdentEl.ClassType=TPasConstructor)
+      and (Ref<>nil) and (rrfNewInstance in Ref.Flags) then
     begin
-    aClass:=Proc.Parent as TPasClassType;
+    // new instance call -> return value of type class
+    aClass:=GetReference_NewInstanceClass(Ref);
     SetResolverValueExpr(ResolvedEl,btContext,aClass,Expr,[rrfReadable]);
     end
   else
@@ -5998,6 +6059,8 @@ var
   Data: TPRFindData;
 begin
   Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs);
+  if Data.Found=nil then exit; // forward type: class-of or ^
+  CheckFoundElement(Data,nil);
   if (Data.StartScope<>nil) and (Data.StartScope.ClassType=TPasWithExprScope)
       and TPasWithExprScope(Data.StartScope).NeedTmpVar then
     RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
@@ -6035,8 +6098,6 @@ begin
     // proc needs parameters
     RaiseMsg(nWrongNumberOfParametersForCallTo,
       sWrongNumberOfParametersForCallTo,[GetProcDesc(TPasProcedure(Result).ProcType)],ErrorPosEl);
-
-  CheckFoundElement(Data,nil);
 end;
 
 procedure TPasResolver.IterateElements(const aName: string;
@@ -6064,12 +6125,29 @@ var
   Proc: TPasProcedure;
   Context: TPasElement;
   FoundContext: TPasClassType;
+  StartScope: TPasScope;
+  OnlyTypeMembers: Boolean;
+  TypeEl: TPasType;
 begin
-  //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',FindData.StartScope.ClassName,' ',FindData.StartScope is TPasDotIdentifierScope,' ',(FindData.StartScope is TPasDotIdentifierScope)
+  StartScope:=FindData.StartScope;
-  //    and TPasDotIdentifierScope(FindData.StartScope).OnlyTypeMembers,
+  OnlyTypeMembers:=false;
+  if (StartScope is TPasDotIdentifierScope) then
+    begin
+    OnlyTypeMembers:=TPasDotIdentifierScope(StartScope).OnlyTypeMembers;
+    Include(Ref.Flags,rrfDotScope);
+    end
+  else if StartScope.ClassType=TPasWithExprScope then
+    begin
+    OnlyTypeMembers:=TPasWithExprScope(StartScope).OnlyTypeMembers;
+    Include(Ref.Flags,rrfDotScope);
+    end;
+
+  //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
+  //    ' ',StartScope is TPasDotIdentifierScope,
+  //    ' ',(StartScope is TPasDotIdentifierScope)
+  //       and TPasDotIdentifierScope(StartScope).OnlyTypeMembers,
   //    ' FindData.Found=',GetObjName(FindData.Found));
-  if (FindData.StartScope is TPasDotIdentifierScope)
+  if OnlyTypeMembers then
-      and TPasDotIdentifierScope(FindData.StartScope).OnlyTypeMembers then
     begin
     //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
     //    and (vmClass in TPasVariable(FindData.Found).VarModifiers));
@@ -6096,8 +6174,8 @@ begin
     Proc:=TPasProcedure(FindData.Found);
     if Proc.IsVirtual or Proc.IsOverride then
       begin
-      if (FindData.StartScope.ClassType=TPasDotClassScope)
+      if (StartScope.ClassType=TPasDotClassScope)
-      and TPasDotClassScope(FindData.StartScope).InheritedExpr then
+      and TPasDotClassScope(StartScope).InheritedExpr then
         begin
         // call directly
         if Proc.IsAbstract then
@@ -6106,16 +6184,69 @@ begin
         end
       else
         begin
-        // call via method table
+        // call via virtual method table
         if Ref<>nil then
           Ref.Flags:=Ref.Flags+[rrfVMT];
         end;
       end;
-    if (FindData.Found.ClassType=TPasConstructor)
+
-        and (FindData.StartScope.ClassType=TPasDotClassScope)
+    // constructor: NewInstance or normal call
-        and TPasDotClassScope(FindData.StartScope).OnlyTypeMembers
+    //  it is a NewInstance iff the scope is a class, e.g. TObject.Create
+    if (Proc.ClassType=TPasConstructor)
+        and OnlyTypeMembers
         and (Ref<>nil) then
+      begin
       Ref.Flags:=Ref.Flags+[rrfNewInstance];
+      // store the class in Ref.Context
+      if Ref.Context<>nil then
+        RaiseInternalError(20170131141936);
+      Ref.Context:=TResolvedRefCtxConstructor.Create;
+      if StartScope is TPasDotClassScope then
+        TypeEl:=TPasDotClassScope(StartScope).ClassScope.Element as TPasType
+      else if (StartScope is TPasWithExprScope) and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
+        TypeEl:=TPasClassScope(TPasWithExprScope(StartScope).Scope).Element as TPasType
+      else
+        RaiseInternalError(20170131150855,GetObjName(StartScope));
+      TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
+      end;
+    {$IFDEF VerbosePasResolver}
+    if (Proc.ClassType=TPasConstructor) then
+      begin
+      write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
+      if Ref=nil then
+        write(' no ref!')
+      else
+        begin
+        write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
+          ' StartScope=',GetObjName(StartScope),
+          ' OnlyTypeMembers=',OnlyTypeMembers);
+        end;
+      writeln;
+      end;
+    {$ENDIF}
+
+    // destructor: FreeInstance or normal call
+    // it is a normal call if 'inherited'
+    if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
+      if ((StartScope.ClassType<>TPasDotClassScope)
+          or (not TPasDotClassScope(StartScope).InheritedExpr)) then
+        Ref.Flags:=Ref.Flags+[rrfFreeInstance];
+    {$IFDEF VerbosePasResolver}
+    if (Proc.ClassType=TPasDestructor) then
+      begin
+      write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
+      if Ref=nil then
+        write(' no ref!')
+      else
+        begin
+        write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
+          ' StartScope=',GetObjName(StartScope));
+        if StartScope.ClassType=TPasDotClassScope then
+          write(' InheritedExpr=',TPasDotClassScope(StartScope).InheritedExpr);
+        end;
+      writeln;
+      end;
+    {$ENDIF}
     end;
 
   // check class visibility
@@ -6886,6 +7017,16 @@ begin
     RaiseMsg(nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
 end;
 
+function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
+  RaiseOnIncompatible: boolean): integer;
+var
+  LeftResolved, RightResolved: TPasResolverResult;
+begin
+  ComputeElement(LHS,LeftResolved,[]);
+  ComputeElement(RHS,RightResolved,[rcReturnFuncResult]);
+  Result:=CheckAssignCompatibility(LeftResolved,RightResolved,RHS,RaiseOnIncompatible);
+end;
+
 function TPasResolver.CheckAssignCompatibility(const LHS,
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
   ): integer;
@@ -6894,7 +7035,7 @@ var
 begin
   // check if the RHS can be converted to LHS
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.CheckAssignCompatibility ');
+  writeln('TPasResolver.CheckAssignCompatibility START LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
   {$ENDIF}
   if LHS.TypeEl=nil then
     begin
@@ -6966,7 +7107,7 @@ begin
       end;
     end;
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.CheckAssignCompatibility LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
+  writeln('TPasResolver.CheckAssignCompatibility incompatible LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
   {$ENDIF}
   if not RaiseOnIncompatible then
     exit(cIncompatible);
@@ -7194,8 +7335,6 @@ begin
   MustFitExactly:=Param.Access in [argVar, argOut];
 
   ComputeElement(Expr,ExprResolved,ComputeFlags);
-  if ExprResolved.BaseType=btProc then
-    ComputeProcWithoutParams(ExprResolved,Expr);
 
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDesc(Expr,2),' ResolvedExpr=',GetResolverResultDesc(ExprResolved));
@@ -7213,7 +7352,9 @@ begin
         RaiseMsg(nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
       exit;
       end;
-    end;
+    end
+  else if ExprResolved.BaseType=btProc then
+    ComputeProcWithoutParams(ExprResolved,Expr);
 
   ComputeElement(Param,ParamResolved,ComputeFlags);
   {$IFDEF VerbosePasResolver}
@@ -7269,7 +7410,7 @@ begin
     exit(cExact);
 
   {$IFDEF VerbosePasResolver}
-  //writeln('TPasResolver.CheckCustomTypeCompatibility SrcTypeEl=',GetObjName(RTypeEl),' DstTypeEl=',GetObjName(LTypeEl));
+  writeln('TPasResolver.CheckCustomTypeCompatibility LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
   {$ENDIF}
   if LTypeEl.ClassType=TPasClassType then
     begin
@@ -7591,6 +7732,8 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
 var
   DeclEl: TPasElement;
   aClass: TPasClassType;
+  Ref: TResolvedReference;
+  Proc: TPasProcedure;
 begin
   ResolvedEl:=Default(TPasResolverResult);
   {$IFDEF VerbosePasResolver}
@@ -7605,20 +7748,30 @@ begin
         begin
         if not (El.CustomData is TResolvedReference) then
           RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
-        ComputeElement(TResolvedReference(El.CustomData).Declaration,ResolvedEl,Flags-[rcReturnFuncResult]);
+        Ref:=TResolvedReference(El.CustomData);
+        ComputeElement(Ref.Declaration,ResolvedEl,Flags-[rcReturnFuncResult]);
+        //writeln('TPasResolver.ComputeElement TPrimitiveExpr "',TPrimitiveExpr(El).Value,'" ',GetResolverResultDesc(ResolvedEl),' rcReturnFuncResult=',rcReturnFuncResult in Flags);
         if (ResolvedEl.BaseType=btProc) and (rcReturnFuncResult in Flags) then
           begin
+          // a proc and implicit call without params is allowed -> check if possible
           if rcConstant in Flags then
             RaiseConstantExprExp(El);
-          Include(TResolvedReference(El.CustomData).Flags,rrfCallWithoutParams);
+          Proc:=ResolvedEl.IdentEl as TPasProcedure;
-          if ResolvedEl.IdentEl is TPasFunction then
+          if (Proc.ProcType.Args.Count=0)
-            // function => return result
+              or (TPasArgument(Proc.ProcType.Args[0]).ValueExpr<>nil) then
-            ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,Flags-[rcReturnFuncResult])
-          else if ResolvedEl.IdentEl.ClassType=TPasConstructor then
             begin
-            // constructor -> return value of type class
+            // parameter less proc -> implicit call
-            aClass:=ResolvedEl.IdentEl.Parent as TPasClassType;
+            Include(Ref.Flags,rrfImplicitCallWithoutParams);
-            SetResolverValueExpr(ResolvedEl,btContext,aClass,TPrimitiveExpr(El),[rrfReadable]);
+            if ResolvedEl.IdentEl is TPasFunction then
+              // function => return result
+              ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,Flags-[rcReturnFuncResult])
+            else if (ResolvedEl.IdentEl.ClassType=TPasConstructor)
+                and (rrfNewInstance in Ref.Flags) then
+              begin
+              // new instance constructor -> return value of type class
+              aClass:=GetReference_NewInstanceClass(Ref);
+              SetResolverValueExpr(ResolvedEl,btContext,aClass,TPrimitiveExpr(El),[rrfReadable]);
+              end;
             end;
           end;
         end;
@@ -7657,8 +7810,72 @@ begin
     else
       RaiseNotYetImplemented(20160926194756,El);
     end
+  else if El.ClassType=TSelfExpr then
+    begin
+    if rcConstant in Flags then
+      RaiseConstantExprExp(El);
+    ComputeElement(TResolvedReference(El.CustomData).Declaration,ResolvedEl,Flags);
+    end
+  else if El.ClassType=TBoolConstExpr then
+    SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TBoolConstExpr(El),[rrfReadable])
   else if El.ClassType=TBinaryExpr then
     ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags)
+  else if El.ClassType=TUnaryExpr then
+    begin
+    if TUnaryExpr(El).OpCode=eopAddress then
+      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags-[rcReturnFuncResult])
+    else
+      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDesc(ResolvedEl),' ',GetElementSourcePosStr(El));
+    {$ENDIF}
+    case TUnaryExpr(El).OpCode of
+      eopAdd, eopSubtract:
+        if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
+          exit
+        else
+          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+      eopNot:
+        if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
+          exit
+        else
+          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+      eopAddress:
+        if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
+          begin
+          SetResolverValueExpr(ResolvedEl,btContext,ResolvedEl.TypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
+          exit;
+          end
+        else
+          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+    end;
+    RaiseNotYetImplemented(20160926142426,El);
+    end
+  else if El.ClassType=TParamsExpr then
+    case TParamsExpr(El).Kind of
+      pekArrayParams:
+        ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags);
+      pekFuncParams:
+        ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags);
+      pekSet:
+        ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags);
+    else
+      RaiseNotYetImplemented(20161010184559,El);
+    end
+  else if El.ClassType=TInheritedExpr then
+    begin
+    // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
+    if El.CustomData is TResolvedReference then
+      begin
+        // "inherited;"
+        DeclEl:=TResolvedReference(El.CustomData).Declaration as TPasProcedure;
+        SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
+          TPasProcedure(DeclEl).ProcType,[]);
+      end
+    else
+      // no ancestor proc
+      SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[]);
+    end
   else if El.ClassType=TPasAliasType then
     begin
     // e.g. 'type a = b' -> compute b
@@ -7767,37 +7984,6 @@ begin
     ResolvedEl.IdentEl:=El;
     ResolvedEl.Flags:=[];
     end
-  else if El.ClassType=TUnaryExpr then
-    begin
-    if TUnaryExpr(El).OpCode=eopAddress then
-      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags-[rcReturnFuncResult])
-    else
-      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags);
-    {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDesc(ResolvedEl),' ',GetElementSourcePosStr(El));
-    {$ENDIF}
-    case TUnaryExpr(El).OpCode of
-      eopAdd, eopSubtract:
-        if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
-          exit
-        else
-          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
-      eopNot:
-        if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
-          exit
-        else
-          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
-      eopAddress:
-        if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
-          begin
-          SetResolverValueExpr(ResolvedEl,btContext,ResolvedEl.TypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
-          exit;
-          end
-        else
-          RaiseMsg(nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
-    end;
-    RaiseNotYetImplemented(20160926142426,El);
-    end
   else if El.ClassType=TPasResultElement then
     begin
     if rcConstant in Flags then
@@ -7810,47 +7996,17 @@ begin
     SetResolverIdentifier(ResolvedEl,btModule,El,nil,[])
   else if El.ClassType=TNilExpr then
     SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],TNilExpr(El),[rrfReadable])
-  else if El.ClassType=TSelfExpr then
-    begin
-    if rcConstant in Flags then
-      RaiseConstantExprExp(El);
-    ComputeElement(TResolvedReference(El.CustomData).Declaration,ResolvedEl,Flags);
-    end
-  else if El.ClassType=TBoolConstExpr then
-    SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TBoolConstExpr(El),[rrfReadable])
-  else if El.ClassType=TParamsExpr then
-    case TParamsExpr(El).Kind of
-      pekArrayParams:
-        ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags);
-      pekFuncParams:
-        ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags);
-      pekSet:
-        ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags);
-    else
-      RaiseNotYetImplemented(20161010184559,El);
-    end
   else if El is TPasProcedure then
     begin
     SetResolverIdentifier(ResolvedEl,btProc,El,TPasProcedure(El).ProcType,[]);
     if El is TPasFunction then
       Include(ResolvedEl.Flags,rrfReadable);
+    // Note: the readability of TPasConstructor depends on the context
     end
   else if El is TPasProcedureType then
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasProcedureType(El),[])
   else if El.ClassType=TPasArrayType then
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
-  else if El.ClassType=TInheritedExpr then
-    begin
-    if El.CustomData is TResolvedReference then
-      begin
-        DeclEl:=TResolvedReference(El.CustomData).Declaration as TPasProcedure;
-        SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
-          TPasProcedure(DeclEl).ProcType,[]);
-      end
-    else
-      // no ancestor proc
-      SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[]);
-    end
   else
     RaiseNotYetImplemented(20160922163705,El);
 end;
@@ -7896,18 +8052,19 @@ begin
 end;
 
 function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
-// returns true if El is the last element of an @ operator expression
+{ returns true if El is
-// e.g. the OnClick in '@p().o[].OnClick'
+  a) the last element of an @ operator expression
-//  or '@s[]'
+  e.g. '@p().o[].El' or '@El[]'
+  b) an accessor function, e.g. property P read El;
+}
 var
   Parent: TPasElement;
+  Prop: TPasProperty;
 begin
   Result:=false;
   if El=nil then exit;
-  if (El.ClassType=TParamsExpr) or (El.ClassType=TPrimitiveExpr)
+  if not ((El.ClassType=TParamsExpr) or (El.ClassType=TPrimitiveExpr)
-      or (El.ClassType=TSelfExpr) then
+      or (El.ClassType=TSelfExpr)) then
-    // these are possible endings of a @ expression
-  else
     exit;
   repeat
     Parent:=El.Parent;
@@ -7924,12 +8081,36 @@ begin
       begin
       if TParamsExpr(Parent).Value<>El then exit;
       end
-    else
+    else if Parent.ClassType=TPasProperty then
+      begin
+      Prop:=TPasProperty(Parent);
+      Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
+      exit;
+      end
+     else
       exit;
     El:=TPasExpr(Parent);
   until false;
 end;
 
+function TPasResolver.GetLastExprIdentifier(El: TPasExpr): TPasExpr;
+begin
+  Result:=El;
+  while Result<>nil do
+    begin
+    if Result is TParamsExpr then
+      Result:=TParamsExpr(Result).Value
+    else if Result is TBinaryExpr then
+      Result:=TBinaryExpr(Result).right;
+    end;
+end;
+
+function TPasResolver.GetReference_NewInstanceClass(Ref: TResolvedReference
+  ): TPasClassType;
+begin
+  Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
+end;
+
 function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
   ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
 // finds distance between classes SrcType and DestType

packages/fcl-passrc/src/pparser.pp

@@ -283,6 +283,9 @@ type
       Element: TPasExpr; AOpCode: TExprOpCode);
     procedure AddParamsToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
       Params: TParamsExpr);
+    {$IFDEF VerbosePasParser}
+    procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
+    {$ENDIF}
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
@@ -2701,7 +2704,12 @@ begin
     NextToken;
     if CurToken = tkColon then
       begin
-      Result.VarType := ParseType(Result,Scanner.CurSourcePos);
+      Scanner.ForceCaret:=True;
+      try
+        Result.VarType := ParseType(Result,Scanner.CurSourcePos);
+      finally
+        Scanner.ForceCaret:=False;
+      end;
 {      if Result.VarType is TPasRangeType then
         Ungettoken; // Range type stops on token after last range token}
       end
@@ -2870,7 +2878,12 @@ begin
   TypeName := CurTokenString;
   NamePos:=Scanner.CurSourcePos;
   ExpectToken(tkEqual);
-  Result:=ParseType(Parent,NamePos,TypeName,True);
+  Scanner.ForceCaret:=True;
+  try
+    Result:=ParseType(Parent,NamePos,TypeName,True);
+  finally
+    Scanner.ForceCaret:=False;
+  end;
 end;
 
 function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; out
@@ -2994,9 +3007,13 @@ begin
       if CurToken=tkComma then
         ExpectIdentifier;
     Until (CurToken=tkColon);
-
+    Scanner.ForceCaret:=False;
+    try
+      VarType := ParseComplexType(VarEl);
+    finally
+      Scanner.ForceCaret:=False;
+    end;
     // read type
-    VarType := ParseComplexType(VarEl);
     for i := OldListCount to VarList.Count - 1 do
       begin
       VarEl:=TPasVariable(VarList[i]);
@@ -3254,16 +3271,10 @@ function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
 
 begin
   NextToken;
-  Result:=(Curtoken=tkbraceOpen);
+  case CurToken of
-  if not Result then
+  tkBraceOpen:
-    begin
-    if Mandatory then
-      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
-    else
-      UngetToken;
-    end
-  else
     begin
+    Result:=true;
     NextToken;
     if (CurToken<>tkBraceClose) then
       begin
@@ -3271,6 +3282,17 @@ begin
       ParseArgList(Parent, Args, tkBraceClose);
       end;
     end;
+  tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
+    begin
+    Result:=false;
+    if Mandatory then
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
+    else
+      UngetToken;
+    end
+  else
+    ParseExcTokenError(';');
+  end;
 end;
 
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
@@ -5039,7 +5061,7 @@ begin
       // chain not yet full => inconsistency
       RaiseInternal;
     Last.right:=CreateBinaryExpr(Last,Last.right,Element,AOpCode);
-    ChainLast:=Last;
+    ChainLast:=Last.right;
     end
   else
     begin
@@ -5085,6 +5107,68 @@ begin
     end;
 end;
 
+{$IFDEF VerbosePasParser}
+procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
+  );
+var
+  i: Integer;
+begin
+  if First=nil then
+    begin
+    write(Prefix,'First=nil');
+    if Last=nil then
+      writeln('=Last')
+    else
+      begin
+      writeln(', ERROR Last=',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    end
+  else if Last=nil then
+    begin
+    writeln(Prefix,'ERROR Last=nil First=',First.ClassName);
+    ParseExcSyntaxError;
+    end
+  else if First is TBinaryExpr then
+    begin
+    i:=0;
+    while First is TBinaryExpr do
+      begin
+      writeln(Prefix,Space(i*2),'bin.left=',TBinaryExpr(First).left.ClassName);
+      if First=Last then break;
+      First:=TBinaryExpr(First).right;
+      inc(i);
+      end;
+    if First<>Last then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not last in chain');
+      ParseExcSyntaxError;
+      end;
+    if not (Last is TBinaryExpr) then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not TBinaryExpr: ',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    if TBinaryExpr(Last).right=nil then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last.right=nil');
+      ParseExcSyntaxError;
+      end;
+    writeln(Prefix,Space(i*2),'last.right=',TBinaryExpr(Last).right.ClassName);
+    end
+  else if First=Last then
+    writeln(Prefix,'First=Last=',First.ClassName)
+  else
+    begin
+    write(Prefix,'ERROR First=',First.ClassName);
+    if Last<>nil then
+      writeln(' Last=',Last.ClassName)
+    else
+      writeln(' Last=nil');
+    end;
+end;
+{$ENDIF}
+
 function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
   AOpCode: TExprOpCode): TUnaryExpr;
 begin

packages/fcl-passrc/src/pscanner.pp

@@ -403,6 +403,7 @@ type
   TPascalScanner = class
   private
     FCurrentModeSwitches: TModeSwitches;
+    FForceCaret: Boolean;
     FLastMsg: string;
     FLastMsgArgs: TMessageArgs;
     FLastMsgNumber: integer;
@@ -420,6 +421,7 @@ type
     FOptions: TPOptions;
     FLogEvents: TPScannerLogEvents;
     FOnLog: TPScannerLogHandler;
+    FPreviousToken: TToken;
     FSkipComments: Boolean;
     FSkipWhiteSpace: Boolean;
     TokenStr: PChar;
@@ -484,6 +486,7 @@ type
 
     property CurToken: TToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
+    Property PreviousToken : TToken Read FPreviousToken;
 
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
@@ -497,6 +500,7 @@ type
     property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
     Property CurrentModeSwitches : TModeSwitches Read FCurrentModeSwitches Write FCurrentModeSwitches;
+    Property ForceCaret : Boolean Read FForceCaret Write FForceCaret;
   end;
 
 const
@@ -1262,6 +1266,7 @@ function TPascalScanner.FetchToken: TToken;
 var
   IncludeStackItem: TIncludeStackItem;
 begin
+  FPreviousToken:=FCurToken;
   while true do
   begin
     Result := DoFetchToken;
@@ -1403,9 +1408,14 @@ begin
   OldLength:=0;
   FCurTokenString := '';
 
-  while TokenStr[0] in ['#', ''''] do
+  while TokenStr[0] in ['^','#', ''''] do
   begin
     case TokenStr[0] of
+      '^' :
+        begin
+        TokenStart := TokenStr;
+        Inc(TokenStr);
+        end;
       '#':
         begin
           TokenStart := TokenStr;
@@ -2173,8 +2183,14 @@ begin
       end;
     '^':
       begin
+      if ForceCaret or
+         (PreviousToken in [tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET]) then
+        begin
         Inc(TokenStr);
         Result := tkCaret;
+        end
+      else
+        Result:=DoFetchTextToken;
       end;
     '\':
       begin

packages/fcl-passrc/tests/tcclasstype.pas

@@ -37,6 +37,7 @@ type
     Procedure EndClass(AEnd : String = 'end');
     Procedure AddMember(S : String);
     Procedure ParseClass;
+    Procedure ParseClassFail(Msg: string; MsgNumber: integer);
     Procedure DoParseClass(FromSpecial : Boolean = False);
     procedure SetUp; override;
     procedure TearDown; override;
@@ -92,6 +93,7 @@ type
     procedure TestHintFieldUninmplemented;
     Procedure TestMethodSimple;
     Procedure TestMethodSimpleComment;
+    Procedure TestMethodWithDotFails;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
@@ -329,6 +331,23 @@ begin
   DoParseClass(False);
 end;
 
+procedure TTestClassType.ParseClassFail(Msg: string; MsgNumber: integer);
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseClass;
+  except
+    on E: EParserError do
+      begin
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',MsgNumber,Parser.LastMsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
 procedure TTestClassType.DoParseClass(FromSpecial: Boolean);
 begin
   EndClass;
@@ -363,7 +382,6 @@ begin
     AssertNull('No helperfortype if not helper',TheClass.HelperForType);
   if TheClass.Members.Count>0 then
     FMember1:=TObject(TheClass.Members[0]) as TPaselement;
-
 end;
 
 procedure TTestClassType.SetUp;
@@ -409,6 +427,7 @@ procedure TTestClassType.AssertProperty(P: TPasProperty;
   AVisibility: TPasMemberVisibility; AName, ARead, AWrite, AStored,
   AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean);
 begin
+  AssertEquals('Property Name',AName,P.Name);
   AssertEquals(P.Name+': Visibility',AVisibility,P.Visibility);
   Assertequals(P.Name+': No args',AArgCount,P.Args.Count);
   Assertequals(P.Name+': Read accessor',ARead,P.ReadAccessorName);
@@ -768,6 +787,12 @@ begin
   AssertEquals('Comment','c'+sLineBreak,Method1.DocComment);
 end;
 
+procedure TTestClassType.TestMethodWithDotFails;
+begin
+  AddMember('Procedure DoSomething.Stupid');
+  ParseClassFail('Expected ";"',nParserExpectTokenError);
+end;
+
 procedure TTestClassType.TestClassMethodSimple;
 begin
   AddMember('Class Procedure DoSomething');

packages/fcl-passrc/tests/tcstatements.pas

@@ -1211,8 +1211,6 @@ procedure TTestStatementParser.TestCaseElseNoSemicolon;
 Var
   C : TPasImplCaseOf;
   S : TPasImplCaseStatement;
-  B : TPasImplbeginBlock;
-
 begin
   DeclareVar('integer');
   TestStatement(['case a of','1 : dosomething;','2 : dosomethingmore','else','a:=1;','end;']);

packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,7 +30,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestExpressions.TestUnaryDoubleDeref"/>
+        <CommandLineParams Value="--suite=TTestStatementParser.TestCaseElseNoSemicolon"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">

packages/pastojs/tests/tcconverter.pp

@@ -108,7 +108,6 @@ type
     Procedure TestMemberExpressionArrayTwoDim;
     Procedure TestVariable;
     Procedure TestArrayVariable;
-    procedure TestClassDecleration;
   end;
 
   { TTestStatementConverter }
@@ -374,6 +373,7 @@ Var
   I : TJSUnaryPostPlusPlusExpression;
   C : TJSRelationalExpressionLE;
   VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
   // For I:=1 to 100 do a:=b;
@@ -385,24 +385,27 @@ begin
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
   // Should be a list of two statements:
-  //   i:=1;
+  //   var $loopend1=100;
-  //   for(var $loopend=100; i<=$loopend; i++){ a:=b; }
+  //   for(i=1; i<=$loopend1; i++){ a:=b; }
-  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
+
-  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  // "var $loopend1=100"
-  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+  LoopEndVar:=DefaultLoopEndVarName+'1';
+  VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  AssertLiteral('Correct end value',VD.Init,100);
 
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
-  // "var $loopend=100"
+  // i:=1
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
+  A:=TJSSimpleAssignStatement(AssertElement('Init statement',TJSSimpleAssignStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
+  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
-  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
+  AssertLiteral('Init statement RHS is start value',A.Expr,1);
-  AssertLiteral('Correct end value',VD.Init,100);
 
-  // i<=$loopend
+  // i<=$loopend1
   C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
 
   // i++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
@@ -422,6 +425,7 @@ Var
   I : TJSUnaryPostMinusMinusExpression;
   C : TJSRelationalExpressionGE;
   VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
   // For I:=100 downto 1 do a:=b;
@@ -435,24 +439,27 @@ begin
   L:=TJSStatementList(Convert(F,TJSStatementList));
 
   // Should be a list of two statements:
-  //   i:=100;
+  //   var $loopend1=1;
-  //   for(var $loopend=1; i>=$loopend; i--){ a:=b; }
+  //   for(i=100; i>=$loopend1; i--){ a:=b; }
-  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
+
-  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  // "var $loopend1=1"
-  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+  LoopEndVar:=DefaultLoopEndVarName+'1';
+  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  AssertLiteral('Correct end value',VD.Init,1);
 
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
-  // "var $loopend=1"
+  // i=100;
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
+  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
+  AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
-  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
+  AssertLiteral('Init statement RHS is start value',A.Expr,100);
-  AssertLiteral('Correct end value',VD.Init,1);
 
-  // i>=$loopend
+  // i>=$loopend1
   C:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
 
   // i--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
@@ -596,7 +603,7 @@ Procedure TTestStatementConverter.TestTryExceptStatement;
 Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
 
 begin
@@ -605,7 +612,7 @@ begin
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
   F.AddElement(CreateAssignStatement('b','c'));
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
   L:=AssertListStatement('try..except block is statement list',El.Block);
   AssertAssignStatement('Correct assignment in try..except block',L.A,'a','b');
   AssertNull('No second statement',L.B);
@@ -621,7 +628,7 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
   IC : TJSRelationalExpressionInstanceOf;
@@ -647,7 +654,7 @@ begin
   O:=F.AddExceptOn('E','Exception');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
   AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
@@ -669,7 +676,7 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
   IC : TJSRelationalExpressionInstanceOf;
@@ -695,7 +702,7 @@ begin
   O:=F.AddExceptOn('E','Exception');
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
   AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
@@ -756,6 +763,7 @@ begin
   AssertNotNull('Convert returned a result',E);
   if not (E is TJSUnary) then
     Fail('Do not have unary class, but: '+E.ClassName);
+  AssertEquals('TTestExpressionConverter.TestUnaryExpression: wrong class',AClass.ClassName,E.ClassName);
   Result:=TJSUnary(E);
 end;
 
@@ -1186,27 +1194,7 @@ begin
   A:=TJSArrayLiteral(AssertElement('Init is array literal',TJSArrayLiteral,VD.Init));
   AssertEquals('No elements',0,A.Elements.Count);
 end;
-procedure TTestExpressionConverter.TestClassDecleration;
+
-var
-  C: TPasClassType;
-  Decl: TPasDeclarations;
-  Sl: TJSStatementList;
-  Uni: TJSUnary;
-  Asi: TJSSimpleAssignStatement;
-  pex: TJSPrimaryExpressionIdent;
-  Call: TJSCallExpression;
-begin
-  Decl:=TPasDeclarations.Create('',Nil);
-  C:=TPasClassType.Create('myclass',Nil);
-  Decl.Declarations.Add(c);
-  Sl:=TJSStatementList(Convert(Decl,TJSStatementList));
-  Uni:=TJSUnary(AssertElement('Sl.A is TJSUnary',TJSUnary,Sl.A));
-  Asi:=TJSSimpleAssignStatement(AssertElement('Sl.A is TJSUnary',TJSSimpleAssignStatement,Uni.A));
-  pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
-  AssertEquals('Correct name','myclass',String(pex.Name));
-  Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
-  if Call=nil then ;
-end;
 procedure TTestTestConverter.TestEmpty;
 begin
   AssertNotNull('Have converter',Converter);

packages/pastojs/tests/tcmodules.pas

@@ -112,6 +112,7 @@ type
     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);
     property PasProgram: TPasProgram Read FPasProgram;
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
@@ -154,6 +155,7 @@ type
     Procedure TestProcedureWithoutParams;
     Procedure TestPrgProcVar;
     Procedure TestProcTwoArgs;
+    Procedure TestProc_DefaultValue;
     Procedure TestUnitProcVar;
     Procedure TestFunctionResult;
     // ToDo: overloads
@@ -163,11 +165,12 @@ type
     Procedure TestAssignFunctionResult;
     Procedure TestFunctionResultInCondition;
     Procedure TestExit;
+    // ToDo: Procedure TestBreak;
+    // ToDo: Procedure TestContinue;
+    // ToDo: TestString; SetLength,Length,[],char
 
     // ToDo: pass by reference
 
-    // ToDo: procedure type
-
     // ToDo: enums
 
     // statements
@@ -179,30 +182,43 @@ type
     Procedure TestVarRecord;
     Procedure TestForLoop;
     Procedure TestForLoopInFunction;
+    Procedure TestForLoop_ReadVarAfter;
+    Procedure TestForLoop_Nested;
     Procedure TestRepeatUntil;
     Procedure TestAsmBlock;
     Procedure TestTryFinally;
-    // ToDo: try..except
+    Procedure TestTryExcept;
     Procedure TestCaseOf;
     Procedure TestCaseOf_UseSwitch;
     Procedure TestCaseOfNoElse;
     Procedure TestCaseOfNoElse_UseSwitch;
     Procedure TestCaseOfRange;
 
+    // arrays
+    Procedure TestArray;
+
     // classes
-    // ToDo: var
+    Procedure TestClass_TObjectDefaultConstructor;
-    // ToDo: inheritance
+    Procedure TestClass_TObjectConstructorWithParams;
-    // ToDo: constructor
+    Procedure TestClass_Var;
+    Procedure TestClass_Method;
+    Procedure TestClass_Inheritance;
+    Procedure TestClass_AbstractMethod;
+    Procedure TestClass_CallInherited_NoParams;
+    Procedure TestClass_CallInherited_WithParams;
+    // ToDo: Procedure TestClass_CallInheritedConstructor;
+    // ToDo: overload
     // ToDo: second constructor
     // ToDo: call another constructor within a constructor
-    // ToDo: newinstance
+    // ToDo: call class.classmethod
-    // ToDo: BeforeDestruction
+    // ToDo: call instance.classmethod
-    // ToDo: AfterConstruction
+    // ToDo: property
     // ToDo: event
 
     // ToDo: class of
+    // ToDo: call classof.classmethod
 
-    // ToDo: arrays
+    // ToDo: procedure type
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -428,6 +444,8 @@ begin
 end;
 
 procedure TTestModule.ParseModule;
+var
+  Row, Col: integer;
 begin
   FFirstPasStatement:=nil;
   try
@@ -436,22 +454,20 @@ begin
   except
     on E: EParserError do
       begin
+      WriteSource(E.Filename,E.Row,E.Column);
       writeln('ERROR: TTestModule.ParseModule Parser: '+E.ClassName+':'+E.Message
-        +' File='+Scanner.CurFilename
+        +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
-        +' LineNo='+IntToStr(Scanner.CurRow)
-        +' Col='+IntToStr(Scanner.CurColumn)
         +' Line="'+Scanner.CurLine+'"'
         );
       raise E;
       end;
     on E: EPasResolve do
       begin
+      Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
+      WriteSource(E.PasElement.SourceFilename,Row,Col);
       writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message
-        +' File='+Scanner.CurFilename
+        +' '+E.PasElement.SourceFilename
-        +' LineNo='+IntToStr(Scanner.CurRow)
+        +'('+IntToStr(Row)+','+IntToStr(Col)+')');
-        +' Col='+IntToStr(Scanner.CurColumn)
-        +' Line="'+Scanner.CurLine+'"'
-        );
       raise E;
       end;
     on E: Exception do
@@ -582,7 +598,7 @@ var
   FunBody: TJSFunctionBody;
   InitName: String;
 begin
-  FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
+  FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
   FJSSource:=TStringList.Create;
   FJSSource.Text:=JSToStr(JSModule);
   writeln('TTestModule.ConvertModule JS:');
@@ -809,6 +825,34 @@ begin
   until false;
 end;
 
+procedure TTestModule.WriteSource(aFilename: string; Row: integer; Col: integer
+  );
+var
+  LR: TLineReader;
+  CurRow: Integer;
+  Line: String;
+begin
+  LR:=FileResolver.FindSourceFile(aFilename);
+  writeln('Testcode:-File="',aFilename,'"----------------------------------:');
+  if LR=nil then
+    writeln('Error: file not loaded: "',aFilename,'"')
+  else
+    begin
+    CurRow:=0;
+    while not LR.IsEOF do
+      begin
+      inc(CurRow);
+      Line:=LR.ReadLine;
+      if (Row=CurRow) then
+        begin
+        write('*');
+        Line:=LeftStr(Line,Col-1)+'|'+copy(Line,Col,length(Line));
+        end;
+      writeln(Format('%:4d: ',[CurRow]),Line);
+      end;
+    end;
+end;
+
 procedure TTestModule.TestEmptyProgram;
 begin
   StartProgram(false);
@@ -1347,7 +1391,7 @@ begin
   Add('end;');
   Add('begin');
   ConvertProgram;
-  CheckSource('TestUnitImplVar',
+  CheckSource('TestExit',
     LinesToStr([ // statements
     'this.proca = function () {',
     '  return;',
@@ -1379,7 +1423,7 @@ begin
   Add('  v2:longint = 3;');
   Add('  v3:string = ''abc'';');
   ConvertUnit;
-  CheckSource('TestUnitImplVar',
+  CheckSource('TestUnitImplVars',
     LinesToStr([ // statements
     'var $impl = {',
     '};',
@@ -1401,7 +1445,7 @@ begin
   Add('  v2:longint = 4;');
   Add('  v3:string = ''abc'';');
   ConvertUnit;
-  CheckSource('TestUnitImplVar',
+  CheckSource('TestUnitImplConsts',
     LinesToStr([ // statements
     'var $impl = {',
     '};',
@@ -1426,7 +1470,7 @@ begin
   Add('initialization');
   Add('  r.i:=3;');
   ConvertUnit;
-  CheckSource('TestUnitImplVar',
+  CheckSource('TestUnitImplRecord',
     LinesToStr([ // statements
     'var $impl = {',
     '};',
@@ -1458,6 +1502,49 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_DefaultValue;
+begin
+  StartProgram(false);
+  Add('procedure p1(i: longint = 1);');
+  Add('begin');
+  Add('end;');
+  Add('procedure p2(i: longint = 1; c: char = ''a'');');
+  Add('begin');
+  Add('end;');
+  Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  p1;');
+  Add('  p1();');
+  Add('  p1(11);');
+  Add('  p2;');
+  Add('  p2();');
+  Add('  p2(12);');
+  Add('  p2(13,''b'');');
+  Add('  p3();');
+  ConvertProgram;
+  CheckSource('TestProc_DefaultValue',
+    LinesToStr([ // statements
+    'this.p1 = function (i) {',
+    '};',
+    'this.p2 = function (i,c) {',
+    '};',
+    'this.p3 = function (d,b,s) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.p1(1);',
+    '  this.p1(1);',
+    '  this.p1(11);',
+    '  this.p2(1,"a");',
+    '  this.p2(1,"a");',
+    '  this.p2(12,"a");',
+    '  this.p2(13,"b");',
+    '  this.p3(1.0,false,"abc");'
+    ]));
+end;
+
 procedure TTestModule.TestFunctionInt;
 begin
   StartProgram(false);
@@ -1467,7 +1554,7 @@ begin
   Add('end;');
   Add('begin');
   ConvertProgram;
-  CheckSource('TestProcTwoArgs',
+  CheckSource('TestFunctionInt',
     LinesToStr([ // statements
     'this.test = function (a) {',
     '  var result = 0;',
@@ -1489,7 +1576,7 @@ begin
   Add('end;');
   Add('begin');
   ConvertProgram;
-  CheckSource('TestProcTwoArgs',
+  CheckSource('TestFunctionString',
     LinesToStr([ // statements
     'this.test = function (a) {',
     '  var result = "";',
@@ -1538,7 +1625,7 @@ begin
   Add('    j:=j+i;');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestForLoop',
     LinesToStr([ // statements
     'this.i = 0;',
     'this.j = 0;',
@@ -1547,10 +1634,11 @@ begin
     LinesToStr([ // this.$main
     '  this.j = 0;',
     '  this.n = 3;',
-    '  this.i = 1;',
+    '  var $loopend1 = this.n;',
-    '  for (var $loopend = this.n; (this.i <= $loopend); this.i++) {',
+    '  for (this.i = 1; (this.i <= $loopend1); this.i++) {',
     '    this.j = (this.j + this.i);',
-    '  };'
+    '  };',
+    '  if ((this.i > $loopend1)) this.i--;'
     ]));
 end;
 
@@ -1570,15 +1658,15 @@ begin
   Add('begin');
   Add('  SumNumbers(3);');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestForLoopInFunction',
     LinesToStr([ // statements
     'this.sumnumbers = function (n) {',
     '  var result = 0;',
     '  var i = 0;',
     '  var j = 0;',
     '  j = 0;',
-    '  i = 1;',
+    '  var $loopend1 = n;',
-    '  for (var $loopend = n; (i <= $loopend); i++) {',
+    '  for (i = 1; (i <= $loopend1); i++) {',
     '    j = (j + i);',
     '  };',
     '  return result;',
@@ -1589,6 +1677,69 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestForLoop_ReadVarAfter;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  for i:=1 to 2 do ;');
+  Add('  if i=3 then ;');
+  ConvertProgram;
+  CheckSource('TestForLoop',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  var $loopend1 = 2;',
+    '  for (this.i = 1; (this.i <= $loopend1); this.i++);',
+    '  if((this.i>$loopend1))this.i--;',
+    '  if ((this.i==3)){} ;'
+    ]));
+end;
+
+procedure TTestModule.TestForLoop_Nested;
+begin
+  StartProgram(false);
+  Add('function SumNumbers(n: longint): longint;');
+  Add('var');
+  Add('  i, j, k: longint;');
+  Add('begin');
+  Add('  k:=0;');
+  Add('  for i:=1 to n do');
+  Add('  begin');
+  Add('    for j:=1 to i do');
+  Add('    begin');
+  Add('      k:=k+i;');
+  Add('    end;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  SumNumbers(3);');
+  ConvertProgram;
+  CheckSource('TestForLoopInFunction',
+    LinesToStr([ // statements
+    'this.sumnumbers = function (n) {',
+    '  var result = 0;',
+    '  var i = 0;',
+    '  var j = 0;',
+    '  var k = 0;',
+    '  k = 0;',
+    '  var $loopend1 = n;',
+    '  for (i = 1; (i <= $loopend1); i++) {',
+    '    var $loopend2 = i;',
+    '    for (j = 1; (j <= $loopend2); j++) {',
+    '      k = (k + i);',
+    '    };',
+    '  };',
+    '  return result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.sumnumbers(3);'
+    ]));
+end;
+
 procedure TTestModule.TestRepeatUntil;
 begin
   StartProgram(false);
@@ -1603,7 +1754,7 @@ begin
   Add('    j:=j+i;');
   Add('  until i>=n');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestRepeatUntil',
     LinesToStr([ // statements
     'this.i = 0;',
     'this.j = 0;',
@@ -1635,7 +1786,7 @@ begin
   Add('  end;');
   Add('  i:=4;');
   ConvertProgram;
-  CheckSource('TestAsm',
+  CheckSource('TestAsmBlock',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1661,7 +1812,7 @@ begin
   Add('    i:=3');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestTryFinally',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1675,6 +1826,69 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestTryExcept;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  Exception = class Msg: string; end;');
+  Add('  EInvalidCast = class(Exception) end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    i:=1;');
+  Add('  except');
+  Add('    i:=2');
+  Add('  end;');
+  Add('  try');
+  Add('    i:=3;');
+  Add('  except');
+  Add('    raise;');
+  Add('  end;');
+  Add('  try');
+  Add('    i:=4;');
+  Add('  except');
+  Add('    on EInvalidCast do');
+  Add('      raise;');
+  Add('    on E: Exception do');
+  Add('      if E.msg='''' then');
+  Add('        raise E;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestTryExcept',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "tobject", null, function () {',
+    '});',
+    'rtl.createClass(this, "exception", this.tobject, function () {',
+    '  this.msg = "";',
+    '});',
+    'rtl.createClass(this, "einvalidcast", this.exception, function () {',
+    '});',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'try {',
+    '  this.i = 1;',
+    '} catch {',
+    '  this.i = 2;',
+    '};',
+    'try {',
+    '  this.i = 3;',
+    '} catch (exceptobject) {',
+    '  throw exceptobject;',
+    '};',
+    'try {',
+    '  this.i = 4;',
+    '} catch (exceptobject) {',
+    '  if (this.einvalidcast.isPrototypeOf(exceptobject)) throw exceptobject;',
+    '  if (this.exception.isPrototypeOf(exceptobject)) {',
+    '    var e = exceptobject;',
+    '    if ((e.msg == "")) throw e;',
+    '  };',
+    '};'
+    ]));
+end;
+
 procedure TTestModule.TestCaseOf;
 begin
   StartProgram(false);
@@ -1687,7 +1901,7 @@ begin
   Add('    i:=4');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestCaseOf',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1712,7 +1926,7 @@ begin
   Add('    i:=4');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestCaseOf_UseSwitch',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1738,7 +1952,7 @@ begin
   Add('  1: begin i:=2; i:=3; end;');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestCaseOfNoElse',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1761,7 +1975,7 @@ begin
   Add('  1: begin i:=2; i:=3; end;');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestCaseOfNoElse_UseSwitch',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1787,7 +2001,7 @@ begin
   Add('  else ;');
   Add('  end;');
   ConvertProgram;
-  CheckSource('TestVarRecord',
+  CheckSource('TestCaseOfRange',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -1798,6 +2012,390 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClass_TObjectDefaultConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('    destructor Destroy;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin end;');
+  Add('destructor TObject.Destroy;');
+  Add('begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TObject.Create;');
+  Add('  o.Destroy;');
+  ConvertProgram;
+  CheckSource('TestClass_TObjectDefaultConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.create = function(){',
+    '  };',
+    '  this.destroy = function(){',
+    '  };',
+    '});',
+    'this.o = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.o = this.tobject.$create("create");',
+    'this.o.$destroy("destroy");'
+    ]));
+end;
+
+procedure TTestModule.TestClass_TObjectConstructorWithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create(p: longint);');
+  Add('  end;');
+  Add('constructor TObject.Create(p: longint);');
+  Add('begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TObject.Create(3);');
+  ConvertProgram;
+  CheckSource('TestClass_TObjectConstructorWithParams',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.create = function(p){',
+    '  };',
+    '});',
+    'this.o = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.o = this.tobject.$create("create",[3]);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Var;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    i: longint;');
+  Add('    constructor Create(p: longint);');
+  Add('  end;');
+  Add('constructor TObject.Create(p: longint);');
+  Add('begin');
+  Add('  i:=p+3');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TObject.Create(4);');
+  Add('  o.i:=o.i+5;');
+  ConvertProgram;
+  CheckSource('TestClass_Var',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.i = 0;',
+    '  this.create = function(p){',
+    '    this.i = (p+3);',
+    '  };',
+    '});',
+    'this.o = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.o = this.tobject.$create("create",[4]);',
+    'this.o.i = (this.o.i + 5);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Method;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    i: longint;');
+  Add('    Sub: TObject;');
+  Add('    constructor Create;');
+  Add('    function GetIt(p: longint): TObject;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetIt(p: longint): TObject;');
+  Add('begin');
+  Add('  Self.i:=p+3;');
+  Add('  Result:=Self.Sub;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TObject.Create;');
+  Add('  o.GetIt(4);');
+  Add('  o.Sub.Sub:=nil;');
+  Add('  o.Sub.GetIt(5);');
+  Add('  o.Sub.GetIt(6).Sub:=nil;');
+  Add('  o.Sub.GetIt(7).GetIt(8);');
+  Add('  o.Sub.GetIt(9).Sub.GetIt(10);');
+  ConvertProgram;
+  CheckSource('TestClass_Method',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.i = 0;',
+    '  this.sub = null;',
+    '  this.create = function(){',
+    '  };',
+    '  this.getit = function(p){',
+    '    var result = null;',
+    '    this.i = (p + 3);',
+    '    result = this.sub;',
+    '    return result;',
+    '  };',
+    '});',
+    'this.o = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.o = this.tobject.$create("create");',
+    'this.o.getit(4);',
+    'this.o.sub.sub=null;',
+    'this.o.sub.getit(5);',
+    'this.o.sub.getit(6).sub=null;',
+    'this.o.sub.getit(7).getit(8);',
+    'this.o.sub.getit(9).sub.getit(10);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Inheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('  end;');
+  Add('  TClassB = class(TObject)');
+  Add('    procedure ProcB;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('procedure TClassB.ProcB; begin end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  a: TClassA;');
+  Add('  b: TClassB;');
+  Add('begin');
+  Add('  o:=TObject.Create;');
+  Add('  a:=TClassA.Create;');
+  Add('  b:=TClassB.Create;');
+  Add('  if o is TClassA then ;');
+  Add('  b:=o as TClassB;');
+  Add('  (o as TClassB).ProcB;');
+  ConvertProgram;
+  CheckSource('TestClass_Inheritance',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.create = function () {',
+    '  };',
+    '});',
+    'rtl.createClass(this,"tclassa",this.tobject,function(){',
+    '});',
+    'rtl.createClass(this,"tclassb",this.tobject,function(){',
+    '  this.procb = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    'this.a = null;',
+    'this.b = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.o = this.tobject.$create("create");',
+    'this.a = this.tclassa.$create("create");',
+    'this.b = this.tclassb.$create("create");',
+    'if (this.tclassa.isPrototypeOf(this.o)) {',
+    '};',
+    'this.b = rtl.as(this.o, this.tclassb);',
+    'rtl.as(this.o, this.tclassb).procb();'
+    ]));
+end;
+
+procedure TTestModule.TestClass_AbstractMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    procedure DoIt; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_AbstractMethod',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClass_CallInherited_NoParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoAbstract; virtual; abstract;');
+  Add('    procedure DoVirtual; virtual;');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('  TA = class');
+  Add('    procedure DoAbstract; override;');
+  Add('    procedure DoVirtual; override;');
+  Add('    procedure DoSome;');
+  Add('  end;');
+  Add('procedure TObject.DoVirtual;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('end;');
+  Add('procedure TObject.DoIt;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TA.DoAbstract;');
+  Add('begin');
+  Add('  inherited DoVirtual; // call TObject.DoVirtual');
+  Add('end;');
+  Add('procedure TA.DoVirtual;');
+  Add('begin');
+  Add('  inherited; // call TObject.DoVirtual');
+  Add('  inherited DoVirtual; // call TObject.DoVirtual');
+  Add('  inherited DoVirtual(); // call TObject.DoVirtual');
+  Add('  DoIt;');
+  Add('  DoIt();');
+  Add('end;');
+  Add('procedure TA.DoSome;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor method -> silently ignore');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInherited_NoParams',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.dovirtual = function () {',
+    '  };',
+    '  this.doit = function () {',
+    '  };',
+    '});',
+    'rtl.createClass(this, "ta", this.tobject, function () {',
+    '  this.doabstract = function () {',
+    '    pas.program.tobject.dovirtual.call(this);',
+    '  };',
+    '  this.dovirtual = function () {',
+    '    pas.program.tobject.dovirtual.apply(this, arguments);',
+    '    pas.program.tobject.dovirtual.call(this);',
+    '    pas.program.tobject.dovirtual.call(this);',
+    '    this.doit();',
+    '    this.doit();',
+    '  };',
+    '  this.dosome = function () {',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClass_CallInherited_WithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoAbstract(a: longint; b: longint = 0); virtual; abstract;');
+  Add('    procedure DoVirtual(a: longint; b: longint = 0); virtual;');
+  Add('    procedure DoIt(a: longint; b: longint = 0);');
+  Add('    procedure DoIt2(a: longint = 1; b: longint = 2);');
+  Add('  end;');
+  Add('  TA = class');
+  Add('    procedure DoAbstract(a: longint; b: longint = 0); override;');
+  Add('    procedure DoVirtual(a: longint; b: longint = 0); override;');
+  Add('  end;');
+  Add('procedure TObject.DoVirtual(a: longint; b: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(a: longint; b: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt2(a: longint; b: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TA.DoAbstract(a: longint; b: longint = 0);');
+  Add('begin');
+  Add('  inherited DoVirtual(a,b); // call TObject.DoVirtual(a,b)');
+  Add('  inherited DoVirtual(a); // call TObject.DoVirtual(a,0)');
+  Add('end;');
+  Add('procedure TA.DoVirtual(a: longint; b: longint = 0);');
+  Add('begin');
+  Add('  inherited; // call TObject.DoVirtual(a,b)');
+  Add('  inherited DoVirtual(a,b); // call TObject.DoVirtual(a,b)');
+  Add('  inherited DoVirtual(a); // call TObject.DoVirtual(a,0)');
+  Add('  DoIt(a,b);');
+  Add('  DoIt(a);');
+  Add('  DoIt2(a);');
+  Add('  DoIt2;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInherited_WithParams',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"tobject",null,function(){',
+    '  this.dovirtual = function (a,b) {',
+    '  };',
+    '  this.doit = function (a,b) {',
+    '  };',
+    '  this.doit2 = function (a,b) {',
+    '  };',
+    '});',
+    'rtl.createClass(this, "ta", this.tobject, function () {',
+    '  this.doabstract = function (a,b) {',
+    '    pas.program.tobject.dovirtual.call(this,a,b);',
+    '    pas.program.tobject.dovirtual.call(this,a,0);',
+    '  };',
+    '  this.dovirtual = function (a,b) {',
+    '    pas.program.tobject.dovirtual.apply(this, arguments);',
+    '    pas.program.tobject.dovirtual.call(this,a,b);',
+    '    pas.program.tobject.dovirtual.call(this,a,0);',
+    '    this.doit(a,b);',
+    '    this.doit(a,0);',
+    '    this.doit2(a,2);',
+    '    this.doit2(1,2);',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('var');
+  Add('  a: TArrayInt;');
+  Add('begin');
+  Add('  SetLength(a,3);');
+  Add('  a[0]:=4;');
+  Add('  a[1]:=length(a)+a[0];');
+  ConvertProgram;
+  CheckSource('TestArray',
+    LinesToStr([ // statements
+    'this.a = [];'
+    ]),
+    LinesToStr([ // this.$main
+    'rtl.setArrayLength(this.a,3,0);',
+    'this.a[0]=4;',
+    'this.a[1]=(rtl.length(this.a)+this.a[0]);'
+    ]));
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.