--- Merging r34430 into '.':

U    packages/pastojs/tests/tcconverter.pp
U    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r34430 into '.':
 U   .
--- Merging r34466 into '.':
U    packages/fcl-web/src/base/custfcgi.pp
--- Recording mergeinfo for merge of r34466 into '.':
 G   .
--- Merging r34470 into '.':
U    packages/fcl-web/src/base/httpdefs.pp
--- Recording mergeinfo for merge of r34470 into '.':
 G   .
--- Merging r34520 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcconverter.pp
U    packages/pastojs/tests/testpas2js.pp
A    packages/pastojs/tests/tcmodules.pas
U    packages/fcl-js/tests/testjs.lpr
U    packages/fcl-js/tests/tcwriter.pp
U    packages/fcl-js/src/jswriter.pp
U    packages/fcl-js/src/jstree.pp
U    packages/fcl-passrc/tests/tctypeparser.pas
U    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/pasresolver.pp
U    packages/fcl-passrc/src/pscanner.pp
U    packages/fcl-passrc/src/pparser.pp
U    utils/fpdoc/dw_html.pp
--- Recording mergeinfo for merge of r34520 into '.':
 G   .
--- Merging r34535 into '.':
U    packages/fcl-json/src/jsonscanner.pp
--- Recording mergeinfo for merge of r34535 into '.':
 G   .
--- Merging r34536 into '.':
U    packages/fcl-json/tests/testjsonparser.pp
U    packages/fcl-json/src/jsonparser.pp
--- Recording mergeinfo for merge of r34536 into '.':
 G   .
--- Merging r34537 into '.':
U    packages/fcl-json/src/fpjson.pp
--- Recording mergeinfo for merge of r34537 into '.':
 G   .
--- Merging r34538 into '.':
U    packages/fcl-json/tests/testjsondata.pp
G    packages/fcl-json/tests/testjsonparser.pp
U    packages/fcl-json/tests/testjsonrtti.pp
U    packages/fcl-json/src/fpjsonrtti.pp
G    packages/fcl-json/src/jsonscanner.pp
G    packages/fcl-json/src/jsonparser.pp
--- Recording mergeinfo for merge of r34538 into '.':
 G   .
--- Merging r34651 into '.':
U    packages/fcl-js/src/jsbase.pp
U    packages/fcl-js/src/jsparser.pp
G    packages/fcl-js/src/jswriter.pp
G    packages/fcl-js/src/jstree.pp
U    packages/fcl-js/src/jstoken.pp
--- Recording mergeinfo for merge of r34651 into '.':
 G   .
--- Merging r34652 into '.':
A    packages/fcl-js/src/jsminifier.pp
A    packages/fcl-js/examples
A    packages/fcl-js/examples/fpjsmin.pp
U    packages/fcl-js/fpmake.pp
--- Recording mergeinfo for merge of r34652 into '.':
 G   .
--- Merging r34654 into '.':
G    packages/fcl-js/fpmake.pp
--- Recording mergeinfo for merge of r34654 into '.':
 G   .

# revisions: 34430,34466,34470,34520,34535,34536,34537,34538,34651,34652,34654

git-svn-id: branches/fixes_3_0@35977 -

.gitattributes

@@ -2438,8 +2438,10 @@ packages/fcl-js/Makefile svneol=native#text/plain
 packages/fcl-js/Makefile.fpc svneol=native#text/plain
 packages/fcl-js/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-js/README.TXT svneol=native#text/plain
+packages/fcl-js/examples/fpjsmin.pp svneol=native#text/plain
 packages/fcl-js/fpmake.pp svneol=native#text/plain
 packages/fcl-js/src/jsbase.pp svneol=native#text/plain
+packages/fcl-js/src/jsminifier.pp svneol=native#text/plain
 packages/fcl-js/src/jsparser.pp svneol=native#text/plain
 packages/fcl-js/src/jsscanner.pp svneol=native#text/plain
 packages/fcl-js/src/jstoken.pp svneol=native#text/plain
@@ -6504,6 +6506,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/examples/fpjsmin.pp

@@ -0,0 +1,21 @@
+{$mode objfpc}{$h+}
+{$inline on}
+program fpjsmin;
+
+uses jsminifier;
+
+
+begin
+  if ParamCount<>2 then
+    begin
+    Writeln('Usage: fpjsmin infile outfile');
+    halt(1);
+    end;
+  With TJSONMinifier.Create(Nil) do
+    try
+       FileHeader.Add(paramstr(1));
+       Execute(ParamStr(1),ParamStr(2));
+    finally
+      Free
+    end;
+end.

packages/fcl-js/fpmake.pp

@@ -25,6 +25,8 @@ begin
     P.Description := 'Javascript scanner/parser/syntax tree units';
     P.OSes:=AllOSes-[embedded,msdos];
 
+    P.Dependencies.Add('fcl-base');
+
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');
 
@@ -37,6 +39,8 @@ begin
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('jswriter.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('jsminifier.pp');
+      T.ResourceStrings:=true;
 {$ifndef ALLPACKAGES}
     Run;
     end;

packages/fcl-js/src/jsbase.pp

@@ -1,3 +1,18 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript base definitions
+            
+    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.
+                                
+  **********************************************************************}
+                                 
 unit jsbase;
 
 {$mode objfpc}{$H+}

packages/fcl-js/src/jsminifier.pp

@@ -0,0 +1,440 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    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.
+                                
+  **********************************************************************}
+{ ---------------------------------------------------------------------
+  Javascript minifier, based on an implementation by Douglas Crockford,
+  see original copyright.
+  ---------------------------------------------------------------------}
+{ jsmin.c
+   2013-03-29
+
+Copyright (c) 2002 Douglas Crockford  (www.crockford.com)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+The Software shall be used for Good, not Evil.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+}
+
+unit jsminifier;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses sysutils,classes,bufstream;
+
+
+Const
+  EOS = #0;
+
+Type
+
+  { TJSONMinifier }
+  EJSONMinifier = Class(Exception);
+
+  TJSONMinifier = Class(TComponent)
+  Private
+    FA : char;
+    FB : char;
+    FFileHeader: TStrings;
+    FLookahead : char;
+    FX : char;
+    FY : char ;
+    Fin : TStream;
+    Fout : TStream;
+    procedure SetFileHeader(AValue: TStrings);
+  Protected
+    // Token reading routines
+    function Peek : char;
+    function Get : char;inline;
+    function Next : char;
+    // Token writing routines
+    procedure Putc(c: char);inline;
+    Procedure Reset;
+    procedure DoHeader; virtual;
+    procedure Error(Const Msg: string);
+    Class Function isAlphaNum(c: char): boolean;
+    Class Function iif(B : Boolean; Const ifTrue,ifFalse : integer) : integer; inline;
+    procedure Action(d: Byte);
+    procedure Minify;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute(Const SourceFilename,DestFilename : String);
+    Procedure Execute(Source,Dest : TStream);
+    Procedure Execute(SourceFilenames : TStrings; Const DestFilename : String);
+    Procedure Execute(SourceFileNames : Array of string; Const DestFilename : String);
+  Published
+    Property FileHeader : TStrings Read FFileHeader Write SetFileHeader;
+  end;
+
+Implementation
+
+Resourcestring
+  SErrUnterminatedComment = 'Unterminated comment.';
+  SErrUnterminatedStringLiteral = 'Unterminated string literal.';
+  SErrUnterminatedSetInRegexp = 'Unterminated set in Regular Expression literal.';
+  SerrUnterminatedRegexp = 'Unterminated Regular Expression literal.';
+
+class function TJSONMinifier.iif(B: Boolean; const ifTrue, ifFalse: integer
+  ): integer;
+
+begin
+  if B then
+    Result:=ifTrue
+  else
+    Result:=ifFalse;
+end;
+
+procedure TJSONMinifier.Error(const Msg: string);
+
+begin
+  Raise EJSONMinifier.Create('JSMIN Error: '+Msg);
+end;
+
+procedure TJSONMinifier.SetFileHeader(AValue: TStrings);
+begin
+  if FFileHeader=AValue then Exit;
+  FFileHeader.Assign(AValue);
+end;
+
+procedure TJSONMinifier.Reset;
+
+begin
+  FA:=EOS;
+  FB:=EOS;
+  FLookahead:=EOS;
+  FX:=EOS;
+  FY:=EOS;
+end;
+
+class function TJSONMinifier.isAlphaNum(c: char): boolean;
+
+begin
+  Result:= (C in ['a'..'z']) or (c in ['0'..'9']) or (c in ['A'..'Z']) or (C in ['_','$','\']) or (c > #126);
+end;
+
+
+function TJSONMinifier.Get: char;
+
+begin
+  Result:=FLookahead;
+  FLookahead:=EOS;
+  if (Result=EOS) then
+    if Fin.Read(Result,sizeof(Result))=0 then exit;
+  if (Result>' ') or (Result in [#10,EOS]) then
+    Exit;
+  if (Result=#13) then
+    Result:=#10
+  else
+    Result:=' ';
+end;
+
+
+function TJSONMinifier.Peek: char;
+begin
+  FLookahead := get();
+  result:=FLookahead;
+end;
+
+function TJSONMinifier.Next: char;
+
+var
+ c : char;
+
+begin
+  c:= get();
+  if (c='/') then
+    case peek of
+      '/': Repeat
+             c := get();
+           until (c <= #10);
+      '*':
+           begin
+           Get();
+           while (c <> ' ') do
+             case get of
+               '*':
+                 begin
+                 if (peek()= '/') then
+                   begin
+                   get();
+                   c:=' ';
+                   end;
+                 end;
+               EOS:
+                 Error(SErrUnterminatedComment);
+              end;
+           end;
+    end;
+  FY:=FX;
+  FX:=c;
+  Result:=c;
+end;
+
+procedure TJSONMinifier.Putc(c: char);
+
+begin
+  Fout.writebuffer(c,sizeof(c));
+end;
+
+procedure TJSONMinifier.Action(d : Byte);
+
+  Procedure Do1;
+
+  begin
+    putc(FA);
+    if ((FY in [#10,' '])
+        and (FA in ['+','-','*','/'])
+        and (FB in ['+','-','*','/'])) then
+      putc(FY);
+  end;
+
+  Procedure Do2;
+
+  begin
+    FA:=FB;
+    if (FA in ['''','"','`']) then
+      While true do
+        begin
+        putc(FA);
+        FA:= get();
+        if (FA=FB) then
+          break;
+        if (FA='\') then
+          begin
+          putc(FA);
+          FA:=get();
+          end;
+        if (FA=EOS) then
+          Error(SErrUnterminatedStringLiteral);
+        end;
+  end;
+
+begin
+  if (D=1) then
+    Do1;
+  if (D in [1,2]) then
+    Do2;
+  FB := next();
+  if (FB='/') and (FA in ['(',',','=',':','[','!','&','|','?','+','-','~','*','/','{',#10]) then
+    begin
+    putc(FA);
+    if (FA in ['/','*']) then
+       putc(' ');
+    putc(FB);
+    While true do
+      begin
+      FA := get();
+      if (FA='[') then
+        begin
+        While true do
+          begin
+          putc(FA);
+          FA := get();
+          if (FA = ']') then
+            break;
+          if (FA = '\') then
+            begin
+            putc(FA);
+            FA := get();
+            end;
+          if (FA = EOS) then
+            Error(SErrUnterminatedSetInRegexp);
+          end
+        end
+      else if (FA = '/') then
+        begin
+        case (peek()) of
+           '/', '*':
+            Error(SErrUnterminatedSetInRegexp);
+        end;
+        Break;
+        end
+      else if (FA ='\') then
+        begin
+        putc(FA);
+        FA := get();
+        end;
+      if (FA = EOS) then
+        Error(SErrUnterminatedRegexp);
+      putc(FA);
+      end;
+    FB := next();
+    end;
+end;
+
+
+procedure TJSONMinifier.Minify;
+
+begin
+  if (peek()= #$EF) then
+    begin
+    get();
+    get();
+    get();
+    end;
+  FA:=#10;
+  action(3);
+  while (FA <> EOS) do
+    begin
+    case (FA) of
+      ' ':
+        action(iif(isAlphanum(FB),1,2));
+      #10:
+        case (FB) of
+          '{', '[', '(', '+', '-', '!', '~':
+            Action(1);
+          ' ':
+                Action(3);
+        else
+          Action(iif(isAlphanum(FB), 1 , 2));
+        end;
+    else
+      case (FB) of
+        ' ':
+          Action(iif(isAlphanum(FA),1,3));
+        #10:
+          case (FA) of
+            '}',']',')','+','-','"', '''', '`':
+              Action(1);
+          else
+            Action(iif(isAlphanum(FA), 1, 3));
+         end;
+      else
+        Action(1);
+      end;
+    end;
+    end;
+end;
+
+constructor TJSONMinifier.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFileHeader:=TStringList.Create;
+end;
+
+destructor TJSONMinifier.Destroy;
+begin
+  FreeAndNil(FFileHeader);
+  inherited Destroy;
+end;
+
+procedure TJSONMinifier.Execute(const SourceFilename, DestFilename: String);
+
+Var
+ Src,Dest : TBufStream;
+
+begin
+ Dest:=Nil;
+ Src:=TReadBufStream.Create(TFileStream.Create(SourceFileName,fmOpenRead or fmShareDenyWrite),1000);
+ try
+   Src.SourceOwner:=True;
+   Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+   Dest.SourceOwner:=True;
+   Execute(Src,Dest);
+ finally
+   Src.Free;
+   Dest.Free;
+ end;
+end;
+
+procedure TJSONMinifier.DoHeader;
+
+Var
+  S,L : String;
+
+begin
+  For S in FFileHeader do
+    begin
+    L:='// '+S+sLineBreak;
+    Fout.WriteBuffer(L[1],Length(L));
+    end;
+end;
+
+procedure TJSONMinifier.Execute(Source, Dest: TStream);
+
+begin
+  Fin:=Source;
+  Fout:=Dest;
+  try
+    Reset;
+    DoHeader;
+    Minify;
+  finally
+    Fin:=Nil;
+    Fout:=Nil;
+  end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFilenames: TStrings;const DestFilename: String);
+
+Var
+  Src,Dest : TBufStream;
+  I : Integer;
+
+begin
+ Dest:=Src;
+ Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+ try
+   Dest.SourceOwner:=True;
+   for I:=0 to SourceFileNames.Count-1 do
+     begin
+     Src:=TReadBufStream.Create(TFileStream.Create(SourceFileNames[i],fmOpenRead or fmShareDenyWrite),1000);
+     Src.SourceOwner:=True;
+     Execute(Src,Dest);
+     FreeAndNil(Src);
+     end;
+ finally
+   FreeAndNil(Src);
+   FreeAndNil(Dest);
+ end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFileNames: array of string;
+  const DestFilename: String);
+
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  try
+    S.AddStrings(SourceFileNames);
+    Execute(S,DestFileName);
+  finally
+    S.Free;
+  end;
+end;
+
+
+end.
+

packages/fcl-js/src/jsparser.pp

@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript parser
+            
+    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.
+                                
+  **********************************************************************}
 unit jsparser;
 
 { $define debugparser}

packages/fcl-js/src/jstoken.pp

@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript token definitions
+            
+    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.
+                                
+  **********************************************************************}
 unit jstoken;
 
 {$mode objfpc}{$H+}

packages/fcl-js/src/jstree.pp

@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript syntax tree definitions
+            
+    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.
+                                
+  **********************************************************************}
 unit jstree;
 
 {$mode objfpc}{$H+}
@@ -120,7 +134,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

@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    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.
+                                
+  **********************************************************************}
 unit jswriter;
 
 {$mode objfpc}{$H+}
@@ -474,15 +488,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 +509,7 @@ begin
     Write('}')
   else
     begin
-    undent;
+    Undent;
     Write('}'); // do not writeln
     end;
 end;
@@ -697,14 +713,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 +748,8 @@ begin
     end;
   if B then
     begin
-    Write('}');
-    if not C then writeln('');
+    Undent;
+    Write('}'); // do not writeln
     end;
 end;
 
@@ -865,7 +887,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 +1077,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-json/src/fpjson.pp

@@ -623,7 +623,6 @@ Resourcestring
   SErrCannotConvertFromObject = 'Cannot convert data from object value';
   SErrCannotConvertToObject = 'Cannot convert data to object value';
   SErrInvalidFloat = 'Invalid float value : %s';
-  SErrInvalidInteger = 'Invalid float value : %s';
   SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
   SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
   SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
@@ -1074,7 +1073,7 @@ procedure TJSONData.DumpJSON(S: TStream);
   end;
 
 Var
-  I,C : Integer;
+  I: Integer;
   O : TJSONObject;
 
 begin
@@ -2049,13 +2048,20 @@ function TJSONArray.GetAsJSON: TJSONStringType;
 Var
   I : Integer;
   Sep : String;
+  D : TJSONData;
+  V : TJSONStringType;
 
 begin
   Sep:=TJSONData.FElementSep;
   Result:='[';
   For I:=0 to Count-1 do
     begin
-    Result:=Result+Items[i].AsJSON;
+    D:=Items[i];
+    if D<>Nil then
+      V:=D.AsJSON
+    else
+      V:='null';
+    Result:=Result+V;
     If (I<Count-1) then
       Result:=Result+Sep;
     end;
@@ -2093,7 +2099,10 @@ begin
     begin
     if MultiLine then
       Result:=Result+Ind;
-    Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
+    if Items[i]=Nil then
+      Result:=Result+'null'
+    else
+      Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
     If (I<Count-1) then
       if MultiLine then
         Result:=Result+','
@@ -2671,6 +2680,8 @@ function TJSONObject.GetAsJSON: TJSONStringType;
 Var
   I : Integer;
   Sep : String;
+  V : TJSONStringType;
+  D : TJSONData;
 
 begin
   Sep:=TJSONData.FElementSep;
@@ -2679,7 +2690,12 @@ begin
     begin
     If (Result<>'') then
       Result:=Result+Sep;
-    Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+Items[I].AsJSON;
+    D:=Items[i];
+    if Assigned(D) then
+      V:=Items[I].AsJSON
+    else
+      V:='null';
+    Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+V;
     end;
   If (Result<>'') then
     Result:=FObjStartSep+Result+FObjEndSep
@@ -2807,6 +2823,9 @@ Var
   S : TJSONStringType;
   MultiLine,UseQuotes, SkipWhiteSpace : Boolean;
   NSep,Sep,Ind : String;
+  V : TJSONStringType;
+  D : TJSONData;
+
 begin
   Result:='';
   UseQuotes:=Not (foDoNotQuoteMembers in options);
@@ -2833,7 +2852,12 @@ begin
     S:=StringToJSONString(Names[i]);
     If UseQuotes then
       S:='"'+S+'"';
-    Result:=Result+S+NSep+Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    D:=Items[i];
+    if D=Nil then
+      V:='null'
+    else
+      v:=Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    Result:=Result+S+NSep+V;
     end;
   If (Result<>'') then
     begin

packages/fcl-json/src/fpjsonrtti.pp

@@ -406,7 +406,6 @@ Var
   PI : PPropInfo;
   TI : PTypeInfo;
   I,J,S : Integer;
-  D : Double;
   A : TJSONArray;
   JS : TJSONStringType;
 begin
@@ -551,8 +550,6 @@ procedure TJSONDeStreamer.JSONToCollection(const JSON: TJSONData;
 Var
   I : integer;
   A : TJSONArray;
-  O : TJSONObject;
-
 begin
   If (JSON.JSONType=jtArray) then
     A:=JSON As TJSONArray
@@ -980,10 +977,6 @@ end;
 
 function TJSONStreamer.StreamClassProperty(const AObject: TObject): TJSONData;
 
-Var
-  C : TCollection;
-  I : integer;
-
 begin
   Result:=Nil;
   If (AObject=Nil) then

packages/fcl-json/src/jsonparser.pp

@@ -65,7 +65,6 @@ Resourcestring
   SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
   SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
   SErrExpectedColon   = 'Expected colon (:), got token "%s".';
-  SErrUnexpectedComma = 'Invalid comma encountered.';
   SErrEmptyElement = 'Empty element encountered.';
   SErrExpectedElementName    = 'Expected element name, got token "%s"';
   SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
@@ -148,6 +147,7 @@ begin
       tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
       tkNumber : Result:=ParseNumber;
       tkComma : DoError(SErrUnexpectedToken);
+      tkIdentifier : DoError(SErrUnexpectedToken);
     end;
   except
     FreeAndNil(Result);

packages/fcl-json/src/jsonscanner.pp

@@ -205,10 +205,10 @@ function TJSONScanner.DoFetchToken: TJSONToken;
   end;
 
 var
-  TokenStart, CurPos: PChar;
+  TokenStart: PChar;
   it : TJSONToken;
   I : Integer;
-  OldLength, SectionLength, Index: Integer;
+  OldLength, SectionLength,  tstart,tcol: Integer;
   C : char;
   S : String;
   IsStar,EOC: Boolean;
@@ -433,6 +433,8 @@ begin
       end;
     'a'..'z','A'..'Z','_':
       begin
+        tstart:=CurRow;
+        Tcol:=CurColumn;
         TokenStart := TokenStr;
         repeat
           Inc(TokenStr);
@@ -448,7 +450,7 @@ begin
             exit;
             end;
         if (joStrict in Options) then
-          Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
+          Error(SErrInvalidCharacter, [tStart,tcol,TokenStart[0]])
         else
           Result:=tkIdentifier;
       end;

packages/fcl-json/tests/testjsondata.pp

@@ -19,7 +19,7 @@ unit testjsondata;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, fpjson;
+  Classes, SysUtils, fpcunit, testregistry, fpjson;
 
 type
    TMyNull     = Class(TJSONNull);
@@ -204,6 +204,7 @@ type
     Procedure TestClone;
     Procedure TestMyClone;
     Procedure TestFormat;
+    Procedure TestFormatNil;
   end;
   
   { TTestObject }
@@ -252,6 +253,7 @@ type
     procedure TestExtract;
     Procedure TestNonExistingAccessError;
     Procedure TestFormat;
+    Procedure TestFormatNil;
     Procedure TestFind;
   end;
 
@@ -1002,7 +1004,6 @@ end;
 
 procedure TTestJSONPath.TestDeepRecursive;
 Var
-  O : TJSONObject;
   A : TJSONArray;
   D : TJSONData;
 begin
@@ -2563,7 +2564,6 @@ procedure TTestArray.TestAddString;
 Var
   J : TJSONArray;
   S : String;
-  F : TJSONFloat;
   
 begin
   S:='A string';
@@ -2585,8 +2585,6 @@ procedure TTestArray.TestAddNull;
 
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonArray.Create;
@@ -2720,7 +2718,6 @@ procedure TTestArray.TestInsertString;
 Var
   J : TJSONArray;
   S : String;
-  F : TJSONFloat;
 
 begin
   S:='A string';
@@ -2742,8 +2739,6 @@ end;
 procedure TTestArray.TestInsertNull;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonArray.Create;
@@ -2825,11 +2820,8 @@ end;
 procedure TTestArray.TestMove;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
-  S:='A string';
   J:=TJSonArray.Create;
   try
     J.Add('First string');
@@ -2849,11 +2841,8 @@ end;
 procedure TTestArray.TestExchange;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
-  S:='A string';
   J:=TJSonArray.Create;
   try
     J.Add('First string');
@@ -2987,7 +2976,7 @@ end;
 
 procedure TTestArray.TestMyClone;
 Var
-  J,J2 : TMyArray;
+  J : TMyArray;
   D : TJSONData;
 
 begin
@@ -3010,7 +2999,6 @@ end;
 procedure TTestArray.TestFormat;
 Var
   J : TJSONArray;
-  I : TJSONData;
 
 begin
   J:=TJSonArray.Create;
@@ -3033,6 +3021,23 @@ begin
   end;
 end;
 
+procedure TTestArray.TestFormatNil;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(1);
+    J.Add(TJSONObject(Nil));
+    TestJSON(J,'[1, null]');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineArray],1));
+  finally
+    J.Free;
+  end;
+end;
+
 { TTestObject }
 
 procedure TTestObject.TestCreate;
@@ -3199,7 +3204,6 @@ Const
 Var
   J : TJSONObject;
   S : String;
-  F : TJSONFloat;
 
 begin
   S:='A string';
@@ -3224,8 +3228,6 @@ Const
 
 Var
   J : TJSONObject;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonObject.Create;
@@ -3482,6 +3484,23 @@ begin
   end;
 end;
 
+procedure TTestObject.TestFormatNil;
+
+Var
+  J : TJSONObject;
+
+begin
+  J:=TJSONObject.Create;
+  try
+    J.Add('a',1);
+    J.Add('b',TJSONObject(Nil));
+    TestJSON(J,'{ "a" : 1, "b" : null }');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineObject],1));
+  finally
+    J.Free;
+  end;
+end;
+
 procedure TTestObject.TestFind;
 
 Const

packages/fcl-json/tests/testjsonparser.pp

@@ -19,9 +19,12 @@ unit testjsonparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,fpjson,
+  Classes, SysUtils, fpcunit, testregistry,fpjson,
   jsonscanner,jsonParser,testjsondata;
 
+Const
+  DefaultOpts = [joUTF8,joStrict];
+
 type
 
   { TTestParser }
@@ -30,7 +33,7 @@ type
   private
     FOptions : TJSONOptions;
     procedure CallNoHandlerStream;
-    procedure DoTestError(S: String);
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts);
     procedure DoTestFloat(F: TJSONFloat); overload;
     procedure DoTestFloat(F: TJSONFloat; S: String); overload;
     procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
@@ -53,6 +56,7 @@ type
     procedure TestString;
     procedure TestArray;
     procedure TestObject;
+    procedure TestObjectError;
     procedure TestTrailingComma;
     procedure TestTrailingCommaErrorArray;
     procedure TestTrailingCommaErrorObject;
@@ -326,6 +330,12 @@ begin
   DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']);
 end;
 
+procedure TTestParser.TestObjectError;
+begin
+
+  DoTestError('{ "name" : value }',[joUTF8]);
+end;
+
 
 procedure TTestParser.DoTestObject(S: String; const ElNames: array of String;
   DoJSONTest: Boolean);
@@ -406,21 +416,21 @@ end;
 procedure TTestParser.TestErrors;
 
 begin
-{
+
   DoTestError('a');
   DoTestError('"b');
   DoTestError('1Tru');
-}
+
   DoTestError('b"');
   DoTestError('{"a" : }');
   DoTestError('{"a" : ""');
   DoTestError('{"a : ""');
-{
+
   DoTestError('[1,]');
   DoTestError('[,]');
   DoTestError('[,,]');
   DoTestError('[1,,]');
-}
+
 end;
 
 procedure TTestParser.TestClasses;
@@ -516,7 +526,7 @@ begin
   end;
 end;
 
-procedure TTestParser.DoTestError(S : String);
+procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
 
 Var
   P : TJSONParser;
@@ -527,7 +537,7 @@ Var
 begin
   ParseOK:=False;
   P:=TJSONParser.Create(S);
-  P.Strict:=True;
+  P.OPtions:=Options;
   J:=Nil;
   Try
     Try

packages/fcl-json/tests/testjsonrtti.pp

@@ -117,7 +117,6 @@ type
     FDS : TJSONDeStreamer;
     FJD : TJSONData;
     FToFree : TObject;
-    FCalled : Boolean;
     procedure DeStream(JSON: TJSONStringType; AObject: TObject);
     procedure DeStream(JSON: TJSONObject; AObject: TObject);
     procedure DoDateTimeFormat;
@@ -1021,7 +1020,6 @@ procedure TTestJSONStreamer.TestCollectionProp2;
 
 Var
   C : TCollectionComponent;
-  F : TJSONObject;
   A : TJSONArray;
 
 begin
@@ -1057,8 +1055,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsProp1;
 
-Var
-  A : TJSONArray;
 begin
   RJ.Options:=[jsoTstringsAsArray];
   StreamObject(TStringsCOmponent.Create(Nil));
@@ -1068,8 +1064,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsProp2;
 
-Var
-  A : TJSONArray;
 begin
   StreamObject(TStringsCOmponent.Create(Nil));
   AssertPropCount(1);
@@ -1267,7 +1261,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsStream4;
 Var
-  O : TJSONObject;
   S : TStringList;
 
 begin
@@ -1598,7 +1591,7 @@ begin
   AssertEquals('Variant type',VarTypeAsText(varSingle),VarTypeAsText(VarType(C.VariantProp)));
   StreamObject(FTofree);
   AssertPropCount(1);
-  AssertProp('VariantProp',3.14);
+  AssertProp('VariantProp',i);
 end;
 
 procedure TTestJSONStreamer.TestVariantdouble;

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/fcl-web/src/base/custfcgi.pp

@@ -354,6 +354,9 @@ begin
     else
       NameValueList.Add(Name+'='+Value)
     end;
+  // Microsoft-IIS hack. IIS includes the script name in the PATH_INFO
+  if Pos('IIS', ServerSoftware) > 0 then
+    SetHTTPVariable(hvPathInfo,StringReplace(PathInfo, ScriptName, '', [rfReplaceAll, rfIgnoreCase]));
 end;
 
 procedure TFCGIRequest.Log(EventType: TEventType; const Msg: String);

packages/fcl-web/src/base/httpdefs.pp

@@ -383,7 +383,7 @@ type
     Property ProtocolVersion : String Index ord(hvHTTPVErsion) Read GetHTTPVariable Write SetHTTPVariable;
     // Specials, mostly from CGI protocol/Apache.
     Property PathInfo : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
-    Property PathTranslated : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
+    Property PathTranslated : String index Ord(hvPathTranslated) read GetHTTPVariable Write SetHTTPVariable;
     Property RemoteAddress : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable;
     Property RemoteAddr : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable; // Alias, Delphi-compat
     Property RemoteHost : String Index Ord(hvRemoteHost) read  GetHTTPVariable Write SetHTTPVariable;

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,18 +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
+   - 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+}
@@ -65,6 +103,8 @@ resourcestring
   sInitializedArraysNotSupported = 'Initialized array variables not yet supported';
   sMemberExprMustBeIdentifier = 'Member expression must be an identifier';
 
+const
+  LoopEndVarName = '$loopend';
 
 Type
 
@@ -98,9 +138,9 @@ Type
   TInitializationContext = Class(TConvertContext)
   end;
 
-  { TProcContext }
+  { TDeclContext }
 
-  TProcContext = Class(TConvertContext)
+  TDeclContext = Class(TConvertContext)
   end;
 
   { TProcBodyContext }
@@ -127,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
@@ -153,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;
@@ -171,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;
@@ -206,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;
@@ -331,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(){}
@@ -422,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;
 
@@ -713,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;
@@ -892,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;
@@ -927,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;
@@ -1011,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;
 
@@ -1031,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
@@ -1067,7 +1113,7 @@ function TPasToJSConverter.ConvertType(El: TPasElement;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertType');
   Result:=Nil;
 {
   ToDo:
@@ -1250,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);
@@ -1284,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;
@@ -1341,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);
@@ -1362,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;
@@ -1377,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
@@ -1393,7 +1440,6 @@ end;
 function TPasToJSConverter.ConvertTryFinallyStatement(El: TPasImplTryFinally;
   AContext: TConvertContext): TJSElement;
 
-
 begin
   Result:=ConvertImplBlockElements(El,AContext);
 end;
@@ -1401,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
@@ -1430,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)
@@ -1466,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;
@@ -1475,7 +1537,7 @@ function TPasToJSConverter.ConvertResString(El: TPasResString;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertResString');
   Result:=Nil;
   // ToDo: TPasResString
 end;
@@ -1484,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;
@@ -1515,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;
@@ -1524,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;
@@ -1533,7 +1597,7 @@ function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;
   AContext: TConvertContext): TJSElement;
 
 begin
-  RaiseNotSupported(El,AContext);
+  RaiseNotSupported(El,AContext,'ConvertExportSymbol');
   Result:=Nil;
   // ToDo: TPasExportSymbol
 end;
@@ -1542,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;
@@ -1593,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;
@@ -1704,54 +1768,67 @@ end;
 
 function TPasToJSConverter.ConvertForStatement(El: TPasImplForLoop;
   AContext: TConvertContext): TJSElement;
+// Creates the following code:
+//   LoopVar=<StartExpr>;
+//   for(var $loopend=<EndExpr>; LoopVar<=$loopend; LoopVar++){}
+//
+// The StartExpr must be executed exactly once at beginning.
+// The EndExpr must be executed exactly once at beginning.
+// The $loopend variable is local to the FOR block. It's only used within
+// the for header, so the name can be the same in other for loops.
+// LoopVar can be a varname or programname.varname
 
 Var
-  F : TJSForStatement;
-  L : TJSStatementList;
-  I : TJSSimpleAssignStatement;
-  V : TJSVarDeclaration;
-  VD : TJSVariableStatement;
-  u : TJSUNaryExpression;
-  B : TJSBinaryExpression;
-  MV : String;
+  ForSt : TJSForStatement;
+  List : TJSStatementList;
+  SimpleAss : TJSSimpleAssignStatement;
+  VarDecl : TJSVarDeclaration;
+  Incr : TJSUNaryExpression;
+  BinExp : TJSBinaryExpression;
   ok: Boolean;
+  VarStat: TJSVariableStatement;
 
 begin
   Result:=Nil;
-  B:=Nil;
-  L:=TJSStatementList(CreateElement(TJSStatementList,El));
-  Result:=L;
+  BinExp:=Nil;
+  // loopvar:=
+  // for (statementlist...
+  List:=TJSStatementList(CreateElement(TJSStatementList,El));
+  Result:=List;
   ok:=false;
   try
-    VD:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
-    L.A:=VD;
-    V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
-    VD.A:=V;
-    MV:=TransformVariableName(El.VariableName,AContext)+'$endloopvalue';
-    V.Name:=MV;
-    V.Init:=ConvertElement(El.EndExpr,AContext);
-    F:=TJSForStatement(CreateElement(TJSForStatement,El));
-    L.B:=F;
-    I:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.StartExpr));
-    F.Init:=I;
-    I.LHS:=CreateIdentifierExpr(El.VariableName,El);
-    I.Expr:=ConvertElement(El.StartExpr,AContext);
+    // add "LoopVar:=<StartExpr>;"
+    SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.StartExpr));
+    SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
+    SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
+    List.A:=SimpleAss;
+    // add "for()"
+    ForSt:=TJSForStatement(CreateElement(TJSForStatement,El));
+    List.B:=ForSt;
+    // add "var $loopend=<EndExpr>"
+    VarStat:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
+    VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
+    VarStat.A:=VarDecl;
+    VarDecl.Name:=LoopEndVarName;
+    VarDecl.Init:=ConvertElement(El.EndExpr,AContext);
+    ForSt.Init:=VarStat;
+    // add "LoopVar<=$loopend"
     If El.Down then
-      begin
-      U:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El));
-      B:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr));
-      end
+      BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr))
     else
-      begin
-      U:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
-      B:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
-      end;
-    F.Incr:=U;
-    F.Cond:=B;
-    U.A:=CreateIdentifierExpr(El.VariableName,El);
-    B.A:=CreateIdentifierExpr(El.VariableName,El);
-    B.B:=CreateIdentifierExpr(MV,El.EndExpr);
-    F.Body:=ConvertElement(El.Body,AContext);
+      BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
+    BinExp.A:=ConvertElement(El.VariableName,AContext);
+    BinExp.B:=CreateIdentifierExpr(LoopEndVarName,El.EndExpr);
+    ForSt.Cond:=BinExp;
+    // add "LoopVar++"
+    If El.Down then
+      Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El))
+    else
+      Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
+    Incr.A:=ConvertElement(El.VariableName,AContext);
+    ForSt.Incr:=Incr;
+    // add body
+    ForSt.Body:=ConvertElement(El.Body,AContext);
     ok:=true;
   finally
     if not ok then
@@ -2042,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;
 
@@ -2088,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
@@ -2139,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
@@ -2152,6 +2272,7 @@ begin
   FS.AFunction := FD;
   Result := FS;
 end;
+
 function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
   AContext: TConvertContext): TJSElement;
 
@@ -2198,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)
 }
@@ -2210,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;
@@ -2219,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;
@@ -2267,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);
@@ -2291,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;
@@ -369,35 +374,47 @@ Var
   F : TPasImplForLoop;
   E : TJSForStatement;
   L : TJSStatementList;
-  VS : TJSVariableStatement;
   VD : TJSVarDeclaration;
   A : TJSSimpleAssignStatement;
   I : TJSUnaryPostPlusPlusExpression;
   C : TJSRelationalExpressionLE;
+  VS: TJSVariableStatement;
 
 begin
-  // For I:=0 to 100 do a:=b;
+  // For I:=1 to 100 do a:=b;
   F:=TPasImplForLoop.Create('',Nil);
   F.Variable:=TPasVariable.Create('I',F);
-  F.VariableName:='I';
+  F.VariableName:=CreateIdent('I');
   F.StartExpr:=CreateLiteral(1);
   F.EndExpr:=CreateLiteral(100);
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
-  VS:=TJSVariableStatement(AssertElement('Start with upper limit temp var',TJSVariableStatement,L.A));
-  VD:=TJSVarDeclaration(AssertElement('Have variable',TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for end value','i$endloopvalue',VD.Name);
-  AssertLiteral('Correct end value',VD.Init,100);
-  E:=TJSForStatement(AssertElement('Second in list is for statement',TJSForStatement,L.B));
-  A:=TJSSimpleAssignStatement(AssertElement('Init statement is assign statement',TJSSimpleAssignStatement,E.Init));
-  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+  // Should be a list of two statements:
+  //   i:=1;
+  //   for(var $loopend=100; i<=$loopend; i++){ a:=b; }
+  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+
+  E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
+
+  // "var $loopend=100"
+  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 '+LoopEndVarName,C.B,LoopEndVarName);
+
+  // i++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
   AssertIdentifier('++ on correct variable name',I.A,'i');
+
+  // body
   AssertAssignStatement('Correct body',E.Body);
-  C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
-  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is end loop value variable',C.B,'i$endloopvalue');
 end;
 
 Procedure TTestStatementConverter.TestForLoopDown;
@@ -405,36 +422,49 @@ Var
   F : TPasImplForLoop;
   E : TJSForStatement;
   L : TJSStatementList;
-  VS : TJSVariableStatement;
   VD : TJSVarDeclaration;
   A : TJSSimpleAssignStatement;
   I : TJSUnaryPostMinusMinusExpression;
   C : TJSRelationalExpressionGE;
+  VS: TJSVariableStatement;
 
 begin
-  // For I:=0 to 100 do a:=b;
+  // For I:=100 downto 1 do a:=b;
   F:=TPasImplForLoop.Create('',Nil);
   F.Variable:=TPasVariable.Create('I',F);
-  F.VariableName:='I';
+  F.VariableName:=CreateIdent('I');
   F.StartExpr:=CreateLiteral(100);
   F.EndExpr:=CreateLiteral(1);
   F.LoopType:=ltDown;
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
-  VS:=TJSVariableStatement(AssertElement('Start with upper limit temp var',TJSVariableStatement,L.A));
-  VD:=TJSVarDeclaration(AssertElement('Have variable',TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for end value','i$endloopvalue',VD.Name);
-  AssertLiteral('Correct end value',VD.Init,1);
-  E:=TJSForStatement(AssertElement('Second in list is for statement',TJSForStatement,L.B));
-  A:=TJSSimpleAssignStatement(AssertElement('Init statement is assign statement',TJSSimpleAssignStatement,E.Init));
-  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+
+  // Should be a list of two statements:
+  //   i:=100;
+  //   for(var $loopend=1; i>=$loopend; i--){ a:=b; }
+  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,L.A));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+
+  E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
+
+  // "var $loopend=1"
+  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 '+LoopEndVarName,C.B,LoopEndVarName);
+
+  // i--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
-  AssertIdentifier('++ on correct variable name',I.A,'i');
+  AssertIdentifier('-- on correct variable name',I.A,'i');
+
+  // body
   AssertAssignStatement('Correct body',E.Body);
-  C:=TJSRelationalExpressionGE(AssertElement('Condition is <= expression',TJSRelationalExpressionGE,E.Cond));
-  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is end loop value variable',C.B,'i$endloopvalue');
 end;
 
 Procedure TTestStatementConverter.TestBeginEndBlockEmpty;
@@ -1308,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