* Patch from Mattias Gaertner: Record support, detect duplicate identifiers, bug fixes

git-svn-id: trunk@34520 -

.gitattributes

@@ -6627,6 +6627,7 @@ packages/pastojs/Makefile.fpc svneol=native#text/plain
 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/testpas2js.lpi svneol=native#text/plain
 packages/pastojs/tests/testpas2js.pp svneol=native#text/plain
 packages/pastojs/todo.txt svneol=native#text/plain

packages/fcl-js/src/jstree.pp

@@ -120,7 +120,7 @@ Type
     Constructor Create;
     Destructor Destroy; override;
     Property Params : TStrings Read FParams Write SetParams;
-    Property Body : TJSFunctionBody Read FBody Write FBody;
+    Property Body : TJSFunctionBody Read FBody Write FBody; // can be nil
     Property Name : TJSString Read FName Write FName;
     Property IsEmpty : Boolean Read FIsEmpty Write FIsEmpty;
   end;

packages/fcl-js/src/jswriter.pp

@@ -474,15 +474,17 @@ begin
   if Not (C or FD.IsEmpty) then
     begin
     Writeln('');
-    indent;
+    Indent;
     end;
   if Assigned(FD.Body) then
     begin
     FSkipBrackets:=True;
+    //writeln('TJSWriter.WriteFuncDef '+FD.Body.ClassName);
     WriteJS(FD.Body);
     If (Assigned(FD.Body.A))
     and (not (FD.Body.A is TJSStatementList))
     and (not (FD.Body.A is TJSSourceElements))
+    and (not (FD.Body.A is TJSEmptyBlockStatement))
     then
       if C then
         Write('; ')
@@ -493,7 +495,7 @@ begin
     Write('}')
   else
     begin
-    undent;
+    Undent;
     Write('}'); // do not writeln
     end;
 end;
@@ -697,14 +699,20 @@ Var
   LastEl: TJSElement;
 
 begin
+  //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipBrackets,true));
+  //if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
+  //if El.B<>nil then write(' El.B='+El.B.ClassName) else write(' El.B=nil');
+  //writeln(' ');
+
   C:=(woCompact in Options);
   B:= Not FSkipBrackets;
   if B then
     begin
     Write('{');
+    Indent;
     if not C then writeln('');
     end;
-  if Assigned(El.A) then
+  if Assigned(El.A) and (El.A.ClassType<>TJSEmptyBlockStatement) then
     begin
     WriteJS(El.A);
     LastEl:=El.A;
@@ -726,8 +734,8 @@ begin
     end;
   if B then
     begin
-    Write('}');
-    if not C then writeln('');
+    Undent;
+    Write('}'); // do not writeln
     end;
 end;
 
@@ -865,7 +873,10 @@ begin
     begin
     Write('do ');
     if Assigned(El.Body) then
+      begin
+      FSkipBrackets:=false;
       WriteJS(El.Body);
+      end;
     Write(' while (');
     If Assigned(El.Cond) then
       WriteJS(EL.Cond);
@@ -1052,7 +1063,8 @@ end;
 procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody);
 
 begin
-  if Assigned(El.A) then
+  //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipBrackets,'true','false'));
+  if Assigned(El.A) and (not (El.A is TJSEmptyBlockStatement)) then
     WriteJS(El.A);
 end;
 

packages/fcl-js/tests/tcwriter.pp

@@ -1399,7 +1399,7 @@ Var
 begin
 //  Writer.Options:=[woCompact,woUseUTF8];
   S:=TJSStatementList.Create(0,0);
-  AssertWrite('Statement list','{'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list','{'+sLineBreak+'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListEmptyCompact;
@@ -1420,7 +1420,7 @@ begin
 //  Writer.Options:=[woCompact,woUseUTF8];
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListOneStatementCompact;
@@ -1444,7 +1444,7 @@ begin
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
   S.B:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'a = b;'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'a = b;'+sLineBreak+'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListTwoStatementsCompact;

packages/fcl-js/tests/testjs.lpr

@@ -3,7 +3,10 @@ program testjs;
 {$mode objfpc}{$H+}
 
 uses
-  cwstring,Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
+  {$IFDEF Unix}
+  cwstring,
+  {$ENDIF}
+  Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
   tcparser, jswriter, tcwriter, jstoken;
 
 var

packages/fcl-passrc/src/pasresolver.pp

@@ -38,9 +38,12 @@
   - case of
   - try..finally..except, on, else, raise
   - for loop
+  - spot duplicates
 
  ToDo:
-  - spot duplicates
+   - records - TPasRecordType,
+     - variant - TPasVariant
+     - const  TRecordValues
   - check if types only refer types
   - nested forward procs, nested must be resolved before proc body
   - program/library/implementation forward procs
@@ -49,9 +52,6 @@
   - enums - TPasEnumType, TPasEnumValue
     - propagate to parent scopes
   - ranges TPasRangeType
-  - records - TPasRecordType,
-    - variant - TPasVariant
-    - const  TRecordValues
   - arrays  TPasArrayType
     - const TArrayValues
   - pointer TPasPointerType
@@ -102,6 +102,7 @@ const
   nIncompatibleTypeArgNo = 3006;
   nIncompatibleTypeArgNoVarParamMustMatchExactly = 3007;
   nVariableIdentifierExpected = 3008;
+  nDuplicateIdentifier = 3009;
 
 // resourcestring patterns of messages
 resourcestring
@@ -113,6 +114,7 @@ resourcestring
   sIncompatibleTypeArgNo = 'Incompatible type arg no. %s: Got "%s", expected "%s"';
   sIncompatibleTypeArgNoVarParamMustMatchExactly = 'Incompatible type arg no. %s: Got "%s", expected "%s". Var param must match exactly.';
   sVariableIdentifierExpected = 'Variable identifier expected';
+  sDuplicateIdentifier = 'Duplicate identifier "%s" at %s';
 
 type
   TResolveBaseType = (
@@ -388,6 +390,11 @@ type
   TPasProcedureScope = Class(TPasIdentifierScope)
   end;
 
+  { TPasRecordScope }
+
+  TPasRecordScope = Class(TPasIdentifierScope)
+  end;
+
   { TPasExceptOnScope }
 
   TPasExceptOnScope = Class(TPasIdentifierScope)
@@ -427,6 +434,17 @@ type
     property CurModule: TPasModule read FCurModule write SetCurModule;
   end;
 
+  { TPasSubRecordScope }
+
+  TPasSubRecordScope = Class(TPasSubScope)
+  public
+    RecordScope: TPasRecordScope;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+  end;
+
   TPasResolvedKind = (
     rkNone,
     rkIdentifier, // IdentEl is a type, var, const, property, proc, etc, built-in types have IdentEl=nil
@@ -492,18 +510,23 @@ type
   protected
     procedure SetCurrentParser(AValue: TPasParser); override;
     procedure CheckTopScope(ExpectedClass: TPasScopeClass);
+    function AddIdentifier(Scope: TPasIdentifierScope;
+      const aName: String; El: TPasElement;
+      const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
     procedure AddModule(El: TPasModule);
     procedure AddSection(El: TPasSection);
     procedure AddType(El: TPasType);
+    Procedure AddRecordType(El: TPasRecordType);
     procedure AddVariable(El: TPasVariable);
     procedure AddProcedure(El: TPasProcedure);
     procedure AddArgument(El: TPasArgument);
     procedure AddFunctionResult(El: TPasResultElement);
     procedure AddExceptOn(El: TPasImplExceptOn);
     procedure StartProcedureBody(El: TProcedureBody);
-    procedure FinishModule;
+    procedure FinishModule(CurModule: TPasModule);
     procedure FinishUsesList;
     procedure FinishTypeSection;
+    procedure FinishTypeDef(El: TPasType);
     procedure FinishProcedure;
     procedure FinishProcedureHeader;
     procedure FinishExceptOnExpr;
@@ -534,9 +557,10 @@ type
     procedure IterateElements(const aName: string;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
       var Abort: boolean); virtual;
-    procedure FinishScope(ScopeType: TPasScopeType); override;
+    procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
     class procedure UnmangleSourceLineNumber(LineNumber: integer;
       out Line, Column: integer);
+    class function GetElementSourcePosStr(El: TPasElement): string;
     procedure Clear; virtual;
     procedure AddObjFPCBuiltInIdentifiers(BaseTypes: TResolveBaseTypes = btAllStandardTypes);
     function CreateReference(DeclEl, RefEl: TPasElement): TResolvedReference; virtual;
@@ -810,6 +834,21 @@ begin
   ResolvedType.ExprEl:=ExprEl;
 end;
 
+{ TPasSubRecordScope }
+
+function TPasSubRecordScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=RecordScope.FindIdentifier(Identifier);
+end;
+
+procedure TPasSubRecordScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+begin
+  RecordScope.IterateElements(aName, OnIterateElement, Data, Abort);
+end;
+
 { TPasIdentifier }
 
 procedure TPasIdentifier.SetElement(AValue: TPasElement);
@@ -1135,12 +1174,26 @@ begin
     RaiseInternalError('Expected TopScope='+ExpectedClass.ClassName+' but found '+TopScope.ClassName);
 end;
 
-procedure TPasResolver.FinishModule;
+function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
+  const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
+  ): TPasIdentifier;
+var
+  Identifier, OlderIdentifier: TPasIdentifier;
+begin
+  Identifier:=Scope.AddIdentifier(aName,El,Kind);
+  OlderIdentifier:=Identifier.NextSameIdentifier;
+  // check duplicate
+  if OlderIdentifier<>nil then
+    if (Identifier.Kind=pikSimple) or (OlderIdentifier.Kind=pikSimple) then
+      RaiseMsg(nDuplicateIdentifier,sDuplicateIdentifier,
+               [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El);
+  Result:=Identifier;
+end;
+
+procedure TPasResolver.FinishModule(CurModule: TPasModule);
 var
   CurModuleClass: TClass;
-  CurModule: TPasModule;
 begin
-  CurModule:=CurrentParser.CurModule;
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishModule START ',CurModule.Name);
   {$ENDIF}
@@ -1199,7 +1252,7 @@ begin
     if (El.ClassType=TProgramSection) then
       RaiseInternalError('used unit is a program: '+GetObjName(El));
 
-    Scope.AddIdentifier(El.Name,El,pikSimple);
+    AddIdentifier(Scope,El.Name,El,pikSimple);
 
     // check used unit
     PublicEl:=nil;
@@ -1226,6 +1279,18 @@ begin
   // ToDo: resolve pending forwards
 end;
 
+procedure TPasResolver.FinishTypeDef(El: TPasType);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
+  {$ENDIF}
+  if TopScope.Element=El then
+    begin
+    if TopScope.ClassType=TPasRecordScope then
+      PopScope;
+    end;
+end;
+
 procedure TPasResolver.FinishProcedure;
 var
   aProc: TPasProcedure;
@@ -1244,6 +1309,7 @@ procedure TPasResolver.FinishProcedureHeader;
 begin
   CheckTopScope(TPasProcedureScope);
   // ToDo: check class
+  // ToDo: check duplicate
 end;
 
 procedure TPasResolver.FinishExceptOnExpr;
@@ -1260,7 +1326,7 @@ begin
     Expr:=TPrimitiveExpr(El.VarExpr);
     if Expr.Kind<>pekIdent then
       RaiseNotYetImplemented(Expr);
-    TPasExceptOnScope(FTopScope).AddIdentifier(Expr.Value,Expr,pikSimple);
+    AddIdentifier(TPasExceptOnScope(FTopScope),Expr.Value,Expr,pikSimple);
     end;
   if El.TypeExpr<>nil then
     ResolveExpr(El.TypeExpr);
@@ -1287,6 +1353,8 @@ procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
 begin
   //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
   if El=nil then
+  else if El.ClassType=TPasImplBeginBlock then
+    ResolveImplBlock(TPasImplBeginBlock(El))
   else if El.ClassType=TPasImplAssign then
     begin
     ResolveExpr(TPasImplAssign(El).left);
@@ -1334,10 +1402,11 @@ begin
   else if El.ClassType=TPasImplCommand then
     begin
     if TPasImplCommand(El).Command<>'' then
-      RaiseNotYetImplemented(El);
+      RaiseNotYetImplemented(El,'TPasResolver.ResolveImplElement');
     end
+  else if El.ClassType=TPasImplAsmStatement then
   else
-    RaiseNotYetImplemented(El);
+    RaiseNotYetImplemented(El,'TPasResolver.ResolveImplElement');
 end;
 
 procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
@@ -1423,6 +1492,7 @@ end;
 
 procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr);
 begin
+  //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
   ResolveExpr(El.left);
   if El.right=nil then exit;
   case El.OpCode of
@@ -1469,6 +1539,9 @@ var
   DeclEl: TPasElement;
   ModuleScope: TPasSubModuleScope;
   aModule: TPasModule;
+  VarType: TPasType;
+  RecScope: TPasRecordScope;
+  SubScope: TPasSubRecordScope;
 begin
   //writeln('TPasResolver.ResolveSubIdent El.left=',GetObjName(El.left));
   if El.left.ClassType=TPrimitiveExpr then
@@ -1512,13 +1585,38 @@ begin
         PushScope(ModuleScope);
         ResolveExpr(El.right);
         PopScope;
+        exit;
+        end
+      else if DeclEl.ClassType=TPasVariable then
+        begin
+        VarType:=TPasVariable(DeclEl).VarType;
+        if VarType.ClassType=TPasRecordType then
+          begin
+          RecScope:=TPasRecordType(VarType).CustomData as TPasRecordScope;
+          SubScope:=TPasSubRecordScope.Create;
+          SubScope.Owner:=Self;
+          SubScope.RecordScope:=RecScope;
+          PushScope(SubScope);
+          ResolveExpr(El.right);
+          PopScope;
+          exit;
+          end
+        else
+          begin
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.ResolveSubIdent DeclEl=',GetObjName(DeclEl),' VarType=',GetObjName(VarType));
+          {$ENDIF}
+          end;
+          end;
+        end
+      else
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ResolveSubIdent DeclEl=',GetObjName(DeclEl));
+        {$ENDIF}
         end;
-      end
-    else
-      RaiseMsg(nIllegalQualifier,sIllegalQualifier,['.'],El);
-    end
-  else
-    RaiseMsg(nIllegalQualifier,sIllegalQualifier,['.'],El);
+    end;
+  RaiseMsg(nIllegalQualifier,sIllegalQualifier,['.'],El);
 end;
 
 procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr);
@@ -1558,7 +1656,7 @@ begin
     CreateReference(FindData.Found,Params.Value);
     end
   else
-    RaiseNotYetImplemented(Params,' with parameters');
+    RaiseNotYetImplemented(Params,'with parameters');
 end;
 
 procedure TPasResolver.AddModule(El: TPasModule);
@@ -1615,7 +1713,21 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(El);
-  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddRecordType(El: TPasRecordType);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(El);
+  if El.Name<>'' then
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+
+  if El.Parent.ClassType<>TPasVariant then
+    PushScope(El,TPasRecordScope);
 end;
 
 procedure TPasResolver.AddVariable(El: TPasVariable);
@@ -1626,7 +1738,7 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(El);
-  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 end;
 
 procedure TPasResolver.AddProcedure(El: TPasProcedure);
@@ -1636,7 +1748,7 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(El);
-  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikProc);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikProc);
   PushScope(El,TPasProcedureScope);
 end;
 
@@ -1649,14 +1761,14 @@ begin
   {$ENDIF}
   if not (TopScope is TPasProcedureScope) then
     RaiseInvalidScopeForElement(El);
-  TPasProcedureScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+  AddIdentifier(TPasProcedureScope(TopScope),El.Name,El,pikSimple);
 end;
 
 procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
 begin
   if TopScope.ClassType<>TPasProcedureScope then
     RaiseInvalidScopeForElement(El);
-  TPasProcedureScope(TopScope).AddIdentifier(ResolverResultVar,El,pikSimple);
+  AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple);
 end;
 
 procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
@@ -1727,7 +1839,7 @@ begin
   writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
   {$ENDIF}
   if (AParent=nil) and (FRootElement<>nil)
-  and (not AClass.InheritsFrom(TPasUnresolvedTypeRef)) then
+  and (AClass<>TPasUnresolvedTypeRef) then
     RaiseInternalError('TPasResolver.CreateElement more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
 
   if ASrcPos.FileName='' then
@@ -1751,30 +1863,41 @@ begin
     FRootElement:=Result;
 
   // create scope
-  if AClass.InheritsFrom(TPasType) then
-    AddType(TPasType(El))
-  else if (AClass.ClassType=TPasVariable)
-      or (AClass.ClassType=TPasConst)
-      or (AClass.ClassType=TPasProperty) then
+  if (AClass=TPasVariable)
+      or (AClass=TPasConst)
+      or (AClass=TPasProperty) then
     AddVariable(TPasVariable(El))
-  else if AClass.ClassType=TPasArgument then
+  else if AClass=TPasArgument then
     AddArgument(TPasArgument(El))
+  else if AClass=TPasUnresolvedTypeRef then
+  else if (AClass=TPasAliasType)
+      or (AClass=TPasProcedureType)
+      or (AClass=TPasFunctionType) then
+    AddType(TPasType(El))
+  else if AClass=TPasRecordType then
+    AddRecordType(TPasRecordType(El))
+  else if AClass=TPasVariant then
   else if AClass.InheritsFrom(TPasProcedure) then
     AddProcedure(TPasProcedure(El))
-  else if AClass.ClassType=TPasResultElement then
+  else if AClass=TPasResultElement then
     AddFunctionResult(TPasResultElement(El))
-  else if AClass.ClassType=TProcedureBody then
+  else if AClass=TProcedureBody then
     StartProcedureBody(TProcedureBody(El))
-  else if AClass.InheritsFrom(TPasSection) then
+  else if AClass=TPasImplExceptOn then
+    AddExceptOn(TPasImplExceptOn(El))
+  else if AClass=TPasImplLabelMark then
+  else if AClass=TPasOverloadedProc then
+  else if (AClass=TInterfaceSection)
+      or (AClass=TImplementationSection)
+      or (AClass=TProgramSection)
+      or (AClass=TLibrarySection) then
     AddSection(TPasSection(El))
-  else if AClass.InheritsFrom(TPasModule) then
+  else if (AClass=TPasModule)
+      or (AClass=TPasProgram)
+      or (AClass=TPasLibrary) then
     AddModule(TPasModule(El))
   else if AClass.InheritsFrom(TPasExpr) then
-  else if AClass.ClassType=TPasImplExceptOn then
-    AddExceptOn(TPasImplExceptOn(El))
   else if AClass.InheritsFrom(TPasImplBlock) then
-  else if AClass.ClassType=TPasImplLabelMark then
-  else if AClass.ClassType=TPasOverloadedProc then
   else
     RaiseNotYetImplemented(El);
 end;
@@ -1818,13 +1941,13 @@ begin
     end;
 end;
 
-procedure TPasResolver.FinishScope(ScopeType: TPasScopeType);
+procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
 begin
   case ScopeType of
-  stModule: FinishModule;
+  stModule: FinishModule(El as TPasModule);
   stUsesList: FinishUsesList;
   stTypeSection: FinishTypeSection;
-  stTypeDef: ;
+  stTypeDef: FinishTypeDef(El as TPasType);
   stProcedure: FinishProcedure;
   stProcedureHeader: FinishProcedureHeader;
   stExceptOnExpr: FinishExceptOnExpr;
@@ -1846,6 +1969,18 @@ begin
   end;
 end;
 
+class function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
+var
+  Line, Column: integer;
+begin
+  if El=nil then exit('nil');
+  UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
+  Result:=El.SourceFilename+'('+IntToStr(Line);
+  if Column>0 then
+    Result:=Result+','+IntToStr(Column);
+  Result:=Result+')';
+end;
+
 destructor TPasResolver.Destroy;
 begin
   Clear;
@@ -1876,7 +2011,7 @@ var
   bt: TResolveBaseType;
 begin
   for bt in BaseTypes do
-    FDefaultScope.AddIdentifier(BaseTypeNames[bt],
+    AddIdentifier(FDefaultScope,BaseTypeNames[bt],
       TPasUnresolvedSymbolRef.Create(BaseTypeNames[bt],nil),pikCustom);
 end;
 
@@ -1885,12 +2020,10 @@ function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement
 
   procedure RaiseAlreadySet;
   var
-    aLine, aCol: integer;
     FormerDeclEl: TPasElement;
   begin
     writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
-    UnmangleSourceLineNumber(RefEl.SourceLinenumber,aLine,aCol);
-    writeln('  RefEl at ',RefEl.SourceFilename,'(',aLine,',',aCol,')');
+    writeln('  RefEl at ',GetElementSourcePosStr(RefEl));
     writeln('  RefEl.CustomData=',GetObjName(RefEl.CustomData));
     if RefEl.CustomData is TResolvedReference then
       begin
@@ -1969,7 +2102,9 @@ begin
   FScopes[FScopeCount]:=Scope;
   inc(FScopeCount);
   FTopScope:=Scope;
+  {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope),' IsDefault=',FDefaultScope=FTopScope);
+  {$ENDIF}
 end;
 
 procedure TPasResolver.SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
@@ -1997,8 +2132,13 @@ begin
 end;
 
 procedure TPasResolver.RaiseNotYetImplemented(El: TPasElement; Msg: string);
+var
+  s: String;
 begin
-  RaiseMsg(nNotYetImplemented,sNotYetImplemented+Msg,[GetObjName(El)],El);
+  s:=sNotYetImplemented;
+  if Msg<>'' then
+    s:=s+Msg;
+  RaiseMsg(nNotYetImplemented,s,[GetObjName(El)],El);
 end;
 
 procedure TPasResolver.RaiseInternalError(const Msg: string);

packages/fcl-passrc/src/pastree.pp

@@ -558,8 +558,7 @@ type
   public
     PackMode: TPackMode;
     Members: TFPList;     // array of TPasVariable elements
-    VariantName: string;
-    VariantType: TPasType;
+    VariantEl: TPasElement; // TPasVariable or TPasType
     Variants: TFPList;	// array of TPasVariant elements, may be nil!
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
@@ -2173,8 +2172,8 @@ begin
     TPasVariable(Members[i]).Release;
   Members.Free;
 
-  if Assigned(VariantType) then
-    VariantType.Release;
+  if Assigned(VariantEl) then
+    VariantEl.Release;
 
   if Assigned(Variants) then
   begin
@@ -3125,10 +3124,10 @@ begin
   if Variants<>nil then
     begin
     temp:='case ';
-    if (VariantName<>'') then
-      temp:=Temp+variantName+' : ';
-    if (VariantType<>Nil) then
-      temp:=temp+VariantType.Name;
+    if (VariantEl is TPasVariable) then
+      temp:=Temp+VariantEl.Name+' : '+TPasVariable(VariantEl).VarType.Name
+    else if (VariantEl<>Nil) then
+      temp:=temp+VariantEl.Name;
     S.Add(temp+' of');
     T.Clear;
     For I:=0 to Variants.Count-1 do
@@ -3175,8 +3174,8 @@ begin
   inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to Members.Count-1 do
     TPasElement(Members[i]).ForEachCall(aMethodCall,Arg);
-  if VariantType<>nil then
-    VariantType.ForEachCall(aMethodCall,Arg);
+  if VariantEl<>nil then
+    VariantEl.ForEachCall(aMethodCall,Arg);
   if Variants<>nil then
     for i:=0 to Variants.Count-1 do
       TPasElement(Variants[i]).ForEachCall(aMethodCall,Arg);

packages/fcl-passrc/src/pparser.pp

@@ -176,7 +176,7 @@ type
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
       UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
-    procedure FinishScope(ScopeType: TPasScopeType); virtual;
+    procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
@@ -239,7 +239,6 @@ type
     function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
-    procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
@@ -251,6 +250,7 @@ type
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
+    procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement); virtual;
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
@@ -658,9 +658,11 @@ begin
     visDefault, ASrcPos));
 end;
 
-procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType);
+procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
+  El: TPasElement);
 begin
   if ScopeType=stModule then ;
+  if El=nil then ;
 end;
 
 function TPasTreeContainer.FindModule(const AName: String): TPasModule;
@@ -901,7 +903,7 @@ begin
   if result and (pm in [pmPublic,pmForward]) then
     begin
     While (Parent<>Nil) and Not ((Parent is TPasClassType) or (Parent is TPasRecordType)) do
-     Parent:=Parent.Parent;
+      Parent:=Parent.Parent;
     Result:=Not Assigned(Parent);
     end;
 end;
@@ -1826,7 +1828,7 @@ begin
       tkColon: // record field (a:xxx;b:yyy;c:zzz);
         begin
           n:=GetExprIdent(x);
-          x.Free;
+          x.Release;
           r:=CreateRecordValues(AParent);
           NextToken;
           x:=DoParseConstValueExpression(AParent);
@@ -1850,7 +1852,8 @@ begin
         Result:=DoParseExpression(AParent,Result);
       Exit;
     end;
-    if CurToken<>tkBraceClose then ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
+    if CurToken<>tkBraceClose then
+      ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
     NextToken;
   end;
 end;
@@ -1984,7 +1987,7 @@ begin
     If LogEvent(pleInterface) then
       DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
     ParseInterface;
-    Engine.FinishScope(stModule);
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
@@ -2034,7 +2037,7 @@ begin
     PP.ProgramSection := Section;
     ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
-    Engine.FinishScope(stModule);
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
@@ -2063,7 +2066,7 @@ begin
     PP.LibrarySection := Section;
     ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
-    Engine.FinishScope(stModule);
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
@@ -2077,7 +2080,7 @@ begin
     ParseUsesList(ASection)
   else begin
     CheckImplicitUsedUnits(ASection);
-    Engine.FinishScope(stUsesList);
+    Engine.FinishScope(stUsesList,ASection);
     UngetToken;
   end;
 end;
@@ -2201,7 +2204,7 @@ var
   begin
     if CurBlock=NewBlock then exit;
     if CurBlock=declType then
-      Engine.FinishScope(stTypeDef);
+      Engine.FinishScope(stTypeSection,Declarations);
     CurBlock:=NewBlock;
   end;
 
@@ -2540,7 +2543,7 @@ begin
       ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
   Until (CurToken=tkSemicolon);
 
-  Engine.FinishScope(stUsesList);
+  Engine.FinishScope(stUsesList,ASection);
 end;
 
 // Starts after the variable name
@@ -2823,6 +2826,7 @@ begin
   ok:=false;
   try
     D:=SaveComments; // This means we support only one comment per 'list'.
+    VarEl:=nil;
     Repeat
       // create the TPasVariable here, so that SourceLineNumber is correct
       VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,AVisibility));
@@ -2835,13 +2839,13 @@ begin
     Until (CurToken=tkColon);
 
     // read type
-    VarType := ParseComplexType(Parent);
+    VarType := ParseComplexType(VarEl);
     for i := OldListCount to VarList.Count - 1 do
       begin
       VarEl:=TPasVariable(VarList[i]);
       // Writeln(VarEl.Name, AVisibility);
       VarEl.VarType := VarType;
-      VarType.Parent := VarEl;
+      //VarType.Parent := VarEl; // this is wrong for references types
       if (i>=OldListCount) then
         VarType.AddRef;
       end;
@@ -3231,6 +3235,7 @@ Var
   CC : TCallingConvention;
   PM : TProcedureModifier;
   Done: Boolean;
+  ResultEl: TPasResultElement;
 
 begin
   // Element must be non-nil. Removed all checks for not-nil.
@@ -3240,22 +3245,24 @@ begin
     ptFunction,ptClassFunction:
       begin
       ExpectToken(tkColon);
-      TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent,Scanner.CurSourcePos);
+      ResultEl:=TPasFunctionType(Element).ResultEl;
+      ResultEl.ResultType := ParseType(ResultEl,Scanner.CurSourcePos);
       end;
     ptOperator,ptClassOperator:
       begin
       NextToken;
+      ResultEl:=TPasFunctionType(Element).ResultEl;
       if (CurToken=tkIdentifier) then
         begin
-        TPasFunctionType(Element).ResultEl.Name := CurTokenName;
+        ResultEl.Name := CurTokenName;
         ExpectToken(tkColon);
         end
       else
         if (CurToken=tkColon) then
-          TPasFunctionType(Element).ResultEl.Name := 'Result'
+          ResultEl.Name := 'Result'
         else
           ParseExc(nParserExpectedColonID,SParserExpectedColonID);
-        TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent,Scanner.CurSourcePos)
+        ResultEl.ResultType := ParseType(ResultEl,Scanner.CurSourcePos)
       end;
   end;
   if OfObjectPossible then
@@ -3343,7 +3350,7 @@ begin
     ConsumeSemi;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
-  Engine.FinishScope(stProcedureHeader);
+  Engine.FinishScope(stProcedureHeader,Element);
   if (Parent is TPasProcedure)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
@@ -3351,7 +3358,7 @@ begin
      or (Parent.Parent is TProcedureBody))
   then
     ParseProcedureBody(Parent);
-  Engine.FinishScope(stProcedure);
+  Engine.FinishScope(stProcedure,Parent);
 end;
 
 // starts after the semicolon
@@ -3527,13 +3534,45 @@ begin
 end;
 
 procedure TPasParser.ParseAsmBlock(AsmBlock : TPasImplAsmStatement);
-
 begin
-  NextToken;
-  While CurToken<>tkEnd do
+  if po_asmwhole in Options then
+    begin
+    FTokenBufferIndex:=1;
+    FTokenBufferSize:=1;
+    FCommentsBuffer[0].Clear;
+    repeat
+      Scanner.ReadNonPascalTilEndToken(true);
+      case Scanner.CurToken of
+      tkLineEnding:
+        AsmBlock.Tokens.Add(Scanner.CurTokenString);
+      tkend:
+        begin
+        FTokenBuffer[0] := tkend;
+        FTokenStringBuffer[0] := Scanner.CurTokenString;
+        break;
+        end
+      else
+        begin
+        // missing end
+        FTokenBuffer[0] := tkEOF;
+        FTokenStringBuffer[0] := '';
+        end;
+      end;
+    until false;
+    FCurToken := FTokenBuffer[0];
+    FCurTokenString := FTokenStringBuffer[0];
+    FCurComments:=FCommentsBuffer[0];
+    CheckToken(tkend);
+    end
+  else
     begin
-    AsmBlock.Tokens.Add(CurTokenText);
     NextToken;
+    While CurToken<>tkEnd do
+      begin
+      // ToDo: allow @@end
+      AsmBlock.Tokens.Add(CurTokenText);
+      NextToken;
+      end;
     end;
   // NextToken; // Eat end.
   // Do not consume end. Current token will normally be end;
@@ -3563,7 +3602,7 @@ var
   function CloseBlock: boolean; // true if parent reached
   begin
     if CurBlock.ClassType=TPasImplExceptOn then
-      Engine.FinishScope(stExceptOnStatement);
+      Engine.FinishScope(stExceptOnStatement,CurBlock);
     CurBlock:=CurBlock.Parent as TPasImplBlock;
     Result:=CurBlock=Parent;
   end;
@@ -3897,7 +3936,7 @@ begin
           El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
           TPasImplExceptOn(El).VarExpr:=Left;
           TPasImplExceptOn(El).TypeExpr:=Right;
-          Engine.FinishScope(stExceptOnExpr);
+          Engine.FinishScope(stExceptOnExpr,El);
           CurBlock.AddElement(El);
           CurBlock:=TPasImplExceptOn(El);
           ExpectToken(tkDo);
@@ -4184,14 +4223,14 @@ procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
   AEndToken: TToken; AllowMethods: Boolean);
 
 Var
-  VN : String;
+  VariantName : String;
   v : TPasmemberVisibility;
   Proc: TPasProcedure;
   ProcType: TProcType;
   Prop : TPasProperty;
   Cons : TPasConst;
   isClass : Boolean;
-
+  NamePos: TPasSourcePos;
 begin
   v:=visDefault;
   isClass:=False;
@@ -4256,16 +4295,20 @@ begin
         begin
         ARec.Variants:=TFPList.Create;
         NextToken;
-        VN:=CurTokenString;
+        VariantName:=CurTokenString;
+        NamePos:=Scanner.CurSourcePos;
         NextToken;
         If CurToken=tkColon then
-          ARec.VariantName:=VN
+          begin
+          ARec.VariantEl:=TPasVariable(CreateElement(TPasVariable,VariantName,ARec,NamePos));
+          TPasVariable(ARec.VariantEl).VarType:=ParseType(ARec,Scanner.CurSourcePos);
+          end
         else
           begin
           UnGetToken;
           UnGetToken;
+          ARec.VariantEl:=ParseType(ARec,Scanner.CurSourcePos);
           end;
-        ARec.VariantType:=ParseType(ARec,Scanner.CurSourcePos);
         ExpectToken(tkOf);
         ParseRecordVariantParts(ARec,AEndToken);
         end;
@@ -4293,6 +4336,7 @@ begin
     Result.PackMode:=PackMode;
     NextToken;
     ParseRecordFieldList(Result,tkEnd,true);
+    Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
     if not ok then

packages/fcl-passrc/src/pscanner.pp

@@ -328,7 +328,8 @@ type
   TPOption = (
     po_delphi, // Delphi mode: forbid nested comments
     po_cassignments,  // allow C-operators += -= *= /=
-    po_resolvestandardtypes // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
+    po_resolvestandardtypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
+    po_asmwhole  // store whole text between asm..end in TPasImplAsmStatement.Tokens
     );
   TPOptions = set of TPOption;
 
@@ -379,6 +380,7 @@ type
     function GetCurColumn: Integer;
     procedure SetOptions(AValue: TPOptions);
   protected
+    function FetchLine: boolean;
     procedure SetCurMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
@@ -400,6 +402,7 @@ type
     destructor Destroy; override;
     procedure OpenFile(const AFilename: string);
     function FetchToken: TToken;
+    function ReadNonPascalTilEndToken(StopAtLineEnd: boolean): TToken;
     Procedure AddDefine(S : String);
     Procedure RemoveDefine(S : String);
     function CurSourcePos: TPasSourcePos;
@@ -1159,6 +1162,84 @@ begin
 //  Writeln(Result, '(',CurTokenString,')');
 end;
 
+function TPascalScanner.ReadNonPascalTilEndToken(StopAtLineEnd: boolean
+  ): TToken;
+var
+  StartPos: PChar;
+
+  Procedure Add;
+  var
+    AddLen: PtrInt;
+    OldLen: Integer;
+  begin
+    AddLen:=TokenStr-StartPos;
+    if AddLen=0 then exit;
+    OldLen:=length(FCurTokenString);
+    SetLength(FCurTokenString,OldLen+AddLen);
+    Move(StartPos^,PChar(PChar(FCurTokenString)+OldLen)^,AddLen);
+    StartPos:=TokenStr;
+  end;
+
+begin
+  FCurTokenString := '';
+  if (TokenStr = nil) or (TokenStr^ = #0) then
+    if not FetchLine then
+    begin
+      Result := tkEOF;
+      FCurToken := Result;
+      exit;
+    end;
+
+  StartPos:=TokenStr;
+  repeat
+    case TokenStr[0] of
+      #0: // end of line
+        begin
+          Add;
+          if StopAtLineEnd then
+            begin
+            Result := tkLineEnding;
+            FCurToken := Result;
+            exit;
+            end;
+          if not FetchLine then
+            begin
+            Result := tkEOF;
+            FCurToken := Result;
+            exit;
+            end;
+          StartPos:=TokenStr;
+        end;
+      '0'..'9', 'A'..'Z', 'a'..'z','_':
+        begin
+          // number or identifier
+          if (TokenStr[0] in ['e','E'])
+              and (TokenStr[1] in ['n','N'])
+              and (TokenStr[2] in ['d','D'])
+              and not (TokenStr[3] in ['0'..'9', 'A'..'Z', 'a'..'z','_']) then
+            begin
+            // 'end' found
+            Add;
+            Result := tkend;
+            SetLength(FCurTokenString, 3);
+            Move(TokenStr^, FCurTokenString[1], 3);
+            inc(TokenStr,3);
+            FCurToken := Result;
+            exit;
+            end
+          else
+            begin
+            // skip identifier
+            while TokenStr[0] in ['0'..'9', 'A'..'Z', 'a'..'z','_'] do
+              inc(TokenStr);
+            end;
+        end;
+      else
+        inc(TokenStr);
+    end;
+  until false;
+end;
+
 procedure TPascalScanner.Error(MsgNumber: integer; const Msg: string);
 begin
   SetCurMsg(mtError,MsgNumber,Msg,[]);
@@ -1335,25 +1416,6 @@ begin
 end;
 
 function TPascalScanner.DoFetchToken: TToken;
-
-  function FetchLine: Boolean;
-  begin
-    if CurSourceFile.IsEOF then
-    begin
-      FCurLine := '';
-      TokenStr := nil;
-      Result := false;
-    end else
-    begin
-      FCurLine := CurSourceFile.ReadLine;
-      TokenStr := PChar(CurLine);
-      Result := true;
-      Inc(FCurRow);
-      if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
-        DoLog(mtInfo,nLogLineNumber,SLogLineNumber,[FCurRow],True);
-    end;
-  end;
-
 var
   TokenStart, CurPos: PChar;
   i: TToken;
@@ -1935,6 +1997,24 @@ begin
   FOptions:=AValue;
 end;
 
+function TPascalScanner.FetchLine: boolean;
+begin
+  if CurSourceFile.IsEOF then
+  begin
+    FCurLine := '';
+    TokenStr := nil;
+    Result := false;
+  end else
+  begin
+    FCurLine := CurSourceFile.ReadLine;
+    TokenStr := PChar(CurLine);
+    Result := true;
+    Inc(FCurRow);
+    if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
+      DoLog(mtInfo,nLogLineNumber,SLogLineNumber,[FCurRow],True);
+  end;
+end;
+
 procedure TPascalScanner.SetCurMsg(MsgType: TMessageType; MsgNumber: integer;
   const Fmt: String; Args: array of const);
 begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -64,7 +64,7 @@ Type
   Private
     FFirstStatement: TPasImplBlock;
     FModules: TObjectList;// list of TTestEnginePasResolver
-    FPasResolver: TTestEnginePasResolver;
+    FResolverEngine: TTestEnginePasResolver;
     function GetModuleCount: integer;
     function GetModules(Index: integer): TTestEnginePasResolver;
     function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
@@ -109,7 +109,11 @@ Type
     Procedure TestProcOverload;
     Procedure TestProcOverloadRefs;
     Procedure TestNestedProc;
-    property PasResolver: TTestEnginePasResolver read FPasResolver;
+    Procedure TestDuplicateVar;
+    Procedure TestRecord;
+    Procedure TestRecordVariant;
+    Procedure TestRecordVariantNested;
+    property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -182,22 +186,22 @@ end;
 
 procedure TTestResolver.TearDown;
 begin
-  PasResolver.Clear;
+  ResolverEngine.Clear;
   if FModules<>nil then
     begin
     FModules.OwnsObjects:=false;
-    FModules.Remove(PasResolver); // remove reference
+    FModules.Remove(ResolverEngine); // remove reference
     FModules.OwnsObjects:=true;
     FreeAndNil(FModules);// free all other modules
     end;
   inherited TearDown;
-  FPasResolver:=nil;
+  FResolverEngine:=nil;
 end;
 
 procedure TTestResolver.CreateEngine(var TheEngine: TPasTreeContainer);
 begin
-  FPasResolver:=AddModule(MainFilename);
-  TheEngine:=PasResolver;
+  FResolverEngine:=AddModule(MainFilename);
+  TheEngine:=ResolverEngine;
 end;
 
 procedure TTestResolver.ParseProgram;
@@ -232,7 +236,7 @@ begin
       raise E;
       end;
   end;
-  TAssert.AssertSame('Has resolver',PasResolver,Parser.Engine);
+  TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
   AssertEquals('Has program',TPasProgram,Module.ClassType);
   AssertNotNull('Has program section',PasProgram.ProgramSection);
   AssertNotNull('Has initialization section',PasProgram.InitializationSection);
@@ -274,7 +278,7 @@ begin
       raise E;
       end;
   end;
-  TAssert.AssertSame('Has resolver',PasResolver,Parser.Engine);
+  TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
   AssertEquals('Has unit',TPasModule,Module.ClassType);
   AssertNotNull('Has interface section',Module.InterfaceSection);
   AssertNotNull('Has implementation section',Module.ImplementationSection);
@@ -588,7 +592,7 @@ var
           begin
           Ref:=TResolvedReference(El.CustomData);
           write(' Decl=',GetObjName(Ref.Declaration));
-          PasResolver.UnmangleSourceLineNumber(Ref.Declaration.SourceLinenumber,aLine,aCol);
+          ResolverEngine.UnmangleSourceLineNumber(Ref.Declaration.SourceLinenumber,aLine,aCol);
           write(Ref.Declaration.SourceFilename,'(',aLine,',',aCol,')');
           end
         else
@@ -636,7 +640,7 @@ var
         if El.ClassType=TPasAliasType then
           begin
           DeclEl:=TPasAliasType(El).DestType;
-          PasResolver.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
+          ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
           if (aLabel^.Filename=DeclEl.SourceFilename)
           and (aLabel^.LineNumber=LabelLine)
           and (aLabel^.StartCol<=LabelCol)
@@ -841,7 +845,7 @@ var
   Data: PTestResolverReferenceData absolute FindData;
   Line, Col: integer;
 begin
-  PasResolver.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
+  ResolverEngine.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
   //writeln('TTestResolver.OnFindReference ',GetObjName(El),' ',El.SourceFilename,' Line=',Line,',Col=',Col,' SearchFile=',Data^.Filename,',Line=',Data^.Line,',Col=',Data^.StartCol,'-',Data^.EndCol);
   if (Data^.Filename=El.SourceFilename)
   and (Data^.Line=Line)
@@ -1417,6 +1421,87 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestDuplicateVar;
+var
+  ok: Boolean;
+begin
+  StartProgram(false);
+  Add('var a: longint;');
+  Add('var a: string;');
+  Add('begin');
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected duplicate identifier, but got msg number "'+E.Message+'"',
+        PasResolver.nDuplicateIdentifier,E.MsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('duplicate identifier spotted',true,ok);
+end;
+
+procedure TTestResolver.TestRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariant;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariantNested;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('    1: ({#c}c:');
+  Add('          record');
+  Add('            {#d}d: longint;');
+  Add('            case {#e}e: longint of');
+  Add('            0: ({#f}f: longint)');
+  Add('          end)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  Add('  {@r}r.{@c}c.{@d}d:=6;');
+  Add('  {@r}r.{@c}c.{@e}e:=7;');
+  Add('  {@r}r.{@c}c.{@f}f:=8;');
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tctypeparser.pas

@@ -1191,13 +1191,12 @@ begin
   if HaveVariant then
     begin
     AssertNotNull('Have variants',TheRecord.Variants);
-    AssertNotNull('Have variant type',TheRecord.VariantType);
+    AssertNotNull('Have variant type',TheRecord.VariantEl);
     end
   else
     begin
     AssertNull('No variants',TheRecord.Variants);
-    AssertNull('No variant type',TheRecord.VariantType);
-    AssertEquals('No variant name','',TheRecord.VariantName);
+    AssertNull('No variant element',TheRecord.VariantEl);
     end;
   if AddComment then
     AssertComment;
@@ -1205,13 +1204,22 @@ end;
 
 procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
 
+var
+  V: TPasVariable;
 begin
-  if (AType='') then
-    AType:='Integer';
-  AssertEquals('Have variant selector storage name',AName,TheRecord.VariantName);
-  AssertNotNull('Have variant selector type',TheRecord.VariantType);
-  AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,TheRecord.VariantType.ClassType);
-  AssertEquals('Have variant selector type name',AType,TheRecord.VariantType.Name);
+  AssertNotNull('Have variant element',TheRecord.VariantEl);
+  if AName<>'' then
+    begin
+    AssertEquals('Have variant variable',TPasVariable,TheRecord.VariantEl.ClassType);
+    V:=TPasVariable(TheRecord.VariantEl);
+    AssertEquals('Have variant variable name',AName,V.Name);
+    AssertNotNull('Have variant var type',V.VarType);
+    AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,V.VarType.ClassType);
+    AssertEquals('Have variant selector type name',lowercase(AType),lowercase(V.VarType.Name));
+    end else begin
+    AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,TheRecord.VariantEl.ClassType);
+    AssertEquals('Have variant selector type name',lowercase(AType),lowercase(TheRecord.VariantEl.Name));
+    end;
 end;
 
 procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
@@ -1316,7 +1324,7 @@ procedure TTestRecordTypeParser.DoTestVariantNoStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([]);
 end;
 
@@ -1325,7 +1333,7 @@ procedure TTestRecordTypeParser.DoTestDeprecatedVariantNoStorage(
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([hDeprecated]);
 end;
 
@@ -1334,7 +1342,7 @@ procedure TTestRecordTypeParser.DoTestDeprecatedVariantStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([hDeprecated]);
 end;
 
@@ -1342,7 +1350,7 @@ procedure TTestRecordTypeParser.DoTestVariantStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
 end;
 
@@ -1350,7 +1358,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsNoStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([]);
   AssertVariant2([]);
 end;
@@ -1359,7 +1367,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
   AssertVariant2([]);
 end;
@@ -1369,7 +1377,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsFirstDeprecatedStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([hdeprecated]);
   AssertVariant2([]);
 end;
@@ -1379,7 +1387,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsSecondDeprecatedStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer ;);','1 : (z : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
   AssertVariant2([hdeprecated]);
 end;
@@ -1388,7 +1396,7 @@ procedure TTestRecordTypeParser.DoTestVariantTwoLabels(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0,1 : (y : integer)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([],['0','1']);
 end;
 
@@ -1396,7 +1404,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsTwoLabels(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0,1 : (y : integer);','2,3 : (z : integer);'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([],['0','1']);
   AssertVariant2([],['2','3']);
 end;
@@ -1405,7 +1413,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedRecord(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
 end;
 
@@ -1413,7 +1421,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariant(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer);','    2 : ( j :  byte)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[],['2'])
@@ -1424,7 +1432,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantFirstDeprecated(
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated);','    2 : ( j :  byte)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[hDeprecated],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[],['2'])
@@ -1435,7 +1443,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantSecondDeprecated(
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
@@ -1446,7 +1454,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantBothDeprecated(const A
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[hdeprecated],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])

packages/pastojs/src/fppas2js.pp

@@ -12,9 +12,9 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************
-
+}(*
  Abstract:
-   Converts a TPasModule into
+   Converts TPasElements into TJSElements.
 
  Works:
    - units, programs
@@ -25,20 +25,56 @@
    - procs, params, local vars
    - assign statements
    - function results
+   - record types and vars
    - for loop
+   - repeat..until
+   - while..do
+   - try..finally
+   - asm..end
 
  ToDos:
-   - many statements started, needs testing
+   - unit interface function
+   - optional: use $impl
+   - append to for-loop: if($loopend>i)i--;
    - rename overloaded procs, append $0, $1, ...
-   - records
+   - rename js identifiers: apply, bind, call, prototyp, ...
+   - bug: try adds empty line
+   - bug: finally adds unnecessary {}
+   - record const
+   - copy record
+   - asm..end as whole body
    - arrays
-   - access JavaScript from Pascal
+   - classes
+   - passing by reference
+   - procedure modifier external
    - Optional: put implementation into $impl
    - library
+   - enums, sets. For small sets use an integer, for big sets use
+       var s = {};
+       s["red"] = true; s["green"] = true; s["red"] = true;
+       Object.keys(s).length === 2;
+       s["red"] === true;
+       for (var key in s) // arbitrary order
+         if (s.hasOwnProperty(key))
+           console.log(s[key]);
+   - Fix file names on converter errors (relative instead of full)
+   - 'use strict' to allow javascript compilers optimize better
+   - Avoid nameclashes with the following identifiers:
+      implements, interface, let, package,
+        private, protected, public, static, yield,
+        class, enum, export, extends, import, super,
+        __extends, _super
+      array, Array, null, prototype, delete, for, break, if
+        do, while, constructor, each, in, function, continue, default, arguments,
+        switch, try, catch, throw, var, let, with, return, getPrototypeOf, new,
+        instanceof, Math, Object, anonymous, true, false, null, NaN, undefined,
+        String, Number, static, this, case, default
+   - use UTF8 string literals
+   - dotted unit names
 
  Debug flags: -d<x>
    VerbosePas2JS
-}
+*)
 unit fppas2js;
 
 {$mode objfpc}{$H+}
@@ -68,7 +104,7 @@ resourcestring
   sMemberExprMustBeIdentifier = 'Member expression must be an identifier';
 
 const
-  LoopEndVar = '$loopend';
+  LoopEndVarName = '$loopend';
 
 Type
 
@@ -102,9 +138,9 @@ Type
   TInitializationContext = Class(TConvertContext)
   end;
 
-  { TProcContext }
+  { TDeclContext }
 
-  TProcContext = Class(TConvertContext)
+  TDeclContext = Class(TConvertContext)
   end;
 
   { TProcBodyContext }
@@ -131,7 +167,7 @@ Type
     Procedure DoError(Const Msg : String);
     Procedure DoError(Const Msg : String; Const Args : Array of Const);
     Procedure DoError(MsgNumber: integer; const MsgPattern: string; Const Args : Array of Const; El: TPasElement);
-    procedure RaiseNotSupported(El: TPasElement; AContext: TConvertContext);
+    procedure RaiseNotSupported(El: TPasElement; AContext: TConvertContext; const Msg: string = '');
     procedure RaiseIdentifierNotFound(Identifier: string; El: TPasElement);
     procedure RaiseInconsistency;
     // Never create an element manually, always use the below function
@@ -157,6 +193,8 @@ Type
       Add: TJSElement; Src: TPasElement);
     Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;virtual;
     Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement;virtual;
+    Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;virtual;
+    Function CreateTypeRef(El: TPasType; AContext : TConvertContext): TJSElement;virtual;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual;
@@ -175,6 +213,7 @@ Type
     Function ConvertTryFinallyStatement(El: TPasImplTryFinally; AContext: TConvertContext): TJSElement;virtual;
     Function ConvertExceptOn(El: TPasImplExceptOn; AContext: TConvertContext): TJSElement;
     Function ConvertTryExceptStatement(El: TPasImplTryExcept; AContext: TConvertContext): TJSElement;
+    Function ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext);
     // Expressions
     Function ConvertArrayValues(El: TArrayValues; AContext : TConvertContext): TJSElement;virtual;
@@ -210,9 +249,10 @@ Type
     Function ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;virtual;
     Function ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;virtual;
     Function ConvertElement(El : TPasElement; AContext : TConvertContext) : TJSElement; virtual;
-    function ConvertClassType(El: TPasClassType;AContext: TConvertContext): TJSElement;
-    Function ConvertClassMember(El: TPasElement;AContext: TConvertContext): TJSElement;
-    Function ConvertClassConstructor(El: TPasConstructor;AContext: TConvertContext): TJSElement;
+    function ConvertRecordType(El: TPasRecordType; AContext: TConvertContext): TJSElement; virtual;
+    function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassMember(El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassConstructor(El: TPasConstructor; AContext: TConvertContext): TJSElement; virtual;
   Public
     constructor Create;
     Function ConvertPasElement(El : TPasElement; Resolver: TPasResolver) : TJSElement;
@@ -335,9 +375,7 @@ begin
     UsesSection:=TPasLibrary(El).LibrarySection
   else
     UsesSection:=El.InterfaceSection;
-  UsesList:=nil;
-  if UsesSection<>nil then
-    UsesList:=UsesSection.UsesList;
+  UsesList:=UsesSection.UsesList;
   ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext);
 
   // add parameter: function(){}
@@ -426,7 +464,7 @@ function TPasToJSConverter.ConvertCallExpression(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
 begin
   if AContext=nil then ;
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertCallExpression');
   Result:=nil;
 end;
 
@@ -717,7 +755,9 @@ begin
     else
       begin
       Name:=TransformVariableName(Decl,AContext);
+      {$IFDEF VerbosePas2JS}
       writeln('TPasToJSConverter.ConvertIdentifierExpr Decl.Parent=',GetObjName(Decl.Parent));
+      {$ENDIF}
       if Decl.Parent is TPasSection then
         begin
         FoundModule:=Decl.GetModule;
@@ -896,7 +936,7 @@ begin
   else if (El is TRecordValues) then
     Result:=ConvertRecordValues(TRecordValues(El),AContext)
   else
-    RaiseNotSupported(El,AContext);
+    RaiseNotSupported(El,AContext,'ConvertExpression');
 end;
 
 function TPasToJSConverter.CreateConstDecl(El: TPasConst;
@@ -931,8 +971,10 @@ function TPasToJSConverter.CreateTypeDecl(El: TPasType;
 begin
   Result:=Nil;
   if (El is TPasClassType) then
-    Result := ConvertClassType(TPasClassType(El), AContext);
-  // ToDo: Need to do something for classes and records.
+    Result := ConvertClassType(TPasClassType(El), AContext)
+  else if El is TPasRecordType then
+    Result := ConvertRecordType(TPasRecordType(El), AContext);
+  // other types don't need a constructor function
 end;
 
 function TPasToJSConverter.CreateVarDecl(El: TPasVariable;
@@ -1015,7 +1057,7 @@ begin
   IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil);
   IsFunction:=IsProcBody and (El.Parent is TPasFunction);
 
-  SubContext:=TProcContext.Create(aContext);
+  SubContext:=TDeclContext.Create(aContext);
   try
     SubContext.Element:=El;
 
@@ -1035,7 +1077,7 @@ begin
       else if P is TPasProcedure then
         E:=ConvertProcedure(TPasProcedure(P),SubContext)
       else
-        RaiseNotSupported(P as TPasElement,AContext);
+        RaiseNotSupported(P as TPasElement,AContext,'ConvertDeclarations');
       if (Pos('.', P.Name) > 0) then
         AddProcedureToClass(TJSStatementList(Result), E, P as TPasProcedure)
       else
@@ -1071,7 +1113,7 @@ function TPasToJSConverter.ConvertType(El: TPasElement;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertType');
   Result:=Nil;
 {
   ToDo:
@@ -1254,7 +1296,7 @@ begin
     FD.Name:=TJSString(FunName);
   FS.AFunction:=FD;
   for n := 0 to El.ProcType.Args.Count - 1 do
-    FD.Params.Add(TransformVariableName(TPasArgument(El.ProcType.Args[0]).Name,AContext));
+    FD.Params.Add(TransformVariableName(TPasArgument(El.ProcType.Args[n]).Name,AContext));
   FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El.Body));
 
   SubContext:=TProcBodyContext.Create(AContext);
@@ -1288,33 +1330,27 @@ function TPasToJSConverter.ConvertImplBlockElements(El: TPasImplBlock;
   AContext: TConvertContext): TJSElement;
 
 var
-  B : TJSElement;
-  S,S2 : TJSStatementList;
+  First, Last: TJSStatementList;
   I : Integer;
+  PasImpl: TPasImplElement;
+  JSImpl : TJSElement;
 
 begin
   if Not (Assigned(El.Elements) and (El.Elements.Count>0)) then
     Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El))
   else
     begin
-    S:=TJSStatementList(CreateElement(TJSStatementList,TPasImplElement(El)));
-    Result:=S;
+    First:=nil;
+    Result:=First;
+    Last:=First;
+    //writeln('TPasToJSConverter.ConvertImplBlockElements START El.Elements.Count=',El.Elements.Count);
     For I:=0 to El.Elements.Count-1 do
       begin
-      B:=ConvertElement(TPasImplElement(El.Elements[i]),AContext);
-      if not Assigned(S.A) then
-        S.A:=B
-      else
-        begin
-        if Assigned(S.B) then
-          begin
-          S2:=TJSStatementList(CreateElement(TJSStatementList,TPasImplElement(El.Elements[i])));
-          S2.A:=S.B;
-          S.B:=S2;
-          S:=S2;
-          end;
-        S.B:=B;
-        end;
+      PasImpl:=TPasImplElement(El.Elements[i]);
+      JSImpl:=ConvertElement(PasImpl,AContext);
+      //writeln('TPasToJSConverter.ConvertImplBlockElements ',i,' ',JSImpl.ClassName);
+      AddToStatementList(First,Last,JSImpl,PasImpl);
+      Result:=First;
       end;
     end;
 end;
@@ -1345,8 +1381,11 @@ begin
     AssignSt.Expr:=FDS;
     FD:=TJSFuncDef.Create;
     FDS.AFunction:=FD;
-    FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
-    FD.Body.A:=ConvertImplBlockElements(El,AContext);
+    if El.Elements.Count>0 then
+      begin
+      FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
+      FD.Body.A:=ConvertImplBlockElements(El,AContext);
+      end;
     ok:=true;
   finally
     if not ok then FreeAndNil(Result);
@@ -1366,11 +1405,12 @@ function TPasToJSConverter.ConvertTryStatement(El: TPasImplTry;
 Var
   B,F : TJSElement;
   T : TJSTryStatement;
-  IsFin : Boolean;
+  IsFin , ok: Boolean;
 
 begin
   F:=Nil;
   B:=ConvertImplBlockElements(El,AContext);
+  ok:=false;
   try
     F:=ConvertElement(El.FinallyExcept,AContext);
     IsFin:=El.FinallyExcept is TPasImplTryFinally;
@@ -1381,10 +1421,13 @@ begin
       T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El));
       T.Ident:=TJSString(GetExceptionObjectName(AContext));
       end;
-  except
-    FreeAndNil(B);
-    FreeAndNil(F);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      begin
+      B.Free;
+      F.Free;
+      end;
   end;
   if IsFin then
     T.BFinally:=F
@@ -1397,7 +1440,6 @@ end;
 function TPasToJSConverter.ConvertTryFinallyStatement(El: TPasImplTryFinally;
   AContext: TConvertContext): TJSElement;
 
-
 begin
   Result:=ConvertImplBlockElements(El,AContext);
 end;
@@ -1405,11 +1447,27 @@ end;
 function TPasToJSConverter.ConvertTryExceptStatement(El: TPasImplTryExcept;
   AContext: TConvertContext): TJSElement;
 
-
 begin
   Result:=ConvertImplBlockElements(El,AContext);
 end;
 
+function TPasToJSConverter.ConvertAsmStatement(El: TPasImplAsmStatement;
+  AContext: TConvertContext): TJSElement;
+var
+  pex: TJSPrimaryExpressionIdent;
+  s: String;
+begin
+  if AContext=nil then ;
+  s:=El.Tokens.Text;
+  if s='' then
+    Result:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,El))
+  else begin
+    pex:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
+    pex.Name := TJSString(s);
+    Result:=pex;
+  end;
+end;
+
 procedure TPasToJSConverter.CreateInitSection(El: TPasModule;
   Src: TJSSourceElements; AContext: TConvertContext);
 var
@@ -1434,9 +1492,9 @@ function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock;
 
 begin
   Result:=Nil;
-  if (EL is TPasImplStatement) then
+  if (El is TPasImplStatement) then
     Result:=ConvertStatement(TPasImplStatement(El),AContext)
-  else if (EL is TPasImplIfElse) then
+  else if (El is TPasImplIfElse) then
     Result:=ConvertIfStatement(TPasImplIfElse(El),AContext)
   else if (El is TPasImplRepeatUntil) then
     Result:=ConvertRepeatStatement(TPasImplRepeatUntil(El),AContext)
@@ -1470,7 +1528,7 @@ function TPasToJSConverter.ConvertPackage(El: TPasPackage;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertPackage');
   Result:=Nil;
   // ToDo TPasPackage = class(TPasElement)
 end;
@@ -1479,7 +1537,7 @@ function TPasToJSConverter.ConvertResString(El: TPasResString;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertResString');
   Result:=Nil;
   // ToDo: TPasResString
 end;
@@ -1488,7 +1546,8 @@ function TPasToJSConverter.ConvertArgument(El: TPasArgument;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  // is this still needed?
+  RaiseNotSupported(El,AContext,'ConvertArgument');
   Result:=Nil;
   // ToDo: TPasArgument
 end;
@@ -1519,7 +1578,8 @@ function TPasToJSConverter.ConvertConst(El: TPasConst; AContext: TConvertContext
   ): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  // is this still needed?
+  RaiseNotSupported(El,AContext,'ConvertConst');
   Result:=Nil;
   // ToDo: TPasConst
 end;
@@ -1528,7 +1588,7 @@ function TPasToJSConverter.ConvertProperty(El: TPasProperty;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertProperty');
   Result:=Nil;
   // ToDo: TPasProperty = class(TPasVariable)
 end;
@@ -1537,7 +1597,7 @@ function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertExportSymbol');
   Result:=Nil;
   // ToDo: TPasExportSymbol
 end;
@@ -1546,7 +1606,7 @@ function TPasToJSConverter.ConvertLabels(El: TPasLabels;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertLabels');
   Result:=Nil;
   // ToDo: TPasLabels = class(TPasImplElement)
 end;
@@ -1597,7 +1657,7 @@ function TPasToJSConverter.ConvertCommand(El: TPasImplCommand;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertCommand');
   Result:=Nil;
   // ToDo: TPasImplCommand = class(TPasImplElement)
 end;
@@ -1749,7 +1809,7 @@ begin
     VarStat:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
     VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
     VarStat.A:=VarDecl;
-    VarDecl.Name:=LoopEndVar;
+    VarDecl.Name:=LoopEndVarName;
     VarDecl.Init:=ConvertElement(El.EndExpr,AContext);
     ForSt.Init:=VarStat;
     // add "LoopVar<=$loopend"
@@ -1758,7 +1818,7 @@ begin
     else
       BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
     BinExp.A:=ConvertElement(El.VariableName,AContext);
-    BinExp.B:=CreateIdentifierExpr(LoopEndVar,El.EndExpr);
+    BinExp.B:=CreateIdentifierExpr(LoopEndVarName,El.EndExpr);
     ForSt.Cond:=BinExp;
     // add "LoopVar++"
     If El.Down then
@@ -2059,36 +2119,41 @@ begin
     else
       begin
       // merge lists (append)
-      if Last.B<>nil then
-        raise Exception.Create('internal error: TPasToJSConverter.ConvertDeclarations.AddToStatementList add list');
-      Last.B:=Add;
-      while Last.B is TJSStatementList do
-        Last:=TJSStatementList(Last.B);
       if Last.B<>nil then
         begin
+        // add a nil to the end of chain
         SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
         SL2.A:=Last.B;
         Last.B:=SL2;
         Last:=SL2;
+        // Last.B is now nil
         end;
+      Last.B:=Add;
+      while Last.B is TJSStatementList do
+        Last:=TJSStatementList(Last.B);
       end;
     end
   else
     begin
     if Last=nil then
       begin
+      // start list
       Last:=TJSStatementList(CreateElement(TJSStatementList,Src));
       First:=Last;
+      Last.A:=Add;
       end
+    else if Last.B=nil then
+      // second element
+      Last.B:=Add
     else
       begin
-      if Last.B<>nil then
-        raise Exception.Create('internal error: TPasToJSConverter.ConvertDeclarations.AddToStatementList add element');
+      // add to chain
       SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
+      SL2.A:=Last.B;
       Last.B:=SL2;
       Last:=SL2;
+      Last.B:=Add;
       end;
-    Last.A:=Add;
     end;
 end;
 
@@ -2105,6 +2170,8 @@ begin
     If Assigned(Expr) then
       DoError(nInitializedArraysNotSupported,sInitializedArraysNotSupported,[],PasType);
     end
+  else if T is TPasRecordType then
+    Result:=CreateRecordInit(TPasRecordType(T),Expr,El,AContext)
   else if Assigned(Expr) then
     Result:=ConvertElement(Expr,AContext)
   else
@@ -2156,6 +2223,42 @@ begin
   Result:=CreateValInit(El.VarType,El.Expr,El,AContext);
 end;
 
+function TPasToJSConverter.CreateRecordInit(aRecord: TPasRecordType;
+  Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;
+var
+  NewMemE: TJSNewMemberExpression;
+begin
+  if Expr<>nil then
+    RaiseNotSupported(Expr,AContext,'CreateRecordInit Expr<>nil');
+  NewMemE:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,El));
+  Result:=NewMemE;
+  NewMemE.MExpr:=CreateTypeRef(aRecord,AContext);
+end;
+
+function TPasToJSConverter.CreateTypeRef(El: TPasType; AContext: TConvertContext
+  ): TJSElement;
+var
+  FoundModule: TPasModule;
+  Name: String;
+begin
+  Name:=TransformVariableName(El.Name,AContext);
+  { $IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.CreateTypeRef El="',GetObjName(El),'" El.Parent=',GetObjName(El.Parent));
+  { $ENDIF}
+  if El.Parent is TPasSection then
+    begin
+    FoundModule:=El.GetModule;
+    if FoundModule=nil then
+      RaiseInconsistency;
+    if AContext.GetRootModule=FoundModule then
+      Name:='this.'+Name
+    else
+      Name:='pas.'+TransformModuleName(FoundModule,AContext)+'.'+Name;
+    end;
+  // ToDo: use TJSDotMemberExpression for dots
+  Result:=CreateIdentifierExpr(Name,El);
+end;
+
 function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement):
 TJSFunctionDeclarationStatement;
 var
@@ -2169,6 +2272,7 @@ begin
   FS.AFunction := FD;
   Result := FS;
 end;
+
 function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
   AContext: TConvertContext): TJSElement;
 
@@ -2215,8 +2319,10 @@ begin
     Result:=ConvertExceptOn(TPasImplExceptOn(El),AContext)
   else if (El is TPasImplForLoop) then
     Result:=ConvertForStatement(TPasImplForLoop(El),AContext)
+  else if (El is TPasImplAsmStatement) then
+    Result:=ConvertAsmStatement(TPasImplAsmStatement(El),AContext)
   else
-    RaiseNotSupported(El,AContext);
+    RaiseNotSupported(El,AContext,'ConvertStatement');
 {
   TPasImplCaseStatement = class(TPasImplStatement)
 }
@@ -2227,7 +2333,7 @@ function TPasToJSConverter.ConvertCommands(El: TPasImplCommands;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertCommands');
   Result:=Nil;
   // ToDo: TPasImplCommands = class(TPasImplElement)
 end;
@@ -2236,7 +2342,7 @@ function TPasToJSConverter.ConvertLabelMark(El: TPasImplLabelMark;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertLabelMark');
   Result:=Nil;
   // ToDo:   TPasImplLabelMark = class(TPasImplLabelMark) then
 end;
@@ -2284,6 +2390,57 @@ begin
     Result:=nil;
 end;
 
+function TPasToJSConverter.ConvertRecordType(El: TPasRecordType;
+  AContext: TConvertContext): TJSElement;
+(*
+  type
+    TMyRecord = record
+      i: longint;
+      s: string;
+      d: double;
+    end;
+
+    this.TMyRecord=function() {
+                 i=0;
+                 s="";
+                 d=0.0;
+                };
+*)
+var
+  AssignSt: TJSSimpleAssignStatement;
+  ok: Boolean;
+  i: Integer;
+  PasVar: TPasVariable;
+  FDS: TJSFunctionDeclarationStatement;
+  FD: TJSFuncDef;
+  JSVar: TJSElement;
+  First, Last: TJSStatementList;
+begin
+  AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+  Result:=AssignSt;
+  ok:=false;
+  try
+    AssignSt.LHS:=CreateMemberExpression(['this',TransformVariableName(El.Name,AContext)]);
+    FDS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El));
+    AssignSt.Expr:=FDS;
+    FD:=TJSFuncDef.Create;
+    FDS.AFunction:=FD;
+    FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
+    First:=nil;
+    Last:=nil;
+    for i:=0 to El.Members.Count-1 do
+      begin
+      PasVar:=TPasVariable(El.Members[i]);
+      JSVar:=ConvertVariable(PasVar,AContext);
+      AddToStatementList(First,Last,JSVar,PasVar);
+      FD.Body.A:=First;
+      end;
+    ok:=true;
+  finally
+    if not ok then FreeAndNil(Result);
+  end;
+end;
+
 procedure TPasToJSConverter.DoError(const Msg: String);
 begin
   Raise EPas2JS.Create(Msg);
@@ -2308,12 +2465,14 @@ begin
 end;
 
 procedure TPasToJSConverter.RaiseNotSupported(El: TPasElement;
-  AContext: TConvertContext);
+  AContext: TConvertContext; const Msg: string);
 var
   E: EPas2JS;
 begin
   if AContext=nil then ;
   E:=EPas2JS.CreateFmt(sPasElementNotSupported,[GetObjName(El)]);
+  if Msg<>'' then
+    E.Message:=E.Message+': '+Msg;
   E.PasElement:=El;
   E.MsgNumber:=nPasElementNotSupported;
   SetLength(E.Args,1);

packages/pastojs/tests/tcconverter.pp

@@ -333,8 +333,13 @@ begin
   AssertEquals('Correct condition class',TJSUnaryNotExpression,E.Cond.ClassType);
   AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
   L:=AssertListStatement('Multiple statements',E.Body);
+  //  writeln('TTestStatementConverter.TestRepeatUntilStatementTwo L.A=',L.A.ClassName);
+  // writeln('  L.B=',L.B.ClassName);
+  // writeln('  L.B.A=',TJSStatementList(L.B).A.ClassName);
+  // writeln('  L.B.B=',TJSStatementList(L.B).B.ClassName);
+
   AssertAssignStatement('First List statement is assignment',L.A,'b','c');
-  AssertAssignStatement('Second List statement is assignment',L.b,'d','e');
+  AssertAssignStatement('Second List statement is assignment',L.B,'d','e');
 end;
 
 Procedure TTestStatementConverter.TestRepeatUntilStatementThree;
@@ -394,15 +399,15 @@ begin
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
   // "var $loopend=100"
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
   AssertLiteral('Correct end value',VD.Init,100);
 
   // i<=$loopend
   C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
+  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
 
   // i++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
@@ -444,15 +449,15 @@ begin
   E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
 
   // "var $loopend=1"
-  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,E.Init));
-  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
+  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVarName,TJSVariableStatement,E.Init));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVarName,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVarName,LoopEndVarName,VD.Name);
   AssertLiteral('Correct end value',VD.Init,1);
 
   // i>=$loopend
   C:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,E.Cond));
   AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
+  AssertIdentifier('Cond RHS is '+LoopEndVarName,C.B,LoopEndVarName);
 
   // i--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
@@ -1333,7 +1338,7 @@ Class Procedure TTestConverter.AssertAssignStatement(Const Msg : String; El : TJ
 begin
   AssertNotNull(Msg+': have statement',EL);
   If not (El is TJSSimpleAssignStatement) then
-    Fail(Msg+': statement is not assign statement but is'+El.ClassName);
+    Fail(Msg+': statement is not assign statement but is '+El.ClassName);
   AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).LHS,LHS);
   AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).Expr,RHS);
 end;

packages/pastojs/tests/tcmodules.pas

@@ -0,0 +1,952 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2014 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=TTestModuleConverter.TestEmptyProgram
+}
+unit tcmodules;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, contnrs, fppas2js,
+  pastree, PScanner, PasResolver, PParser, jstree, jswriter, jsbase;
+
+const
+  po_pas2js = [po_asmwhole,po_resolvestandardtypes];
+type
+
+  { TTestPasParser }
+
+  TTestPasParser = Class(TPasParser)
+  end;
+
+  TOnFindUnit = function(const aUnitName: String): TPasModule of object;
+
+  { TTestEnginePasResolver }
+
+  TTestEnginePasResolver = class(TPasResolver)
+  private
+    FFilename: string;
+    FModule: TPasModule;
+    FOnFindUnit: TOnFindUnit;
+    FParser: TTestPasParser;
+    FResolver: TStreamResolver;
+    FScanner: TPascalScanner;
+    FSource: string;
+    procedure SetModule(AValue: TPasModule);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function FindModule(const AName: String): TPasModule; override;
+    property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
+    property Filename: string read FFilename write FFilename;
+    property Resolver: TStreamResolver read FResolver write FResolver;
+    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Parser: TTestPasParser read FParser write FParser;
+    property Source: string read FSource write FSource;
+    property Module: TPasModule read FModule write SetModule;
+  end;
+
+  { TTestModule }
+
+  TTestModule = Class(TTestCase)
+  private
+    FConverter: TPasToJSConverter;
+    FEngine: TTestEnginePasResolver;
+    FFilename: string;
+    FFileResolver: TStreamResolver;
+    FJSInitBody: TJSFunctionBody;
+    FJSInterfaceUses: TJSArrayLiteral;
+    FJSModule: TJSSourceElements;
+    FJSModuleSrc: TJSSourceElements;
+    FJSSource: TStringList;
+    FModule: TPasModule;
+    FJSModuleCallArgs: TJSArguments;
+    FModules: TObjectList;// list of TTestEnginePasResolver
+    FParser: TTestPasParser;
+    FPasProgram: TPasProgram;
+    FJSRegModuleCall: TJSCallExpression;
+    FScanner: TPascalScanner;
+    FSource: TStringList;
+    FFirstPasStatement: TPasImplBlock;
+    function GetModuleCount: integer;
+    function GetModules(Index: integer): TTestEnginePasResolver;
+    function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure Add(Line: string);
+    Procedure StartParsing;
+    Procedure ParseModule;
+    procedure ParseProgram;
+  protected
+    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
+    function AddModule(aFilename: string): TTestEnginePasResolver;
+    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
+    function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+      ImplementationSrc: string): TTestEnginePasResolver;
+    procedure AddSystemUnit;
+    procedure StartProgram(NeedSystemUnit: boolean);
+    Procedure ConvertProgram;
+    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);
+    property PasProgram: TPasProgram Read FPasProgram;
+    property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
+    property ModuleCount: integer read GetModuleCount;
+    property Engine: TTestEnginePasResolver read FEngine;
+    property Filename: string read FFilename;
+    Property Module: TPasModule Read FModule;
+    property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
+    property Converter: TPasToJSConverter read FConverter;
+    property JSSource: TStringList read FJSSource;
+    property JSModule: TJSSourceElements read FJSModule;
+    property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
+    property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
+    property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
+    property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
+    property JSInitBody: TJSFunctionBody read FJSInitBody;
+  public
+    property Source: TStringList read FSource;
+    property FileResolver: TStreamResolver read FFileResolver;
+    property Scanner: TPascalScanner read FScanner;
+    property Parser: TTestPasParser read FParser;
+  Published
+    Procedure TestEmptyProgram;
+    Procedure TestVarInt;
+    Procedure TestEmptyProc;
+    Procedure TestProcTwoArgs;
+    Procedure TestFunctionInt;
+    Procedure TestFunctionString;
+    Procedure TestVarRecord;
+    Procedure TestForLoop;
+    Procedure TestForLoopInFunction;
+    Procedure TestRepeatUntil;
+    Procedure TestAsmBlock;
+    Procedure TestTryFinally;
+  end;
+
+function LinesToStr(Args: array of const): string;
+function ExtractFileUnitName(aFilename: string): string;
+function JSToStr(El: TJSElement): string;
+
+implementation
+
+function LinesToStr(Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtChar:         s += Args[i].VChar+LineEnding;
+      vtString:       s += Args[i].VString^+LineEnding;
+      vtPChar:        s += Args[i].VPChar+LineEnding;
+      vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
+      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  Result:=s;
+end;
+
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
+
+function JSToStr(El: TJSElement): string;
+var
+  aWriter: TBufferWriter;
+  aJSWriter: TJSWriter;
+begin
+  aWriter:=TBufferWriter.Create(1000);
+  try
+    aJSWriter:=TJSWriter.Create(aWriter);
+    aJSWriter.IndentSize:=2;
+    aJSWriter.WriteJS(El);
+    Result:=aWriter.AsAnsistring;
+  finally
+    aWriter.Free;
+  end;
+end;
+
+{ TTestEnginePasResolver }
+
+procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
+begin
+  if FModule=AValue then Exit;
+  if Module<>nil then
+    Module.Release;
+  FModule:=AValue;
+  if Module<>nil then
+    Module.AddRef;
+end;
+
+constructor TTestEnginePasResolver.Create;
+begin
+  inherited Create;
+  StoreSrcColumns:=true;
+end;
+
+destructor TTestEnginePasResolver.Destroy;
+begin
+  FreeAndNil(FResolver);
+  Module:=nil;
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FResolver);
+  inherited Destroy;
+end;
+
+function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
+begin
+  Result:=nil;
+  if Assigned(OnFindUnit) then
+    Result:=OnFindUnit(AName);
+end;
+
+{ TTestModule }
+
+function TTestModule.GetModuleCount: integer;
+begin
+  Result:=FModules.Count;
+end;
+
+function TTestModule.GetModules(Index: integer
+  ): TTestEnginePasResolver;
+begin
+  Result:=TTestEnginePasResolver(FModules[Index]);
+end;
+
+function TTestModule.OnPasResolverFindUnit(const aUnitName: String
+  ): TPasModule;
+var
+  i: Integer;
+  CurEngine: TTestEnginePasResolver;
+  CurUnitName: String;
+begin
+  //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
+  Result:=nil;
+  for i:=0 to ModuleCount-1 do
+    begin
+    CurEngine:=Modules[i];
+    CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
+    //writeln('TTestModule.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
+    if CompareText(aUnitName,CurUnitName)=0 then
+      begin
+      Result:=CurEngine.Module;
+      if Result<>nil then exit;
+      //writeln('TTestModule.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
+      FileResolver.FindSourceFile(aUnitName);
+
+      CurEngine.Resolver:=TStreamResolver.Create;
+      CurEngine.Resolver.OwnsStreams:=True;
+      //writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
+      CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
+      CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
+      CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
+      CurEngine.Parser.Options:=CurEngine.Parser.Options+po_pas2js;
+      if CompareText(CurUnitName,'System')=0 then
+        CurEngine.Parser.ImplicitUses.Clear;
+      CurEngine.Scanner.OpenFile(CurEngine.Filename);
+      try
+        CurEngine.Parser.NextToken;
+        CurEngine.Parser.ParseUnit(CurEngine.FModule);
+      except
+        on E: Exception do
+          begin
+          writeln('ERROR: TTestModule.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
+            +' File='+CurEngine.Scanner.CurFilename
+            +' LineNo='+IntToStr(CurEngine.Scanner.CurRow)
+            +' Col='+IntToStr(CurEngine.Scanner.CurColumn)
+            +' Line="'+CurEngine.Scanner.CurLine+'"'
+            );
+          raise E;
+          end;
+      end;
+      //writeln('TTestModule.OnPasResolverFindUnit END ',CurUnitName);
+      Result:=CurEngine.Module;
+      exit;
+      end;
+    end;
+  writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
+  raise Exception.Create('can''t find unit "'+aUnitName+'"');
+end;
+
+procedure TTestModule.SetUp;
+begin
+  inherited SetUp;
+  FSource:=TStringList.Create;
+  FModules:=TObjectList.Create(true);
+
+  FFilename:='test1.pp';
+  FFileResolver:=TStreamResolver.Create;
+  FFileResolver.OwnsStreams:=True;
+  FScanner:=TPascalScanner.Create(FFileResolver);
+  FEngine:=AddModule(Filename);
+  FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
+  Parser.Options:=Parser.Options+po_pas2js;
+  FModule:=Nil;
+  FConverter:=TPasToJSConverter.Create;
+end;
+
+procedure TTestModule.TearDown;
+begin
+  FJSModule:=nil;
+  FJSRegModuleCall:=nil;
+  FJSModuleCallArgs:=nil;
+  FJSInterfaceUses:=nil;
+  FJSModuleSrc:=nil;
+  FJSInitBody:=nil;
+  FreeAndNil(FJSSource);
+  FreeAndNil(FJSModule);
+  FreeAndNil(FConverter);
+  Engine.Clear;
+  if Assigned(FModule) then
+    begin
+    FModule.Release;
+    FModule:=nil;
+    end;
+  FreeAndNil(FSource);
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FFileResolver);
+  if FModules<>nil then
+    begin
+    FreeAndNil(FModules);
+    FEngine:=nil;
+    end;
+
+  inherited TearDown;
+end;
+
+procedure TTestModule.Add(Line: string);
+begin
+  Source.Add(Line);
+end;
+
+procedure TTestModule.StartParsing;
+begin
+  FileResolver.AddStream(FileName,TStringStream.Create(Source.Text));
+  Scanner.OpenFile(FileName);
+  Writeln('// Test : ',Self.TestName);
+  Writeln(Source.Text);
+end;
+
+procedure TTestModule.ParseModule;
+begin
+  StartParsing;
+  Parser.ParseMain(FModule);
+  AssertNotNull('Module resulted in Module',FModule);
+  AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
+end;
+
+procedure TTestModule.ParseProgram;
+begin
+  FFirstPasStatement:=nil;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: EPasResolve do
+      begin
+      writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: Exception do
+      begin
+      writeln('ERROR: TTestModule.ParseProgram Exception: '+E.ClassName+':'+E.Message);
+      raise E;
+      end;
+  end;
+  TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
+  AssertEquals('Has program',TPasProgram,Module.ClassType);
+  FPasProgram:=TPasProgram(Module);
+  AssertNotNull('Has program section',PasProgram.ProgramSection);
+  AssertNotNull('Has initialization section',PasProgram.InitializationSection);
+  if (PasProgram.InitializationSection.Elements.Count>0) then
+    if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+end;
+
+function TTestModule.FindModuleWithFilename(aFilename: string
+  ): TTestEnginePasResolver;
+var
+  i: Integer;
+begin
+  for i:=0 to ModuleCount-1 do
+    if CompareText(Modules[i].Filename,aFilename)=0 then
+      exit(Modules[i]);
+  Result:=nil;
+end;
+
+function TTestModule.AddModule(aFilename: string
+  ): TTestEnginePasResolver;
+begin
+  //writeln('TTestModuleConverter.AddModule ',aFilename);
+  if FindModuleWithFilename(aFilename)<>nil then
+    raise Exception.Create('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
+  Result:=TTestEnginePasResolver.Create;
+  Result.Filename:=aFilename;
+  Result.AddObjFPCBuiltInIdentifiers([btChar,btString,btLongint,btInt64,btBoolean,btDouble]);
+  Result.OnFindUnit:=@OnPasResolverFindUnit;
+  FModules.Add(Result);
+end;
+
+function TTestModule.AddModuleWithSrc(aFilename, Src: string
+  ): TTestEnginePasResolver;
+begin
+  Result:=AddModule(aFilename);
+  Result.Source:=Src;
+end;
+
+function TTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+  ImplementationSrc: string): TTestEnginePasResolver;
+var
+  Src: String;
+begin
+  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src+=LineEnding;
+  Src+='interface'+LineEnding;
+  Src+=LineEnding;
+  Src+=InterfaceSrc;
+  Src+='implementation'+LineEnding;
+  Src+=LineEnding;
+  Src+=ImplementationSrc;
+  Src+='end.'+LineEnding;
+  Result:=AddModuleWithSrc(aFilename,Src);
+end;
+
+procedure TTestModule.AddSystemUnit;
+begin
+  AddModuleWithIntfImplSrc('system.pp',
+    // interface
+    LinesToStr([
+    'type',
+    '  integer=longint;',
+    'var',
+    '  ExitCode: Longint;',
+    ''
+    // implementation
+    ]),LinesToStr([
+    ''
+    ]));
+end;
+
+procedure TTestModule.StartProgram(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('program test1;');
+  Add('');
+end;
+
+procedure TTestModule.ConvertProgram;
+var
+  ModuleNameExpr: TJSLiteral;
+  FunDecl, InitFunction: TJSFunctionDeclarationStatement;
+  FunDef: TJSFuncDef;
+  InitAssign: TJSSimpleAssignStatement;
+  FunBody: TJSFunctionBody;
+begin
+  FJSSource:=TStringList.Create;
+  Add('end.');
+  ParseProgram;
+  FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
+  FJSSource.Text:=JSToStr(JSModule);
+  writeln('TTestModule.ConvertProgram JS:');
+  write(FJSSource.Text);
+
+  // rtl.module(...
+  AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
+  AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
+  AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
+  FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
+  AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
+  AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
+  AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
+  FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
+  AssertEquals('rtl.module args.count',3,JSModuleCallArgs.Elements.Count);
+
+  // parameter 'unitname'
+  AssertNotNull('module name param',JSModuleCallArgs.Elements.Elements[0].Expr);
+  ModuleNameExpr:=JSModuleCallArgs.Elements.Elements[0].Expr as TJSLiteral;
+  AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
+  AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString));
+
+  // main uses section
+  AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr);
+  AssertEquals('interface uses section type',TJSArrayLiteral,JSModuleCallArgs.Elements.Elements[1].Expr.ClassType);
+  FJSInterfaceUses:=JSModuleCallArgs.Elements.Elements[1].Expr as TJSArrayLiteral;
+
+  // function()
+  AssertNotNull('module function',JSModuleCallArgs.Elements.Elements[2].Expr);
+  AssertEquals('module function type',TJSFunctionDeclarationStatement,JSModuleCallArgs.Elements.Elements[2].Expr.ClassType);
+  FunDecl:=JSModuleCallArgs.Elements.Elements[2].Expr as TJSFunctionDeclarationStatement;
+  AssertNotNull('module function def',FunDecl.AFunction);
+  FunDef:=FunDecl.AFunction as TJSFuncDef;
+  AssertEquals('module function name','',String(FunDef.Name));
+  AssertNotNull('module function body',FunDef.Body);
+  FunBody:=FunDef.Body as TJSFunctionBody;
+  FJSModuleSrc:=FunBody.A as TJSSourceElements;
+
+  // init this.$main - the last statement
+  AssertEquals('this.$main function 1',true,JSModuleSrc.Statements.Count>0);
+  InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
+  CheckDottedIdentifier('init function',InitAssign.LHS,'this.$main');
+
+  InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
+  FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
+end;
+
+procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
+  DottedName: string);
+begin
+  if DottedName='' then
+    begin
+    AssertNull(Msg,El);
+    end
+  else
+    begin
+    AssertNotNull(Msg,El);
+    AssertEquals(Msg,DottedName,GetDottedIdentifier(EL));
+    end;
+end;
+
+function TTestModule.GetDottedIdentifier(El: TJSElement): string;
+begin
+  if El=nil then
+    Result:=''
+  else if El is TJSPrimaryExpressionIdent then
+    Result:=String(TJSPrimaryExpressionIdent(El).Name)
+  else if El is TJSDotMemberExpression then
+    Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
+  else
+    AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
+end;
+
+procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  ActualSrc:=JSToStr(JSModuleSrc);
+  ExpectedSrc:=Statements+LineEnding
+    +'this.$main = function () {'+LineEnding
+    +InitStatements
+    +'};'+LineEnding;
+  CheckDiff(Msg,ExpectedSrc,ActualSrc);
+end;
+
+procedure TTestModule.CheckDiff(Msg, Expected, Actual: string);
+// search diff, ignore changes in spaces
+const
+  SpaceChars = [#9,#10,#13,' '];
+var
+  ExpectedP, ActualP: PChar;
+
+  function FindLineEnd(p: PChar): PChar;
+  begin
+    Result:=p;
+    while not (Result^ in [#0,#10,#13]) do inc(Result);
+  end;
+
+  function FindLineStart(p, MinP: PChar): PChar;
+  begin
+    while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
+    Result:=p;
+  end;
+
+  procedure DiffFound;
+  var
+    ActLineStartP, ActLineEndP, p, StartPos: PChar;
+    ExpLine, ActLine: String;
+    i: Integer;
+  begin
+    writeln('Diff found "',Msg,'". Lines:');
+    // write correct lines
+    p:=PChar(Expected);
+    repeat
+      StartPos:=p;
+      while not (p^ in [#0,#10,#13]) do inc(p);
+      ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
+      if p^ in [#10,#13] then begin
+        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+          inc(p,2)
+        else
+          inc(p);
+      end;
+      if p<=ExpectedP then begin
+        writeln('= ',ExpLine);
+      end else begin
+        // diff line
+        // write actual line
+        ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
+        ActLineEndP:=FindLineEnd(ActualP);
+        ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
+        writeln('- ',ActLine);
+        // write expected line
+        writeln('+ ',ExpLine);
+        // write empty line with pointer ^
+        for i:=1 to 2+ExpectedP-StartPos do write(' ');
+        writeln('^');
+        AssertEquals(Msg,ExpLine,ActLine);
+        break;
+      end;
+    until p^=#0;
+    raise Exception.Create('diff found, but lines are the same, internal error');
+  end;
+
+var
+  IsSpaceNeeded: Boolean;
+  LastChar: Char;
+begin
+  if Expected='' then Expected:=' ';
+  if Actual='' then Actual:=' ';
+  ExpectedP:=PChar(Expected);
+  ActualP:=PChar(Actual);
+  repeat
+    //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
+    case ExpectedP^ of
+    #0:
+      begin
+      // check that rest of Actual has only spaces
+      while ActualP^ in SpaceChars do inc(ActualP);
+      if ActualP^<>#0 then
+        DiffFound;
+      exit;
+      end;
+    ' ',#9,#10,#13:
+      begin
+      // skip space in Expected
+      IsSpaceNeeded:=false;
+      if ExpectedP>PChar(Expected) then
+        LastChar:=ExpectedP[-1]
+      else
+        LastChar:=#0;
+      while ExpectedP^ in SpaceChars do inc(ExpectedP);
+      if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
+          and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
+        IsSpaceNeeded:=true;
+      if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
+        DiffFound;
+      while ActualP^ in SpaceChars do inc(ActualP);
+      end;
+    else
+      while ActualP^ in SpaceChars do inc(ActualP);
+      if ExpectedP^<>ActualP^ then
+        DiffFound;
+      inc(ExpectedP);
+      inc(ActualP);
+    end;
+  until false;
+end;
+
+procedure TTestModule.TestEmptyProgram;
+begin
+  StartProgram(false);
+  Add('begin');
+  ConvertProgram;
+  CheckSource('Empty program','','');
+end;
+
+procedure TTestModule.TestVarInt;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarInt','this.i=0;','');
+end;
+
+procedure TTestModule.TestEmptyProc;
+begin
+  StartProgram(false);
+  Add('procedure Test;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestEmptyProc',
+    LinesToStr([ // statements
+    'this.test = function () {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProcTwoArgs;
+begin
+  StartProgram(false);
+  Add('procedure Test(a,b: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcTwoArgs',
+    LinesToStr([ // statements
+    'this.test = function (a,b) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestFunctionInt;
+begin
+  StartProgram(false);
+  Add('function Test(a: longint): longint;');
+  Add('begin');
+  Add('  Result:=2*a');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcTwoArgs',
+    LinesToStr([ // statements
+    'this.test = function (a) {',
+    '  var result = 0;',
+    '  result = (2*a);',
+    '  return result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestFunctionString;
+begin
+  StartProgram(false);
+  Add('function Test(a: string): string;');
+  Add('begin');
+  Add('  Result:=a+a');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcTwoArgs',
+    LinesToStr([ // statements
+    'this.test = function (a) {',
+    '  var result = "";',
+    '  result = (a+a);',
+    '  return result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestVarRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRecA = record');
+  Add('    B: longint;');
+  Add('  end;');
+  Add('var r: TRecA;');
+  Add('begin');
+  Add('  r.B:=123');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.treca = function () {',
+    '  b = 0;',
+    '};',
+    'this.r = new this.treca();'
+    ]),
+    LinesToStr([ // this.$main
+    'this.r.b = 123;'
+    ]));
+end;
+
+procedure TTestModule.TestForLoop;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i, j, n: longint;');
+  Add('begin');
+  Add('  j:=0;');
+  Add('  n:=3;');
+  Add('  for i:=1 to n do');
+  Add('  begin');
+  Add('    j:=j+i;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;',
+    'this.j = 0;',
+    'this.n = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.j = 0;',
+    '  this.n = 3;',
+    '  this.i = 1;',
+    '  for (var $loopend = this.n; (this.i <= $loopend); this.i++) {',
+    '    this.j = (this.j + this.i);',
+    '  };'
+    ]));
+end;
+
+procedure TTestModule.TestForLoopInFunction;
+begin
+  StartProgram(false);
+  Add('function SumNumbers(n: longint): longint;');
+  Add('var');
+  Add('  i, j: longint;');
+  Add('begin');
+  Add('  j:=0;');
+  Add('  for i:=1 to n do');
+  Add('  begin');
+  Add('    j:=j+i;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  SumNumbers(3);');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.sumnumbers = function (n) {',
+    '  var result = 0;',
+    '  var i = 0;',
+    '  var j = 0;',
+    '  j = 0;',
+    '  i = 1;',
+    '  for (var $loopend = n; (i <= $loopend); i++) {',
+    '    j = (j + i);',
+    '  };',
+    '  return result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.sumnumbers(3);'
+    ]));
+end;
+
+procedure TTestModule.TestRepeatUntil;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i, j, n: longint;');
+  Add('begin');
+  Add('  n:=3;');
+  Add('  j:=0;');
+  Add('  i:=0;');
+  Add('  repeat');
+  Add('    i:=i+1;');
+  Add('    j:=j+i;');
+  Add('  until i>=n');
+  ConvertProgram;
+  CheckSource('TestVarRecord',
+    LinesToStr([ // statements
+    'this.i = 0;',
+    'this.j = 0;',
+    'this.n = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.n = 3;',
+    '  this.j = 0;',
+    '  this.i = 0;',
+    '  do{',
+    '    this.i = (this.i + 1);',
+    '    this.j = (this.j + this.i);',
+    '  }while(!(this.i>=this.n));'
+    ]));
+end;
+
+procedure TTestModule.TestAsmBlock;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=1;');
+  Add('  asm');
+  Add('    if (i==1) {');
+  Add('      i=2;');
+  Add('    }');
+  Add('    if (i==2){ i=3; }');
+  Add('  end;');
+  Add('  i:=4;');
+  ConvertProgram;
+  CheckSource('TestAsm',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  this.i = 1;',
+    'if (i==1) {',
+    'i=2;',
+    '}',
+    'if (i==2){ i=3; }',
+    ';',
+    'this.i = 4;'
+    ]));
+end;
+
+procedure TTestModule.TestTryFinally;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    i:=0; i:=2 div i;');
+  Add('  finally');
+  Add('    i:=3');
+  Add('  end;');
+  ConvertProgram;
+end;
+
+Initialization
+  RegisterTests([TTestModule]);
+end.
+

packages/pastojs/tests/testpas2js.pp

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

utils/fpdoc/dw_html.pp

@@ -1938,6 +1938,8 @@ var
   TREl, TDEl: TDOMElement;
   CurVariant: TPasVariant;
   isExtended : Boolean;
+  VariantEl: TPasElement;
+  VariantType: TPasType;
 
 begin
   if not (Element.Parent is TPasVariant) then
@@ -1972,18 +1974,21 @@ begin
       AppendSym(CodeEl, ';');
     end;
 
-  if Assigned(Element.VariantType) then
+  if Assigned(Element.VariantEl) then
   begin
     TREl := CreateTR(TableEl);
     CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
     AppendNbSp(CodeEl, NestingLevel * 2 + 2);
     AppendKw(CodeEl, 'case ');
-    if TPasRecordType(Element).VariantName <> '' then
+    VariantEl:=TPasRecordType(Element).VariantEl;
+    if VariantEl is TPasVariable then
     begin
-      AppendText(CodeEl, TPasRecordType(Element).VariantName);
+      AppendText(CodeEl, TPasVariable(VariantEl).Name);
       AppendSym(CodeEl, ': ');
-    end;
-    CodeEl := AppendType(CodeEl, TableEl, TPasRecordType(Element).VariantType, True);
+      VariantType:=TPasVariable(VariantEl).VarType;
+    end else
+      VariantType:=VariantEl as TPasType;
+    CodeEl := AppendType(CodeEl, TableEl, VariantType, True);
     AppendKw(CodeEl, ' of');
     for i := 0 to TPasRecordType(Element).Variants.Count - 1 do
     begin