--- Merging r35565 into '.':

U    packages/fcl-json/tests/testjsonrtti.pp
U    packages/fcl-json/src/fpjsonrtti.pp
--- Recording mergeinfo for merge of r35565 into '.':
 U   .
--- Merging r35571 into '.':
U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/tests/testpassrc.lpi
A    packages/fcl-passrc/tests/tcgenerics.pp
U    packages/fcl-passrc/tests/tctypeparser.pas
U    packages/fcl-passrc/tests/testpassrc.lpr
--- Recording mergeinfo for merge of r35571 into '.':
 G   .
--- Merging r35574 into '.':
U    packages/pastojs/fpmake.pp
--- Recording mergeinfo for merge of r35574 into '.':
 G   .
--- Merging r35576 into '.':
U    packages/fcl-js/src/jsscanner.pp
--- Recording mergeinfo for merge of r35576 into '.':
 G   .
--- Merging r35577 into '.':
U    packages/fcl-js/tests/tcwriter.pp
U    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r35577 into '.':
 G   .
--- Merging r35578 into '.':
U    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35578 into '.':
 G   .
--- Merging r35579 into '.':
U    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35579 into '.':
 G   .
--- Merging r35580 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35580 into '.':
 G   .
--- Merging r35581 into '.':
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35581 into '.':
 G   .
--- Merging r35582 into '.':
U    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35582 into '.':
 G   .
--- Merging r35583 into '.':
U    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35583 into '.':
 G   .
--- Merging r35584 into '.':
U    packages/fcl-passrc/tests/tcbaseparser.pas
--- Recording mergeinfo for merge of r35584 into '.':
 G   .
--- Merging r35585 into '.':
U    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35585 into '.':
 G   .
--- Merging r35586 into '.':
G    packages/fcl-passrc/tests/testpassrc.lpr
A    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/tests/testpassrc.lpi
A    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35586 into '.':
 G   .
--- Merging r35587 into '.':
U    packages/pastojs/tests/testpas2js.lpi
--- Recording mergeinfo for merge of r35587 into '.':
 G   .
--- Merging r35588 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35588 into '.':
 G   .
--- Merging r35591 into '.':
U    packages/fcl-passrc/tests/tcexprparser.pas
U    packages/fcl-passrc/tests/tcgenerics.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35591 into '.':
 G   .
--- Merging r35593 into '.':
U    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35593 into '.':
 G   .
--- Merging r35597 into '.':
U    packages/fcl-passrc/tests/tcprocfunc.pas
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35597 into '.':
 G   .
--- Merging r35612 into '.':
G    packages/fcl-passrc/tests/tcgenerics.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35612 into '.':
 G   .
--- Merging r35613 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35613 into '.':
 G   .
--- Merging r35614 into '.':
U    packages/fcl-passrc/tests/tcuseanalyzer.pas
U    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35614 into '.':
 G   .
--- Merging r35615 into '.':
G    packages/pastojs/src/fppas2js.pp
U    packages/pastojs/tests/testpas2js.pp
G    packages/pastojs/tests/tcmodules.pas
A    packages/pastojs/tests/tcoptimizations.pas
G    packages/pastojs/tests/testpas2js.lpi
--- Recording mergeinfo for merge of r35615 into '.':
 G   .
--- Merging r35616 into '.':
G    packages/fcl-passrc/tests/tcgenerics.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35616 into '.':
 G   .
--- Merging r35617 into '.':
G    packages/fcl-passrc/tests/tcgenerics.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35617 into '.':
 G   .
--- Merging r35621 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35621 into '.':
 G   .
--- Merging r35623 into '.':
U    packages/fcl-web/src/base/fpweb.pp
--- Recording mergeinfo for merge of r35623 into '.':
 G   .
--- Merging r35625 into '.':
U    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35625 into '.':
 G   .
--- Merging r35631 into '.':
U    utils/pas2js/dist/rtl.js
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35631 into '.':
 G   .
--- Merging r35633 into '.':
G    packages/fcl-js/src/jswriter.pp
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
U    packages/pastojs/tests/tcconverter.pp
G    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/tests/tcoptimizations.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35633 into '.':
 G   .
--- Merging r35635 into '.':
G    packages/fcl-passrc/tests/testpassrc.lpi
U    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35635 into '.':
 G   .
--- Merging r35636 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35636 into '.':
 G   .
--- Merging r35637 into '.':
G    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35637 into '.':
 G   .
--- Merging r35638 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35638 into '.':
 G   .
--- Merging r35639 into '.':
G    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/tests/tcvarparser.pas
G    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35639 into '.':
 G   .
--- Merging r35640 into '.':
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r35640 into '.':
 G   .
--- Merging r35641 into '.':
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35641 into '.':
 G   .
--- Merging r35642 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35642 into '.':
 G   .
--- Merging r35643 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35643 into '.':
 G   .
--- Merging r35644 into '.':
U    packages/fcl-json/src/jsonconf.pp
--- Recording mergeinfo for merge of r35644 into '.':
 G   .
--- Merging r35648 into '.':
U    packages/fcl-passrc/fpmake.pp
--- Recording mergeinfo for merge of r35648 into '.':
 G   .
--- Merging r35651 into '.':
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r35651 into '.':
 G   .
--- Merging r35652 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35652 into '.':
 G   .
--- Merging r35653 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35653 into '.':
 G   .
--- Merging r35667 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35667 into '.':
 G   .
--- Merging r35668 into '.':
G    packages/pastojs/tests/tcconverter.pp
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/tests/tcoptimizations.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35668 into '.':
 G   .
--- Merging r35680 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35680 into '.':
 G   .
--- Merging r35681 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35681 into '.':
 G   .
--- Merging r35682 into '.':
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r35682 into '.':
 G   .
--- Merging r35683 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35683 into '.':
 G   .
--- Merging r35691 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35691 into '.':
 G   .
--- Merging r35692 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35692 into '.':
 G   .
--- Merging r35693 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35693 into '.':
 G   .
--- Merging r35694 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35694 into '.':
 G   .
--- Merging r35695 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35695 into '.':
 G   .
--- Merging r35696 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35696 into '.':
 G   .
--- Merging r35697 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35697 into '.':
 G   .
--- Merging r35702 into '.':
G    packages/fcl-passrc/tests/tcbaseparser.pas
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35702 into '.':
 G   .
--- Merging r35703 into '.':
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35703 into '.':
 G   .
--- Merging r35704 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35704 into '.':
 G   .
--- Merging r35705 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35705 into '.':
 G   .
--- Merging r35706 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35706 into '.':
 G   .
--- Merging r35708 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r35708 into '.':
 G   .
--- Merging r35709 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35709 into '.':
 G   .
--- Merging r35710 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35710 into '.':
 G   .
--- Merging r35711 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35711 into '.':
 G   .
--- Merging r35713 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35713 into '.':
 G   .
--- Merging r35714 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35714 into '.':
 G   .
--- Merging r35715 into '.':
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35715 into '.':
 G   .
--- Merging r35716 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35716 into '.':
 G   .
--- Merging r35718 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35718 into '.':
 G   .
--- Merging r35719 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35719 into '.':
 G   .
--- Merging r35720 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35720 into '.':
 G   .
--- Merging r35728 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pastree.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35728 into '.':
 G   .
--- Merging r35729 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35729 into '.':
 G   .
--- Merging r35731 into '.':
G    packages/fcl-passrc/src/pasuseanalyzer.pas
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r35731 into '.':
 G   .
--- Merging r35732 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35732 into '.':
 G   .
--- Merging r35735 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35735 into '.':
 G   .
--- Merging r35736 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35736 into '.':
 G   .
--- Merging r35737 into '.':
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
--- Recording mergeinfo for merge of r35737 into '.':
 G   .
--- Merging r35738 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35738 into '.':
 G   .

# revisions: 35565,35571,35574,35576,35577,35578,35579,35580,35581,35582,35583,35584,35585,35586,35587,35588,35591,35593,35597,35612,35613,35614,35615,35616,35617,35621,35623,35625,35631,35633,35635,35636,35637,35638,35639,35640,35641,35642,35643,35644,35648,35651,35652,35653,35667,35668,35680,35681,35682,35683,35691,35692,35693,35694,35695,35696,35697,35702,35703,35704,35705,35706,35708,35709,35710,35711,35713,35714,35715,35716,35718,35719,35720,35728,35729,35731,35732,35735,35736,35737,35738

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

.gitattributes

@@ -2532,6 +2532,7 @@ packages/fcl-passrc/src/pasresolver.pp svneol=native#text/plain
 packages/fcl-passrc/src/passrcutil.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastounittest.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
+packages/fcl-passrc/src/pasuseanalyzer.pas svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
 packages/fcl-passrc/src/pparser.pp svneol=native#text/plain
 packages/fcl-passrc/src/pscanner.pp svneol=native#text/plain
@@ -2539,6 +2540,7 @@ packages/fcl-passrc/src/readme.txt svneol=native#text/plain
 packages/fcl-passrc/tests/tcbaseparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcclasstype.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcexprparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcgenerics.pp svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
@@ -2547,6 +2549,7 @@ packages/fcl-passrc/tests/tcresolver.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcuseanalyzer.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcvarparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
@@ -6524,6 +6527,7 @@ packages/pastojs/fpmake.pp svneol=native#text/plain
 packages/pastojs/src/fppas2js.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
+packages/pastojs/tests/tcoptimizations.pas svneol=native#text/plain
 packages/pastojs/tests/testpas2js.lpi svneol=native#text/plain
 packages/pastojs/tests/testpas2js.pp svneol=native#text/plain
 packages/pastojs/todo.txt svneol=native#text/plain

packages/fcl-js/src/jsscanner.pp

@@ -515,7 +515,10 @@ begin
       FCurToken := Result;
       exit;
       end;
+    {$Push}
+    {$R-}
     I:=Succ(I);
+    {$Pop}
     end
 end;
 

packages/fcl-js/src/jswriter.pp

@@ -127,7 +127,7 @@ Type
     // one per type of statement
     Procedure WriteValue(V : TJSValue);  virtual;
     Procedure WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral);
-    Procedure WriteVariableStatement(el: TJSVariableStatement);
+    Procedure WriteVariableStatement(El: TJSVariableStatement);
     Procedure WriteEmptyBlockStatement(El: TJSEmptyBlockStatement); virtual;
     Procedure WriteEmptyStatement(El: TJSEmptyStatement);virtual;
     Procedure WriteLiteral(El: TJSLiteral);virtual;
@@ -157,6 +157,8 @@ Type
     Procedure WriteFuncDef(FD: TJSFuncDef);virtual;
     Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual;
     Procedure WriteBinary(El: TJSBinary);virtual;
+    Function IsEmptyStatement(El: TJSElement): boolean;
+    Function HasLineEnding(El: TJSElement): boolean;
   Public
     Function EscapeString(const S: TJSString; Quote: TJSEscapeQuote = jseqDouble): TJSString;
     Constructor Create(AWriter : TTextWriter);
@@ -584,6 +586,7 @@ procedure TJSWriter.WriteFuncDef(FD: TJSFuncDef);
 Var
   C : Boolean;
   I : Integer;
+  A: TJSElement;
 
 begin
   C:=(woCompact in Options);
@@ -609,10 +612,11 @@ begin
     FSkipCurlyBrackets:=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))
+    A:=FD.Body.A;
+    If (Assigned(A))
+        and (not (A is TJSStatementList))
+        and (not (A is TJSSourceElements))
+        and (not (A is TJSEmptyBlockStatement))
     then
       if C then
         Write('; ')
@@ -780,7 +784,8 @@ begin
   if (MExpr is TJSPrimaryExpression)
       or (MExpr is TJSDotMemberExpression)
       or (MExpr is TJSBracketMemberExpression)
-      or (MExpr is TJSCallExpression)
+      // Note: new requires brackets in this case: new (a())()
+      or ((MExpr is TJSCallExpression) and not (El is TJSNewMemberExpression))
       or (MExpr is TJSLiteral) then
     WriteJS(MExpr)
   else
@@ -861,7 +866,7 @@ begin
     Indent;
     if not C then writeln('');
     end;
-  if Assigned(El.A) and (El.A.ClassType<>TJSEmptyBlockStatement) then
+  if not IsEmptyStatement(El.A) then
     begin
     WriteJS(El.A);
     LastEl:=El.A;
@@ -880,6 +885,12 @@ begin
       end;
     if (not C) and not (LastEl is TJSStatementList) then
       writeln(';');
+    end
+  else if Assigned(El.B) then
+    begin
+    WriteJS(El.B);
+    if (not C) and not (El.B is TJSStatementList) then
+      writeln(';');
     end;
   if B then
     begin
@@ -920,6 +931,9 @@ Var
   S : AnsiString;
   AllowCompact, WithBrackets: Boolean;
 begin
+  {$IFDEF VerboseJSWriter}
+  System.writeln('TJSWriter.WriteBinary SkipRoundBrackets=',FSkipRoundBrackets);
+  {$ENDIF}
   WithBrackets:=not FSkipRoundBrackets;
   if WithBrackets then
     Write('(');
@@ -939,6 +953,25 @@ begin
     Write(')');
 end;
 
+function TJSWriter.IsEmptyStatement(El: TJSElement): boolean;
+begin
+  if (El=nil) then
+    exit(true);
+  if (El.ClassType=TJSEmptyStatement) and not (woEmptyStatementAsComment in Options) then
+    exit(true);
+  Result:=false;
+end;
+
+function TJSWriter.HasLineEnding(El: TJSElement): boolean;
+begin
+  if El<>nil then
+    begin
+    if (El.ClassType=TJSStatementList) or (El.ClassType=TJSSourceElements) then
+      exit(true);
+    end;
+  Result:=false;
+end;
+
 procedure TJSWriter.WriteConditionalExpression(El: TJSConditionalExpression);
 
 begin
@@ -981,24 +1014,51 @@ end;
 
 procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
 
+var
+  HasBTrue, C, HasBFalse, BTrueNeedBrackets: Boolean;
 begin
+  C:=woCompact in Options;
   Write('if (');
   FSkipRoundBrackets:=true;
   WriteJS(El.Cond);
   FSkipRoundBrackets:=false;
   Write(')');
-  If Not (woCompact in Options) then
+  If Not C then
     Write(' ');
-  if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then
+  HasBTrue:=not IsEmptyStatement(El.BTrue);
+  HasBFalse:=not IsEmptyStatement(El.BFalse);
+  if HasBTrue then
     begin
+    // Note: the 'else' needs {} in front
+    BTrueNeedBrackets:=HasBFalse and not (El.BTrue is TJSStatementList)
+      and not (El.BTrue is TJSEmptyBlockStatement);
+    if BTrueNeedBrackets then
+      if C then
+        Write('{')
+      else
+        begin
+        Writeln('{');
+        Indent;
+        end;
     WriteJS(El.BTrue);
+    if BTrueNeedBrackets then
+      if C then
+        Write('}')
+      else
+        begin
+        Undent;
+        Writeln('}');
+        end;
     end;
-  if Assigned(El.BFalse) then
+  if HasBFalse then
     begin
-    if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then
-      Writeln('{}')
-    else if not (El.BTrue is TJSStatementList) then
-      Writeln('')
+    if not HasBTrue then
+      begin
+      if C then
+        Write('{}')
+      else
+        Writeln('{}');
+      end
     else
       Write(' ');
     Write('else ');
@@ -1117,28 +1177,37 @@ begin
       WriteJS(EC.Expr);
       FSkipRoundBrackets:=false;
       end;
-    If C then
-      Write(': ')
-    else
-      Writeln(':');
     if Assigned(EC.Body) then
       begin
       FSkipCurlyBrackets:=true;
+      If C then
+        Write(': ')
+      else
+        Writeln(':');
       Indent;
       WriteJS(EC.Body);
       Undent;
-      if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
+      if (EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement) then
+        begin
         if C then
-          Write('; ')
+          begin
+          if I<El.Cases.Count-1 then
+            Write(' ');
+          end
         else
-          Writeln(';');
+          Writeln('');
+        end
+      else if C then
+        Write('; ')
+      else
+        Writeln(';');
       end
     else
       begin
       if C then
-        Write('; ')
+        Write(': ')
       else
-        Writeln(';');
+        Writeln(':');
       end;
     end;
   Write('}');
@@ -1213,11 +1282,15 @@ Var
 begin
   C:=woCompact in Options;
   Write('try {');
-  if Not C then writeln('');
-  FSkipCurlyBrackets:=True;
-  Indent;
-  WriteJS(El.Block);
-  Undent;
+  if not IsEmptyStatement(El.Block) then
+    begin
+    if Not C then writeln('');
+    FSkipCurlyBrackets:=True;
+    Indent;
+    WriteJS(El.Block);
+    if (Not C) and (not (El.Block is TJSStatementList)) then writeln('');
+    Undent;
+    end;
   Write('}');
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
     begin
@@ -1227,10 +1300,14 @@ begin
       Write(' {')
     else
       Writeln(' {');
-    FSkipCurlyBrackets:=True;
-    Indent;
-    WriteJS(El.BCatch);
-    Undent;
+    if not IsEmptyStatement(El.BCatch) then
+      begin
+      FSkipCurlyBrackets:=True;
+      Indent;
+      WriteJS(El.BCatch);
+      Undent;
+      if (Not C) and (not (El.BCatch is TJSStatementList)) then writeln('');
+      end;
     Write('}');
     end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then
@@ -1239,10 +1316,14 @@ begin
       Write(' finally {')
     else
       Writeln(' finally {');
-    Indent;
-    FSkipCurlyBrackets:=True;
-    WriteJS(El.BFinally);
-    Undent;
+    if not IsEmptyStatement(El.BFinally) then
+      begin
+      Indent;
+      FSkipCurlyBrackets:=True;
+      WriteJS(El.BFinally);
+      Undent;
+      if (Not C) and (not (El.BFinally is TJSStatementList)) then writeln('');
+      end;
     Write('}');
     end;
 end;
@@ -1251,7 +1332,7 @@ procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody);
 
 begin
   //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipCurlyBrackets,'true','false'));
-  if Assigned(El.A) and (not (El.A is TJSEmptyBlockStatement)) then
+  if not IsEmptyStatement(El.A) then
     WriteJS(El.A);
 end;
 
@@ -1295,11 +1376,11 @@ begin
   WriteElements(El.Statements);
 end;
 
-procedure TJSWriter.WriteVariableStatement(el: TJSVariableStatement);
+procedure TJSWriter.WriteVariableStatement(El: TJSVariableStatement);
 
 begin
   Write('var ');
-  WriteJS(EL.A);
+  WriteJS(El.A);
 end;
 
 procedure TJSWriter.WriteJS(El: TJSElement);

packages/fcl-js/tests/tcwriter.pp

@@ -84,6 +84,8 @@ type
   Public
     Procedure TestAssignment(Const Msg : String; AClass : TJSAssignStatementClass; Result : String;ACompact : Boolean);
     Function CreateAssignment(AClass : TJSAssignStatementClass) : TJSAssignStatement;
+    Function CreateStatementListOneElement : TJSStatementList;
+    Function CreateStatementListTwoElement2 : TJSStatementList;
   published
     Procedure TestEmptyStatement;
     Procedure TestEmptyStatementComment;
@@ -130,6 +132,7 @@ type
     Procedure TestAssignmentStatementBinaryAndCompact;
     Procedure TestForStatementEmpty;
     Procedure TestForStatementFull;
+    Procedure TestForStatementFull1;
     Procedure TestForStatementCompact;
     Procedure TestForInStatement;
     Procedure TestWhileStatement;
@@ -152,6 +155,7 @@ type
     Procedure TestStatementListOneStatementCompact;
     Procedure TestStatementListTwoStatements;
     Procedure TestStatementListTwoStatementsCompact;
+    Procedure TestStatementListFor;
     Procedure TestEmptyFunctionDef;
     Procedure TestEmptyFunctionDefCompact;
     Procedure TestFunctionDefParams;
@@ -628,7 +632,7 @@ begin
   U.Args:=TJSArguments.Create(0,0);
   U.Args.Elements.AddElement;
   U.Args.Elements[0].Expr:=CreateLiteral(123);
-  AssertWrite('member b of object a (a[b])','new a('+slinebreak+'123'+sLineBreak+')',U);
+  AssertWrite('member b of object a (a[b])','new a(123)',U);
 end;
 
 Procedure TTestExpressionWriter.TestNewMemberCompact;
@@ -666,7 +670,8 @@ begin
   U.Args:=TJSArguments.Create(0,0);
   U.Args.Elements.AddElement;
   U.Args.Elements[0].Expr:=CreateLiteral(123);
-  AssertWrite('call a(123)','a('+slinebreak+'123'+sLineBreak+')',U);
+  AssertWrite('call a(123)',
+     'a(123)',U);
 end;
 
 Procedure TTestExpressionWriter.TestCallCompact;
@@ -696,7 +701,7 @@ begin
   U.Args.Elements[0].Expr:=CreateLiteral(123);
   U.Args.Elements.AddElement;
   U.Args.Elements[1].Expr:=CreateLiteral(456);
-  AssertWrite('call a(123,456)','a(123, 456)',U);
+  AssertWrite('call a(123,456)','a(123,456)',U);
 
 end;
 
@@ -767,6 +772,19 @@ begin
   Result.Expr:=CreateIdent('b');
 end;
 
+function TTestStatementWriter.CreateStatementListOneElement: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+end;
+
+function TTestStatementWriter.CreateStatementListTwoElement2: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+  Result.B:=CreateAssignment(nil);
+end;
+
 Procedure TTestStatementWriter.TestEmptyStatement;
 
 begin
@@ -1120,7 +1138,6 @@ end;
 
 Procedure TTestStatementWriter.TestForStatementFull;
 
-
 Var
   S : TJSForStatement;
   UPP : TJSUnaryPostPlusPlusExpression;
@@ -1141,7 +1158,35 @@ begin
   S.Incr:=UPP;
   S.Cond:=CL;
   S.Body:=TJSEmptyBlockStatement.Create(0,0);
-  AssertWrite('for i:=0 to 9','for (i = 0; (i < 10); i++) {'+sLineBreak+'}',S);
+  AssertWrite('for i:=0 to 9','for (i = 0; i < 10; i++) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatementFull1;
+
+Var
+  S : TJSForStatement;
+  UPP : TJSUnaryPostPlusPlusExpression;
+  CL : TJSRelationalExpressionLT;
+  sa : TJSSimpleAssignStatement;
+
+begin
+  SA:=TJSSimpleAssignStatement.Create(0,0);
+  SA.LHS:=CreateIdent('i');
+  SA.Expr:=CreateLiteral(0);
+  UPP:=TJSUnaryPostPlusPlusExpression.Create(0,0);
+  UPP.A:=CreateIdent('i');
+  CL:=TJSRelationalExpressionLT.Create(0,0);
+  CL.A:=CreateIdent('i');
+  CL.B:=CreateLiteral(10);
+  S:=TJSForStatement.Create(0,0);
+  S.Init:=SA;
+  S.Incr:=UPP;
+  S.Cond:=CL;
+  S.Body:=CreateStatementListOneElement;
+  AssertWrite('for i:=0 to 9',
+     'for (i = 0; i < 10; i++) {'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestForStatementCompact;
@@ -1166,7 +1211,7 @@ begin
   S.Cond:=CL;
   S.Body:=TJSEmptyBlockStatement.Create(0,0);
   Writer.Options:=[woCompact,woUseUTF8];
-  AssertWrite('for i:=0 to 9','for (i=0; (i<10); i++) {}',S);
+  AssertWrite('for i:=0 to 9','for (i=0; i<10; i++) {}',S);
 end;
 
 Procedure TTestStatementWriter.TestForInStatement;
@@ -1288,7 +1333,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   C.Expr:=CreateIdent('d');
-  AssertWrite('switch ','switch (a) {case c: {}case d: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: {} case d: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsDefault;
@@ -1327,7 +1372,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {case c: {}case d: {}default: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: {} case d: {} default: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmpty;
@@ -1345,7 +1390,16 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {'+sLineBreak+'case c:'+sLineBreak+'case d:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'default:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'}',S);
+  AssertWrite('switch ',
+     'switch (a) {'+sLineBreak
+    +'case c:'+sLineBreak
+    +'case d:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'default:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmptyCompact;
@@ -1364,7 +1418,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {case c: case d: {}default: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: case d: {} default: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestIfThen;
@@ -1389,7 +1443,10 @@ begin
   S.Cond:=CreateIdent('a');
   S.btrue:=TJSEmptyBlockStatement.Create(0,0);
   S.bfalse:=TJSEmptyBlockStatement.Create(0,0);
-  AssertWrite('if then','if (a) {'+sLineBreak+'} else {'+sLineBreak+'}',S);
+  AssertWrite('if then',
+     'if (a) {'+sLineBreak
+    +'} else {'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListEmpty;
@@ -1415,12 +1472,14 @@ end;
 Procedure TTestStatementWriter.TestStatementListOneStatement;
 Var
   S : TJSStatementList;
-
 begin
 //  Writer.Options:=[woCompact,woUseUTF8];
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'}',S);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListOneStatementCompact;
@@ -1444,7 +1503,11 @@ begin
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
   S.B:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'a = b;'+sLineBreak+'}',S);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListTwoStatementsCompact;
@@ -1459,6 +1522,21 @@ begin
   AssertWrite('Statement list','{a=b; a=b}',S);
 end;
 
+procedure TTestStatementWriter.TestStatementListFor;
+Var
+  S : TJSStatementList;
+begin
+  // Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=TJSForStatement.Create(0,0);
+  TJSForStatement(S.A).Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'for (; ; ) {'+sLineBreak
+    +'};'+sLineBreak
+    +'}',S);
+end;
+
 Procedure TTestStatementWriter.TestEmptyFunctionDef;
 
 Var
@@ -1468,7 +1546,9 @@ begin
   FD:=TJSFunctionDeclarationStatement.Create(0,0);
   FD.AFunction:=TJSFuncDef.Create;
   FD.AFunction.Name:='a';
-  AssertWrite('Empty function','function a() {'+sLineBreak+'}',FD);
+  AssertWrite('Empty function',
+     'function a() {'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestEmptyFunctionDefCompact;
@@ -1497,7 +1577,9 @@ begin
   FD.AFunction.Params.Add('c');
   FD.AFunction.Params.Add('d');
 
-  AssertWrite('Empty function, 3 params','function a(b, c, d) {'+sLineBreak+'}',FD);
+  AssertWrite('Empty function, 3 params',
+     'function a(b, c, d) {'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefParamsCompact;
@@ -1532,7 +1614,10 @@ begin
   R:=TJSReturnStatement.Create(0,0);
   R.Expr:=CreateLiteral(0);
   FD.AFunction.Body.A:=R;
-  AssertWrite('1 statement, ','function a() {'+sLineBreak+'  return 0;'+sLineBreak+'}',FD);
+  AssertWrite('1 statement, ',
+     'function a() {'+sLineBreak
+    +'  return 0;'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefBody1Compact;
@@ -1581,7 +1666,11 @@ begin
   L.A:=A;
   L.B:=R;
   FD.AFunction.Body.A:=L;
-  AssertWrite('Function, 2 statements','function a(b) {'+sLineBreak+'  b = (b * 10);'+sLineBreak+'  return b;'+sLineBreak+'}',FD);
+  AssertWrite('Function, 2 statements',
+     'function a(b) {'+sLineBreak
+    +'  b = b * 10;'+sLineBreak
+    +'  return b;'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefBody2Compact;
@@ -1612,7 +1701,7 @@ begin
   L.A:=A;
   L.B:=R;
   FD.AFunction.Body.A:=L;
-  AssertWrite('Function, 2 statements, compact','function a(b) {b=(b*10); return b}',FD);
+  AssertWrite('Function, 2 statements, compact','function a(b) {b=b*10; return b}',FD);
 end;
 
 Procedure TTestStatementWriter.TestTryCatch;
@@ -1637,7 +1726,12 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BCatch:=A;
-  AssertWrite('Try catch','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'catch (e) {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try catch',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 1'+sLineBreak
+    +'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchCompact;
@@ -1662,7 +1756,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BCatch:=A;
-  AssertWrite('Try catch compact','try {b=(b*10)} catch (e) {b=1}',T);
+  AssertWrite('Try catch compact','try {b=b*10} catch (e) {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryFinally;
@@ -1687,7 +1781,12 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'finally {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try finally ',
+    'try {'+sLineBreak
+   +'  b = b * 10'+sLineBreak
+   +'} finally {'+sLineBreak
+   +'  b = 1'+sLineBreak
+   +'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryFinallyCompact;
@@ -1713,7 +1812,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally compact','try {b=(b*10)} finally {b=1}',T);
+  AssertWrite('Try finally compact','try {b=b*10} finally {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchFinally;
@@ -1741,7 +1840,13 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'catch (e) {'+sLineBreak+'  b = 10'+sLineBreak+'}'+sLineBreak+'finally {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try finally ',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 10'+sLineBreak
+    +'} finally {'+sLineBreak
+    +'  b = 1'+sLineBreak+'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchFinallyCompact;
@@ -1770,7 +1875,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {b=(b*10)} catch (e) {b=10} finally {b=1}',T);
+  AssertWrite('Try finally ','try {b=b*10} catch (e) {b=10} finally {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestWith;
@@ -1791,7 +1896,7 @@ begin
   M.B:=CreateLiteral(10);
   A.Expr:=M;
   T.B:=A;
-  AssertWrite('With statement ','with (e)'+slineBreak+'  b = (b * 10)',T);
+  AssertWrite('With statement ','with (e)'+slineBreak+'  b = b * 10',T);
 end;
 
 Procedure TTestStatementWriter.TestWithCompact;
@@ -1812,7 +1917,7 @@ begin
   M.B:=CreateLiteral(10);
   A.Expr:=M;
   T.B:=A;
-  AssertWrite('With statement ','with (e) b=(b*10)',T);
+  AssertWrite('With statement ','with (e) b=b*10',T);
 end;
 
 Procedure TTestStatementWriter.TestSourceElements;
@@ -1839,7 +1944,7 @@ begin
   M.B:=CreateLiteral(2);
   A.Expr:=M;
   T.Statements.AddNode.Node:=A;
-  AssertWrite('Statement lists ','b = (b * 10);'+sLineBreak+'c = (c * 2);'+sLineBreak,T);
+  AssertWrite('Statement lists ','b = b * 10;'+sLineBreak+'c = c * 2;'+sLineBreak,T);
 end;
 
 Procedure TTestStatementWriter.TestSourceElementsCompact;
@@ -1866,7 +1971,7 @@ begin
   M.B:=CreateLiteral(2);
   A.Expr:=M;
   T.Statements.AddNode.Node:=A;
-  AssertWrite('Statement lists compact','b=(b*10); c=(c*2);',T);
+  AssertWrite('Statement lists compact','b=b*10; c=c*2;',T);
 end;
 
 { ---------------------------------------------------------------------
@@ -1931,7 +2036,7 @@ Var
 begin
   L:=TJSLiteral.Create(0,0,'');
   L.Value.AsString:='ab"cd';
-  AssertWrite('ab"cd','"ab\"cd"',L);
+  AssertWrite('ab"cd','''ab"cd''',L);
 end;
 
 Procedure TTestLiteralWriter.TestStringBackslash;
@@ -2027,7 +2132,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=1;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'1'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayOneElementCompact;
@@ -2056,7 +2161,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=1;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'  1'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElements;
@@ -2073,7 +2178,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'1,'+sLineBreak+'2'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1, 2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElementsCompact;
@@ -2090,7 +2195,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2]',L);
+  AssertWrite('Empty array ','[1,2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElementsCompact2;
@@ -2107,7 +2212,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2]',L);
+  AssertWrite('Empty array ','[1,2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayThreeElementsCompact;
@@ -2127,7 +2232,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=3;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2, 3]',L);
+  AssertWrite('Empty array ','[1,2,3]',L);
 end;
 
 Procedure TTestLiteralWriter.TestObjectEmpty;
@@ -2372,7 +2477,7 @@ Var
   S : UnicodeString;
 begin
   S:=FTextWriter.AsUnicodeString;
-  AssertEquals(Msg,Result,S);
+  AssertEquals(Msg,String(Result),String(S));
 end;
 
 Procedure TTestJSWriter.AssertWrite(Const Msg, Result: String;

packages/fcl-json/src/fpjsonrtti.pp

@@ -524,7 +524,7 @@ begin
     try
       For I:=0 to PIL.Count-1 do
         begin
-        J:=JSON.IndexOfName(Pil.Items[i]^.Name,FCaseInsensitive);
+        J:=JSON.IndexOfName(Pil.Items[i]^.Name,(jdoCaseInsensitive in Options));
         If (J<>-1) then
           RestoreProperty(AObject,PIL.Items[i],JSON.Items[J]);
         end;

packages/fcl-json/src/jsonconf.pp

@@ -724,7 +724,7 @@ Var
   F : TFileStream;
 
 begin
-  F:=TFileStream.Create(AFileName,fmopenRead);
+  F:=TFileStream.Create(AFileName,fmopenRead or fmShareDenyWrite);
   try
     LoadFromStream(F);
   finally

packages/fcl-json/tests/testjsonrtti.pp

@@ -140,6 +140,8 @@ type
     procedure TestEmpty;
     procedure TestBoolean;
     procedure TestInteger;
+    procedure TestIntegerCaseInsensitive;
+    procedure TestIntegerCaseSensitive;
     procedure TestString;
     procedure TestFloat;
     procedure TestFloat2;
@@ -318,6 +320,31 @@ begin
   AssertEquals('Correct integer value',22,B.IntProp);
 end;
 
+procedure TTestJSONDeStreamer.TestIntegerCaseInsensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options+[jdoCaseInsensitive];
+  B:=TIntegerComponent.Create(Nil);
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value',22,B.IntProp);
+end;
+
+procedure TTestJSONDeStreamer.TestIntegerCaseSensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options;
+  B:=TIntegerComponent.Create(Nil);
+  B.IntProp:=0;
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value not reas',0,B.IntProp);
+end;
+
 procedure TTestJSONDeStreamer.TestString;
 
 Var

packages/fcl-passrc/fpmake.pp

@@ -69,6 +69,11 @@ begin
         begin
           AddUnit('pastree');
         end;
+    T:=P.Targets.AddUnit('pasuseanalyzer.pas');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+        end;
 
 {$ifndef ALLPACKAGES}
     Run;

packages/fcl-passrc/src/pastree.pp

@@ -174,7 +174,7 @@ type
   TPasExpr = class(TPasElement)
     Kind      : TPasExprKind;
     OpCode    : TExprOpCode;
-    format1,format2 : TPasExpr;
+    format1,format2 : TPasExpr; // write, writeln, str
     constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TExprOpCode); virtual; overload;
     destructor Destroy; override;
   end;
@@ -346,7 +346,7 @@ type
   public
     InterfaceSection: TInterfaceSection;
     ImplementationSection: TImplementationSection;
-    InitializationSection: TInitializationSection;
+    InitializationSection: TInitializationSection; // in TPasProgram the begin..end.
     FinalizationSection: TFinalizationSection;
     PackageName: string;
     Filename   : String;  // the IN filename, only written when not empty.
@@ -369,6 +369,7 @@ type
   Public
     ProgramSection: TProgramSection;
     InputFile,OutPutFile : String;
+    // Note: the begin..end. block is in the InitializationSection
   end;
 
   { TPasLibrary }
@@ -506,7 +507,7 @@ type
     ElType: TPasType;
   end;
 
-  { TPasEnumValue }
+  { TPasEnumValue - Parent is TPasEnumType }
 
   TPasEnumValue = class(TPasElement)
   public
@@ -605,16 +606,23 @@ type
     AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
     HelperForType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsForward: Boolean;
+    IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     GUIDExpr : TPasExpr;
     Members: TFPList;     // list of TPasElement
     Modifiers: TStringList;
     Interfaces : TFPList; // list of TPasElement
     GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
+    ExternalNameSpace : String;
+    ExternalName : String;
+    Procedure SetGenericTemplates(AList : TFPList);
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function IsPacked : Boolean;
     Function InterfaceGUID : string;
+    Function IsSealed : Boolean;
+    Function IsAbstract : Boolean;
+    Function HasModifier(const aModifier: String): Boolean;
   end;
 
 
@@ -821,7 +829,8 @@ type
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward, pmDispId, pmNoReturn);
+                        pmCompilerProc,pmExternal,pmForward, pmDispId, 
+                        pmNoReturn, pmfar);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -845,9 +854,9 @@ type
   public
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
-    PublicName,
+    PublicName, // e.g. public PublicName;
     LibrarySymbolName,
-    LibraryExpr : TPasExpr;
+    LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     DispIDExpr :  TPasExpr;
     AliasName : String;
     Procedure AddModifier(AModifier : TProcedureModifier);
@@ -1217,6 +1226,7 @@ Type
   end;
 
   { TPasImplForLoop }
+
   TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
   public
@@ -1340,6 +1350,7 @@ Type
 
 const
   AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
+  AccessDescriptions: array[TArgumentAccess] of string[9] = ('default', 'const', 'var', 'out','constref');
   AllVisibilities: TPasMemberVisibilities =
      [visDefault, visPrivate, visProtected, visPublic,
       visPublished, visAutomated];
@@ -1404,7 +1415,8 @@ const
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
                    'static','inline','assembler','varargs', 'public',
-                   'compilerproc','external','forward','dispid','noreturn');
+                   'compilerproc','external','forward','dispid',
+                   'noreturn','far');
 
   VariableModifierNames : Array[TVariableModifier] of string
      = ('cvar', 'external', 'public', 'export', 'class', 'static');
@@ -2309,6 +2321,8 @@ begin
     okSpecialize : Result := SPasTreeSpecializedType;
     okClassHelper : Result:=SPasClassHelperType;
     okRecordHelper : Result:=SPasRecordHelperType;
+  else
+    Result:='ObjKind('+IntToStr(ord(ObjKind))+')';
   end;
 end;
 
@@ -2330,6 +2344,21 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
 end;
 
+procedure TPasClassType.SetGenericTemplates(AList: TFPList);
+
+Var
+  I : Integer;
+
+begin
+  ObjKind:=okGeneric;
+  For I:=0 to AList.Count-1 do
+    begin
+    TPasElement(AList[i]).Parent:=Self;
+    GenericTemplateTypes.Add(AList[i]);
+    end;
+  ObjKind:=okGeneric;
+end;
+
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
 
 Var
@@ -2381,6 +2410,26 @@ begin
     Result:=''
 end;
 
+function TPasClassType.IsSealed: Boolean;
+begin
+  Result:=HasModifier('sealed');
+end;
+
+function TPasClassType.IsAbstract: Boolean;
+begin
+  Result:=HasModifier('abstract');
+end;
+
+function TPasClassType.HasModifier(const aModifier: String): Boolean;
+var
+  i: Integer;
+begin
+  for i:=0 to Modifiers.Count-1 do
+    if CompareText(aModifier,Modifiers[i])=0 then
+      exit(true);
+  Result:=false;
+end;
+
 function TPasClassType.IsPacked: Boolean;
 begin
   Result:=PackMode<>pmNone;
@@ -2648,7 +2697,7 @@ begin
   if IfBranch=nil then
     begin
     IfBranch:=Element;
-    element.AddRef;
+    Element.AddRef;
     end
   else if ElseBranch=nil then
     begin
@@ -2667,10 +2716,12 @@ end;
 procedure TPasImplIfElse.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
-  ForEachChildCall(aMethodCall,Arg,IfBranch,false);
-  ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  if Elements.IndexOf(IfBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,IfBranch,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplIfElse.Condition: string;
@@ -2704,12 +2755,13 @@ end;
 procedure TPasImplForLoop.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,VariableName,false);
   ForEachChildCall(aMethodCall,Arg,Variable,false);
   ForEachChildCall(aMethodCall,Arg,StartExpr,false);
   ForEachChildCall(aMethodCall,Arg,EndExpr,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplForLoop.Down: boolean;
@@ -3886,15 +3938,16 @@ begin
     Body.AddRef;
     end
   else
-    raise Exception.Create('TPasImplWhileDo.AddElement body already set - please report this bug');
+    raise Exception.Create('TPasImplWhileDo.AddElement body already set');
 end;
 
 procedure TPasImplWhileDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplWhileDo.Condition: string;
@@ -3937,9 +3990,10 @@ end;
 procedure TPasImplCaseOf.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,CaseExpr,false);
-  ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplCaseOf.Expression: string;
@@ -3980,6 +4034,8 @@ begin
     Body:=Element;
     Body.AddRef;
     end
+  else
+    raise Exception.Create('TPasImplCaseStatement.AddElement body already set');
 end;
 
 procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
@@ -3993,10 +4049,11 @@ procedure TPasImplCaseStatement.ForEachCall(
 var
   i: Integer;
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to Expressions.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 { TPasImplWithDo }
@@ -4026,7 +4083,9 @@ begin
     begin
     Body:=Element;
     Body.AddRef;
-    end;
+    end
+  else
+    raise Exception.Create('TPasImplWithDo.AddElement body already set');
 end;
 
 procedure TPasImplWithDo.AddExpression(const Expression: TPasExpr);
@@ -4039,10 +4098,11 @@ procedure TPasImplWithDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
 var
   i: Integer;
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to Expressions.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 { TPasImplTry }
@@ -4105,10 +4165,11 @@ end;
 procedure TPasImplExceptOn.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,VarEl,false);
   ForEachChildCall(aMethodCall,Arg,TypeEl,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplExceptOn.VariableName: String;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -0,0 +1,1843 @@
+{
+    This file is part of the Free Component Library
+
+    Pascal parse tree classes
+    Copyright (c) 2017  Mattias Gaertner, [email protected]
+
+    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.
+
+ **********************************************************************}
+{
+Abstract:
+  After running TPasResolver, run this to
+  - create a list of used declararion, either in a module or a whole program.
+  - emit hints about unused declarations
+  - and warnings about uninitialized variables.
+
+Working:
+- mark used elements of a module, starting from all accessible elements
+- Hint: 'Unit "%s" not used in %s'
+- Hint: 'Parameter "%s" not used'
+- Hint: 'Local variable "%s" not used'
+- Hint: 'Value parameter "%s" is assigned but never used'
+- Hint: 'Local variable "%s" is assigned but never used'
+- Hint: 'Local %s "%s" not used'
+- Hint: 'Private field "%s" is never used'
+- Hint: 'Private field "%s" is assigned but never used'
+- Hint: 'Private method "%s" is never used'
+- Hint: 'Private type "%s" never used'
+- Hint: 'Private const "%s" never used'
+- Hint: 'Private property "%s" never used'
+- Hint: 'Function result does not seem to be set'
+
+ToDo:
+- record members
+- class members
+- Improve Call Override: e.g. A.Proc, mark only overrides of descendants of A
+- TPasArgument: compute the effective Access
+- calls: use the effective Access of arguments
+}
+unit PasUseAnalyzer;
+
+{$mode objfpc}{$H+}{$inline on}
+
+interface
+
+uses
+  Classes, SysUtils, AVL_Tree, PasResolver, PasTree, PScanner;
+
+const
+  nPAUnitNotUsed = 5023;
+  sPAUnitNotUsed = 'Unit "%s" not used in %s';
+  nPAParameterNotUsed = 5024;
+  sPAParameterNotUsed = 'Parameter "%s" not used';
+  nPALocalVariableNotUsed = 5025;
+  sPALocalVariableNotUsed = 'Local variable "%s" not used';
+  nPAValueParameterIsAssignedButNeverUsed = 5026;
+  sPAValueParameterIsAssignedButNeverUsed = 'Value parameter "%s" is assigned but never used';
+  nPALocalVariableIsAssignedButNeverUsed = 5027;
+  sPALocalVariableIsAssignedButNeverUsed = 'Local variable "%s" is assigned but never used';
+  nPALocalXYNotUsed = 5028;
+  sPALocalXYNotUsed = 'Local %s "%s" not used';
+  nPAPrivateFieldIsNeverUsed = 5029;
+  sPAPrivateFieldIsNeverUsed = 'Private field "%s" is never used';
+  nPAPrivateFieldIsAssignedButNeverUsed = 5030;
+  sPAPrivateFieldIsAssignedButNeverUsed = 'Private field "%s" is assigned but never used';
+  nPAPrivateMethodIsNeverUsed = 5031;
+  sPAPrivateMethodIsNeverUsed = 'Private method "%s" is never used';
+  nPAFunctionResultDoesNotSeemToBeSet = 5033;
+  sPAFunctionResultDoesNotSeemToBeSet  = 'Function result does not seem to be set';
+  nPAPrivateTypeXNeverUsed = 5071;
+  sPAPrivateTypeXNeverUsed = 'Private type "%s" never used';
+  nPAPrivateConstXNeverUsed = 5072;
+  sPAPrivateConstXNeverUsed = 'Private const "%s" never used';
+  nPAPrivatePropertyXNeverUsed = 5073;
+  sPAPrivatePropertyXNeverUsed = 'Private property "%s" never used';
+  //nPAUnreachableCode = 6018;
+  //sPAUnreachableCode = 'unreachable code';
+
+type
+  EPasAnalyzer = class(EPasResolve);
+
+  { TPAMessage }
+
+  TPAMessage = class
+  private
+    FRefCount: integer;
+  public
+    Id: int64;
+    MsgType: TMessageType;
+    MsgNumber: integer;
+    MsgText: string;
+    MsgPattern: String;
+    Args: TMessageArgs;
+    PosEl: TPasElement;
+    Filename: string;
+    Row, Col: integer;
+    constructor Create;
+    procedure AddRef;
+    procedure Release;
+    property RefCount: integer read FRefCount;
+  end;
+
+  TPAMessageEvent = procedure(Sender: TObject; Msg: TPAMessage) of object;
+
+  TPAIdentifierAccess = (
+    paiaNone,
+    paiaRead,
+    paiaWrite,
+    paiaReadWrite,
+    paiaWriteRead
+    );
+
+  { TPAElement }
+
+  TPAElement = class
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    Access: TPAIdentifierAccess;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+  TPAElementClass = class of TPAElement;
+
+  { TPAOverrideList }
+
+  TPAOverrideList = class
+  private
+    FElement: TPasElement;
+    FOverrides: TFPList; // list of TPasElement
+    function GetOverrides(Index: integer): TPasElement; inline;
+    procedure SetElement(AValue: TPasElement);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(OverrideEl: TPasElement);
+    property Element: TPasElement read FElement write SetElement;
+    function Count: integer;
+    function IndexOf(OverrideEl: TPasElement): integer; inline;
+    property Overrides[Index: integer]: TPasElement read GetOverrides; default;
+  end;
+
+  TPasAnalyzerOption = (
+    paoKeepPublished, // when a class is used, all its published members are used as well
+    paoOnlyExports // default: use all class members accessible from outside (protected, but not private)
+    );
+  TPasAnalyzerOptions = set of TPasAnalyzerOption;
+
+  TPAUseMode = (
+    paumElement, // mark element
+    paumAllPublic, // mark element and descend into children and mark public identifiers
+    paumAllExports // do not mark element and descend into children and mark exports
+    );
+  TPAUseModes = set of TPAUseMode;
+
+  { TPasAnalyzer }
+
+  TPasAnalyzer = class
+  private
+    FChecked: array[TPAUseMode] of TAVLTree; // tree of TElement
+    FOnMessage: TPAMessageEvent;
+    FOptions: TPasAnalyzerOptions;
+    FOverrideLists: TAVLTree; // tree of TPAOverrideList sorted for Element
+    FResolver: TPasResolver;
+    FScopeModule: TPasModule;
+    FUsedElements: TAVLTree; // tree of TPAElement sorted for Element
+    function AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
+    function FindOverrideNode(El: TPasElement): TAVLTreeNode;
+    function FindOverrideList(El: TPasElement): TPAOverrideList;
+    procedure SetOptions(AValue: TPasAnalyzerOptions);
+    procedure UpdateAccess(IsWrite: Boolean; IsRead: Boolean; Usage: TPAElement);
+  protected
+    procedure RaiseInconsistency(const Id: int64; Msg: string);
+    procedure RaiseNotSupported(const Id: int64; El: TPasElement; const Msg: string = '');
+    // mark used elements
+    function Add(El: TPasElement; CheckDuplicate: boolean = true;
+      aClass: TPAElementClass = nil): TPAElement;
+    function FindNode(El: TPasElement): TAVLTreeNode; inline;
+    function FindPAElement(El: TPasElement): TPAElement; inline;
+    procedure CreateTree; virtual;
+    function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
+    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
+    procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
+    procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
+    procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
+    procedure UseImplElement(El: TPasImplElement); virtual;
+    procedure UseExpr(El: TPasExpr); virtual;
+    procedure UseExprRef(Expr: TPasExpr; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UseProcedure(Proc: TPasProcedure); virtual;
+    procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
+    procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
+    procedure UseRecordType(El: TPasRecordType; Mode: TPAUseMode); virtual;
+    procedure UseClassType(El: TPasClassType; Mode: TPAUseMode); virtual;
+    procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UseArgument(El: TPasArgument; Access: TResolvedRefAccess); virtual;
+    procedure UseResultElement(El: TPasResultElement; Access: TResolvedRefAccess); virtual;
+    // create hints for a unit, program or library
+    procedure EmitElementHints(El: TPasElement); virtual;
+    procedure EmitSectionHints(Section: TPasSection); virtual;
+    procedure EmitDeclarationsHints(El: TPasDeclarations); virtual;
+    procedure EmitTypeHints(El: TPasType); virtual;
+    procedure EmitVariableHints(El: TPasVariable); virtual;
+    procedure EmitProcedureHints(El: TPasProcedure); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure AnalyzeModule(aModule: TPasModule);
+    procedure AnalyzeWholeProgram(aStartModule: TPasProgram);
+    procedure EmitModuleHints(aModule: TPasModule); virtual;
+    function FindElement(El: TPasElement): TPAElement;
+    // utility
+    function IsUsed(El: TPasElement): boolean; // valid after calling Analyze*
+    function IsModuleInternal(El: TPasElement): boolean;
+    function IsExport(El: TPasElement): boolean;
+    function IsIdentifier(El: TPasElement): boolean;
+    function IsImplBlockEmpty(El: TPasImplBlock): boolean;
+    procedure EmitMessage(const Id: int64; const MsgType: TMessageType;
+      MsgNumber: integer; Fmt: String; const Args: array of const; PosEl: TPasElement);
+    procedure EmitMessage(Msg: TPAMessage);
+    property OnMessage: TPAMessageEvent read FOnMessage write FOnMessage;
+    property Options: TPasAnalyzerOptions read FOptions write SetOptions;
+    property Resolver: TPasResolver read FResolver write FResolver;
+    property ScopeModule: TPasModule read FScopeModule write FScopeModule;
+  end;
+
+function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
+function CompareElementWithPAElement(El, Id: Pointer): integer;
+function ComparePAOverrideLists(List1, List2: Pointer): integer;
+function CompareElementWithPAOverrideList(El, List: Pointer): integer;
+function GetElModName(El: TPasElement): string;
+
+implementation
+
+function ComparePointer(Data1, Data2: Pointer): integer;
+begin
+  if Data1>Data2 then Result:=-1
+  else if Data1<Data2 then Result:=1
+  else Result:=0;
+end;
+
+function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
+var
+  Item1: TPAElement absolute Identifier1;
+  Item2: TPAElement absolute Identifier2;
+begin
+  Result:=ComparePointer(Item1.Element,Item2.Element);
+end;
+
+function CompareElementWithPAElement(El, Id: Pointer): integer;
+var
+  Identifier: TPAElement absolute Id;
+begin
+  Result:=ComparePointer(El,Identifier.Element);
+end;
+
+function ComparePAOverrideLists(List1, List2: Pointer): integer;
+var
+  Item1: TPAOverrideList absolute List1;
+  Item2: TPAOverrideList absolute List2;
+begin
+  Result:=ComparePointer(Item1.Element,Item2.Element);
+end;
+
+function CompareElementWithPAOverrideList(El, List: Pointer): integer;
+var
+  OvList: TPAOverrideList absolute List;
+begin
+  Result:=ComparePointer(El,OvList.Element);
+end;
+
+function GetElModName(El: TPasElement): string;
+var
+  aModule: TPasModule;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName;
+  aModule:=El.GetModule;
+  if aModule=El then exit;
+  if aModule=nil then
+    Result:='NilModule.'+Result
+  else
+    Result:=aModule.Name+'.'+Result;
+end;
+
+{ TPAMessage }
+
+constructor TPAMessage.Create;
+begin
+  FRefCount:=1;
+end;
+
+procedure TPAMessage.AddRef;
+begin
+  inc(FRefCount);
+end;
+
+procedure TPAMessage.Release;
+begin
+  if FRefCount=0 then
+    raise Exception.Create('');
+  dec(FRefCount);
+  if FRefCount=0 then
+    Free;
+end;
+
+{ TPAOverrideList }
+
+// inline
+function TPAOverrideList.GetOverrides(Index: integer): TPasElement;
+begin
+  Result:=TPasElement(FOverrides[Index]);
+end;
+
+// inline
+function TPAOverrideList.IndexOf(OverrideEl: TPasElement): integer;
+begin
+  Result:=FOverrides.IndexOf(OverrideEl);
+end;
+
+procedure TPAOverrideList.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    FElement.Release;
+  FElement:=AValue;
+  if FElement<>nil then
+    FElement.AddRef;
+end;
+
+constructor TPAOverrideList.Create;
+begin
+  FOverrides:=TFPList.Create;
+end;
+
+destructor TPAOverrideList.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to FOverrides.Count-1 do
+    TPasElement(FOverrides[i]).Release;
+  FreeAndNil(FOverrides);
+  inherited Destroy;
+end;
+
+procedure TPAOverrideList.Add(OverrideEl: TPasElement);
+begin
+  FOverrides.Add(OverrideEl);
+  OverrideEl.AddRef;
+end;
+
+function TPAOverrideList.Count: integer;
+begin
+  Result:=FOverrides.Count;
+end;
+
+{ TPAElement }
+
+procedure TPAElement.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    FElement.Release;
+  FElement:=AValue;
+  if FElement<>nil then
+    FElement.AddRef;
+end;
+
+destructor TPAElement.Destroy;
+begin
+  Element:=nil;
+  inherited Destroy;
+end;
+
+{ TPasAnalyzer }
+
+// inline
+function TPasAnalyzer.FindNode(El: TPasElement): TAVLTreeNode;
+begin
+  Result:=FUsedElements.FindKey(El,@CompareElementWithPAElement);
+end;
+
+// inline
+function TPasAnalyzer.FindPAElement(El: TPasElement): TPAElement;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAElement(Node.Data);
+end;
+
+procedure TPasAnalyzer.SetOptions(AValue: TPasAnalyzerOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+end;
+
+function TPasAnalyzer.FindOverrideNode(El: TPasElement): TAVLTreeNode;
+begin
+  Result:=FOverrideLists.FindKey(El,@CompareElementWithPAOverrideList);
+end;
+
+function TPasAnalyzer.FindOverrideList(El: TPasElement): TPAOverrideList;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindOverrideNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAOverrideList(Node.Data);
+end;
+
+function TPasAnalyzer.AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
+// OverrideEl overrides OverriddenEl
+// returns true if new override
+var
+  Node: TAVLTreeNode;
+  Item: TPAOverrideList;
+  OverriddenPAEl: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AddOverride OverriddenEl=',GetElModName(OverriddenEl),' OverrideEl=',GetElModName(OverrideEl));
+  {$ENDIF}
+  Node:=FindOverrideNode(OverriddenEl);
+  if Node=nil then
+    begin
+    Item:=TPAOverrideList.Create;
+    Item.Element:=OverriddenEl;
+    FOverrideLists.Add(Item);
+    end
+  else
+    begin
+    Item:=TPAOverrideList(Node.Data);
+    if Item.IndexOf(OverrideEl)>=0 then
+      exit(false);
+    end;
+  // new override
+  Item.Add(OverrideEl);
+  Result:=true;
+
+  OverriddenPAEl:=FindPAElement(OverriddenEl);
+  if OverriddenPAEl<>nil then
+    UseElement(OverrideEl,rraNone,true);
+end;
+
+procedure TPasAnalyzer.UpdateAccess(IsWrite: Boolean; IsRead: Boolean;
+  Usage: TPAElement);
+begin
+  if IsRead then
+    case Usage.Access of
+      paiaNone: Usage.Access:=paiaRead;
+      paiaRead: ;
+      paiaWrite: Usage.Access:=paiaWriteRead;
+      paiaReadWrite: ;
+      paiaWriteRead: ;
+      else RaiseInconsistency(20170311183122, '');
+    end;
+  if IsWrite then
+    case Usage.Access of
+      paiaNone: Usage.Access:=paiaWrite;
+      paiaRead: Usage.Access:=paiaReadWrite;
+      paiaWrite: ;
+      paiaReadWrite: ;
+      paiaWriteRead: ;
+      else RaiseInconsistency(20170311183127, '');
+    end;
+end;
+
+procedure TPasAnalyzer.RaiseInconsistency(const Id: int64; Msg: string);
+begin
+  raise EPasAnalyzer.Create('['+IntToStr(Id)+']: '+Msg);
+end;
+
+procedure TPasAnalyzer.RaiseNotSupported(const Id: int64; El: TPasElement;
+  const Msg: string);
+var
+  s: String;
+  E: EPasAnalyzer;
+begin
+  s:='['+IntToStr(Id)+']: Element='+GetElModName(El);
+  if Msg<>'' then S:=S+' '+Msg;
+  E:=EPasAnalyzer.Create(s);
+  E.PasElement:=El;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.RaiseNotSupported ',E.Message);
+  {$ENDIF}
+  raise E;
+end;
+
+function TPasAnalyzer.Add(El: TPasElement; CheckDuplicate: boolean;
+  aClass: TPAElementClass): TPAElement;
+begin
+  if El=nil then
+    RaiseInconsistency(20170308093407,'');
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.Add ',GetElModName(El),' New=',FindNode(El)=nil);
+  {$ENDIF}
+  if CheckDuplicate and (FindNode(El)<>nil) then
+    RaiseInconsistency(20170304201318,'');
+  if aClass=nil then
+    aClass:=TPAElement;
+  Result:=aClass.Create;
+  Result.Element:=El;
+  FUsedElements.Add(Result);
+end;
+
+procedure TPasAnalyzer.CreateTree;
+begin
+  FUsedElements:=TAVLTree.Create(@ComparePAElements);
+end;
+
+function TPasAnalyzer.MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass
+  ): boolean;
+
+  function MarkModule(CurModule: TPasModule): boolean;
+  begin
+    if FindNode(CurModule)<>nil then
+      exit(false);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.MarkElement.MarkModule mark "',GetElModName(CurModule),'"');
+    {$ENDIF}
+    Add(CurModule);
+    Result:=true;
+  end;
+
+var
+  CurModule: TPasModule;
+begin
+  if El=nil then exit(false);
+  CurModule:=El.GetModule;
+  if CurModule=nil then
+    begin
+    if El.ClassType=TPasUnresolvedSymbolRef then
+      exit(false);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.MarkElement GetModule failed for El=',GetElModName(El),' El.Parent=',GetElModName(El.Parent));
+    {$ENDIF}
+    RaiseInconsistency(20170308093540,GetElModName(El));
+    end;
+  if (ScopeModule<>nil) then
+    begin
+    // single module analysis
+    if (CurModule<>ScopeModule) then
+      begin
+      // element from another unit
+      // -> mark unit as used and do not descend deeper
+      MarkModule(CurModule);
+      exit(false);
+      end;
+    end;
+
+  // mark element
+  if FindNode(El)<>nil then exit(false);
+  Add(El,false,aClass);
+  Result:=true;
+
+  if ScopeModule=nil then
+    begin
+    // whole program analysis
+    if IsIdentifier(El) then
+      // an identifier of this unit is used -> mark unit
+      if MarkModule(CurModule) then
+        UseModule(CurModule,paumElement);
+    end;
+end;
+
+function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
+  ): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if FChecked[Mode].Find(El)<>nil then exit(true);
+  Result:=false;
+  FChecked[Mode].Add(El);
+end;
+
+procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
+  UseFull: boolean);
+var
+  C: TClass;
+begin
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C.InheritsFrom(TPasType) then
+    UseType(TPasType(El),paumElement)
+  else if C.InheritsFrom(TPasVariable) then
+    UseVariable(TPasVariable(El),Access,UseFull)
+  else if C=TPasArgument then
+    UseArgument(TPasArgument(El),Access)
+  else if C=TPasResultElement then
+    UseResultElement(TPasResultElement(El),Access)
+  else if C.InheritsFrom(TPasProcedure) then
+    UseProcedure(TPasProcedure(El))
+  else if C.InheritsFrom(TPasExpr) then
+    UseExpr(TPasExpr(El))
+  else if C=TPasEnumValue then
+    MarkElementAsUsed(El)
+  else if C.InheritsFrom(TPasModule) then
+    // e.g. unitname.identifier -> the module is used by the identifier
+  else
+    RaiseNotSupported(20170307090947,El);
+end;
+
+procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
+
+  procedure UseInitFinal(aSection: TPasImplBlock);
+  begin
+    if IsImplBlockEmpty(aSection) then exit;
+    // this module has an initialization section -> mark module
+    if FindNode(aModule)=nil then
+      Add(aModule);
+    UseImplBlock(aSection,true);
+  end;
+
+begin
+  if ElementVisited(aModule,Mode) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode);
+  {$ENDIF}
+  if Mode in [paumAllExports,paumAllPublic] then
+    begin
+    if aModule is TPasProgram then
+      UseSection(TPasProgram(aModule).ProgramSection,Mode)
+    else if aModule is TPasLibrary then
+      UseSection(TPasLibrary(aModule).LibrarySection,Mode)
+    else
+      begin
+      // unit
+      UseSection(aModule.InterfaceSection,Mode);
+      end;
+    end;
+  UseInitFinal(aModule.InitializationSection);
+  UseInitFinal(aModule.FinalizationSection);
+
+  if Mode=paumElement then
+    // e.g. a reference: unitname.identifier
+    if FindNode(aModule)=nil then
+      Add(aModule);
+end;
+
+procedure TPasAnalyzer.UseSection(Section: TPasSection; Mode: TPAUseMode);
+// called by UseModule
+var
+  UsesList: TFPList;
+  i: Integer;
+  UsedModule: TPasModule;
+  Decl: TPasElement;
+  OnlyExports: Boolean;
+begin
+  // Section is TProgramSection, TLibrarySection, TInterfaceSection, TImplementationSection
+  if Mode=paumElement then
+    RaiseInconsistency(20170317172721,'');
+  if ElementVisited(Section,Mode) then exit;
+
+  OnlyExports:=Mode=paumAllExports;
+
+  if Mode=paumAllPublic then
+    MarkElementAsUsed(Section);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseSection ',GetElModName(Section),' Mode=',Mode);
+  {$ENDIF}
+
+  // used units
+  UsesList:=Section.UsesList;
+  for i:=0 to UsesList.Count-1 do
+    begin
+    if TObject(UsesList[i]) is TPasModule then
+      begin
+      UsedModule:=TPasModule(UsesList[i]);
+      if ScopeModule=nil then
+        // whole program analysis
+        UseModule(UsedModule,paumAllExports)
+      else
+        begin
+        // unit analysis
+        if IsImplBlockEmpty(UsedModule.InitializationSection)
+            and IsImplBlockEmpty(UsedModule.FinalizationSection) then
+          continue;
+        if FindNode(UsedModule)=nil then
+          Add(UsedModule);
+        UseImplBlock(UsedModule.InitializationSection,true);
+        UseImplBlock(UsedModule.FinalizationSection,true);
+        end;
+      end;
+    end;
+
+  // section declarations
+  for i:=0 to Section.Declarations.Count-1 do
+    begin
+    Decl:=TPasElement(Section.Declarations[i]);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseSection ',Section.ClassName,' Decl=',GetElModName(Decl),' Mode=',Mode);
+    {$ENDIF}
+    if Decl is TPasProcedure then
+      begin
+      if OnlyExports and ([pmExport,pmPublic]*TPasProcedure(Decl).Modifiers=[]) then
+        continue;
+      UseProcedure(TPasProcedure(Decl))
+      end
+    else if Decl is TPasType then
+      UseType(TPasType(Decl),Mode)
+    else if Decl is TPasVariable then
+      begin
+      if OnlyExports and ([vmExport,vmPublic]*TPasVariable(Decl).VarModifiers=[]) then
+        continue;
+      UseVariable(TPasVariable(Decl),rraNone,true);
+      end
+    else
+      RaiseNotSupported(20170306165213,Decl);
+    end;
+end;
+
+procedure TPasAnalyzer.UseImplBlock(Block: TPasImplBlock; Mark: boolean);
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  if Block=nil then exit;
+  if Mark and not MarkElementAsUsed(Block) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseImplBlock ',GetElModName(Block),' Elements=',Block.Elements.Count);
+  {$ENDIF}
+  for i:=0 to Block.Elements.Count-1 do
+    begin
+    El:=TPasElement(Block.Elements[i]);
+    if El is TPasImplElement then
+      UseImplElement(TPasImplElement(El))
+    else
+      RaiseNotSupported(20170306195110,El);
+    end;
+end;
+
+procedure TPasAnalyzer.UseImplElement(El: TPasImplElement);
+var
+  C: TClass;
+  ForLoop: TPasImplForLoop;
+  CaseOf: TPasImplCaseOf;
+  i, j: Integer;
+  CaseSt: TPasImplCaseStatement;
+  WithDo: TPasImplWithDo;
+  SubEl, ParentEl: TPasElement;
+begin
+  // do not mark
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C=TPasImplBlock then
+    // impl block
+    UseImplBlock(TPasImplBlock(El),false)
+  else if C=TPasImplSimple then
+    // simple expression
+    UseExpr(TPasImplSimple(El).expr)
+  else if C=TPasImplAssign then
+    // a:=b
+    begin
+    UseExpr(TPasImplAssign(El).left);
+    UseExpr(TPasImplAssign(El).right);
+    end
+  else if C=TPasImplAsmStatement then
+    // asm..end
+  else if C=TPasImplBeginBlock then
+    // begin..end
+    UseImplBlock(TPasImplBeginBlock(El),false)
+  else if C=TPasImplCaseOf then
+    begin
+    // case-of
+    CaseOf:=TPasImplCaseOf(El);
+    UseExpr(CaseOf.CaseExpr);
+    for i:=0 to CaseOf.Elements.Count-1 do
+      begin
+      SubEl:=TPasElement(CaseOf.Elements[i]);
+      if SubEl.ClassType=TPasImplCaseStatement then
+        begin
+        CaseSt:=TPasImplCaseStatement(SubEl);
+        for j:=0 to CaseSt.Expressions.Count-1 do
+          UseExpr(TObject(CaseSt.Expressions[j]) as TPasExpr);
+        UseImplElement(CaseSt.Body);
+        end
+      else if SubEl.ClassType=TPasImplCaseElse then
+        UseImplBlock(TPasImplCaseElse(SubEl),false)
+      else
+        RaiseNotSupported(20170307195329,SubEl);
+      end;
+    end
+  else if C=TPasImplForLoop then
+    begin
+    // for-loop
+    ForLoop:=TPasImplForLoop(El);
+    UseExpr(ForLoop.VariableName);
+    UseExpr(ForLoop.StartExpr);
+    UseExpr(ForLoop.EndExpr);
+    UseImplElement(ForLoop.Body);
+    end
+  else if C=TPasImplIfElse then
+    begin
+    // if-then-else
+    UseExpr(TPasImplIfElse(El).ConditionExpr);
+    UseImplElement(TPasImplIfElse(El).IfBranch);
+    UseImplElement(TPasImplIfElse(El).ElseBranch);
+    end
+  else if C=TPasImplLabelMark then
+    // label mark
+  else if C=TPasImplRepeatUntil then
+    begin
+    // repeat-until
+    UseImplBlock(TPasImplRepeatUntil(El),false);
+    UseExpr(TPasImplRepeatUntil(El).ConditionExpr);
+    end
+  else if C=TPasImplWhileDo then
+    begin
+    // while-do
+    UseExpr(TPasImplWhileDo(El).ConditionExpr);
+    UseImplBlock(TPasImplWhileDo(El),false);
+    end
+  else if C=TPasImplWithDo then
+    begin
+    // with-do
+    WithDo:=TPasImplWithDo(El);
+    for i:=0 to WithDo.Expressions.Count-1 do
+      UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
+    UseImplBlock(WithDo,false);
+    end
+  else if C=TPasImplExceptOn then
+    begin
+    // except-on
+    UseType(TPasImplExceptOn(El).TypeEl,paumElement);
+    UseImplElement(TPasImplExceptOn(El).Body);
+    end
+  else if C=TPasImplRaise then
+    begin
+    // raise
+    if TPasImplRaise(El).ExceptObject<>nil then
+      UseExpr(TPasImplRaise(El).ExceptObject)
+    else
+      begin
+      // raise; -> mark On E:
+      ParentEl:=El.Parent;
+      while ParentEl<>nil do
+        begin
+        if ParentEl is TPasImplExceptOn then
+          begin
+          UseVariable(TPasVariable(TPasImplExceptOn(ParentEl).VarEl),rraRead,false);
+          break;
+          end;
+        ParentEl:=ParentEl.Parent;
+        end;
+      end;
+    UseExpr(TPasImplRaise(El).ExceptAddr);
+    end
+  else if C=TPasImplTry then
+    begin
+    // try..finally/except..else..end
+    UseImplBlock(TPasImplTry(El),false);
+    UseImplBlock(TPasImplTry(El).FinallyExcept,false);
+    UseImplBlock(TPasImplTry(El).ElseBranch,false);
+    end
+  else
+    RaiseNotSupported(20170307162715,El);
+end;
+
+procedure TPasAnalyzer.UseExpr(El: TPasExpr);
+var
+  Ref: TResolvedReference;
+  C: TClass;
+  Params: TPasExprArray;
+  i: Integer;
+begin
+  if El=nil then exit;
+  // expressions are not marked
+
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    UseElement(Ref.Declaration,Ref.Access,false);
+
+    if (El.ClassType=TSelfExpr)
+        or ((El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent)) then
+      begin
+      if Ref.WithExprScope<>nil then
+        begin
+        if Ref.WithExprScope.Scope is TPasRecordScope then
+          begin
+          // a record member was accessed -> access the record too
+          UseExprRef(Ref.WithExprScope.Expr,Ref.Access,false);
+          exit;
+          end;
+        end;
+      if (Ref.Declaration is TPasVariable)
+          and (El.Parent is TBinaryExpr)
+          and (TBinaryExpr(El.Parent).right=El) then
+        begin
+        if ((Ref.Declaration.Parent is TPasRecordType)
+              or (Ref.Declaration.Parent is TPasVariant)) then
+          begin
+          // a record member was accessed -> access the record too
+          UseExprRef(TBinaryExpr(El.Parent).left,Ref.Access,false);
+          end;
+        end;
+      end;
+
+    end;
+  UseExpr(El.format1);
+  UseExpr(El.format2);
+  C:=El.ClassType;
+  if (C=TPrimitiveExpr)
+      or (C=TSelfExpr)
+      or (C=TBoolConstExpr)
+      or (C=TInheritedExpr)
+      or (C=TNilExpr) then
+  else if C=TBinaryExpr then
+    begin
+    UseExpr(TBinaryExpr(El).left);
+    UseExpr(TBinaryExpr(El).right);
+    end
+  else if C=TUnaryExpr then
+    UseExpr(TUnaryExpr(El).Operand)
+  else if C=TParamsExpr then
+    begin
+    UseExpr(TParamsExpr(El).Value);
+    Params:=TParamsExpr(El).Params;
+    for i:=0 to length(Params)-1 do
+      UseExpr(Params[i]);
+    end
+  else
+    RaiseNotSupported(20170307085444,El);
+end;
+
+procedure TPasAnalyzer.UseExprRef(Expr: TPasExpr; Access: TResolvedRefAccess;
+  UseFull: boolean);
+var
+  Ref: TResolvedReference;
+  C: TClass;
+  Bin: TBinaryExpr;
+  Params: TParamsExpr;
+  ValueResolved: TPasResolverResult;
+begin
+  if (Expr.CustomData is TResolvedReference) then
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    UseElement(Ref.Declaration,Access,UseFull);
+    end;
+
+  C:=Expr.ClassType;
+  if C=TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(Expr);
+    if Bin.OpCode in [eopSubIdent,eopNone] then
+      UseExprRef(Bin.right,Access,UseFull);
+    end
+  else if C=TParamsExpr then
+    begin
+    Params:=TParamsExpr(Expr);
+    case Params.Kind of
+    pekFuncParams:
+      if Resolver.IsTypeCast(Params) then
+        UseExprRef(Params.Params[0],Access,UseFull)
+      else
+        UseExprRef(Params.Value,Access,UseFull);
+    pekArrayParams:
+      begin
+      Resolver.ComputeElement(Params.Value,ValueResolved,[]);
+      if not Resolver.IsDynArray(ValueResolved.TypeEl) then
+        UseExprRef(Params.Value,Access,UseFull);
+      end;
+    pekSet: ;
+    else
+      RaiseNotSupported(20170403173817,Params);
+    end;
+    end
+  else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
+    // ok
+  else if (Access=rraRead)
+      and ((C=TPrimitiveExpr)
+        or (C=TNilExpr)
+        or (C=TBoolConstExpr)
+        or (C=TUnaryExpr)) then
+    // ok
+  else
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.UseExprRef Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
+    {$ENDIF}
+    RaiseNotSupported(20170306102158,Expr);
+    end;
+end;
+
+procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
+
+  procedure UseOverrides(CurProc: TPasProcedure);
+  var
+    OverrideList: TPAOverrideList;
+    i: Integer;
+    OverrideProc: TPasProcedure;
+  begin
+    OverrideList:=FindOverrideList(CurProc);
+    if OverrideList=nil then exit;
+    // Note: while traversing the OverrideList it may grow
+    i:=0;
+    while i<OverrideList.Count do
+      begin
+      OverrideProc:=TObject(OverrideList.Overrides[i]) as TPasProcedure;
+      UseProcedure(OverrideProc);
+      inc(i);
+      end;
+  end;
+
+var
+  ProcScope: TPasProcedureScope;
+  ImplProc: TPasProcedure;
+begin
+  // use declaration, not implementation
+  ProcScope:=Proc.CustomData as TPasProcedureScope;
+  if ProcScope.DeclarationProc<>nil then
+    exit; // skip implementation, Note:PasResolver always refers the declaration
+
+  if not MarkElementAsUsed(Proc) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
+  {$ENDIF}
+  UseProcedureType(Proc.ProcType,false);
+
+  ImplProc:=Proc;
+  if ProcScope.ImplProc<>nil then
+    ImplProc:=ProcScope.ImplProc;
+  if ImplProc.Body<>nil then
+    UseImplBlock(ImplProc.Body.Body,false);
+
+  if ProcScope.OverriddenProc<>nil then
+    AddOverride(ProcScope.OverriddenProc,Proc);
+
+  // mark overrides
+  if [pmOverride,pmVirtual]*Proc.Modifiers<>[] then
+    UseOverrides(Proc);
+end;
+
+procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
+  Mark: boolean);
+var
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
+  {$ENDIF}
+  if Mark and not MarkElementAsUsed(ProcType) then exit;
+  for i:=0 to ProcType.Args.Count-1 do
+    begin
+    Arg:=TPasArgument(ProcType.Args[i]);
+    // Note: argument are marked when used in code
+    // mark argument type
+    UseType(Arg.ArgType,paumElement);
+    end;
+  if ProcType is TPasFunctionType then
+    UseType(TPasFunctionType(ProcType).ResultEl.ResultType,paumElement);
+end;
+
+procedure TPasAnalyzer.UseType(El: TPasType; Mode: TPAUseMode);
+var
+  C: TClass;
+  i: Integer;
+begin
+  if El=nil then exit;
+  C:=El.ClassType;
+  if Mode=paumAllExports then
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
+    {$ENDIF}
+    if C=TPasRecordType then
+      UseRecordType(TPasRecordType(El),Mode)
+    else if C=TPasClassType then
+      UseClassType(TPasClassType(El),Mode);
+    end
+  else
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseType using ',GetElModName(El),' Mode=',Mode);
+    {$ENDIF}
+    if C=TPasUnresolvedSymbolRef then
+      begin
+      if (El.CustomData is TResElDataBaseType)
+          or (El.CustomData is TResElDataBuiltInProc) then
+      else
+        RaiseNotSupported(20170307101353,El);
+      end
+    else if (C=TPasAliasType)
+        or (C=TPasTypeAliasType)
+        or (C=TPasClassOfType) then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasAliasType(El).DestType,Mode);
+      end
+    else if C=TPasArrayType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      for i:=0 to length(TPasArrayType(El).Ranges)-1 do
+        UseExpr(TPasArrayType(El).Ranges[i]);
+      UseType(TPasArrayType(El).ElType,Mode);
+      end
+    else if C=TPasRecordType then
+      UseRecordType(TPasRecordType(El),Mode)
+    else if C=TPasClassType then
+      UseClassType(TPasClassType(El),Mode)
+    else if C=TPasEnumType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      end
+    else if C=TPasPointerType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasPointerType(El).DestType,Mode);
+      end
+    else if C=TPasRangeType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseExpr(TPasRangeType(El).RangeExpr);
+      end
+    else if C=TPasSetType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasSetType(El).EnumType,Mode);
+      end
+    else if C.InheritsFrom(TPasProcedureType) then
+      UseProcedureType(TPasProcedureType(El),true)
+    else
+      RaiseNotSupported(20170306170315,El);
+    end;
+end;
+
+procedure TPasAnalyzer.UseRecordType(El: TPasRecordType; Mode: TPAUseMode);
+// called by UseType
+var
+  i: Integer;
+begin
+  if Mode=paumAllExports then exit;
+  MarkElementAsUsed(El);
+  if (Mode=paumAllPublic) and not ElementVisited(El,Mode) then
+    for i:=0 to El.Members.Count-1 do
+      UseVariable(TObject(El.Members[i]) as TPasVariable,rraNone,true);
+end;
+
+procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
+// called by UseType
+var
+  i: Integer;
+  Member: TPasElement;
+  UsePublished, FirstTime: Boolean;
+  ProcScope: TPasProcedureScope;
+  ClassScope: TPasClassScope;
+  Ref: TResolvedReference;
+begin
+  FirstTime:=true;
+  case Mode of
+  paumAllExports: exit;
+  paumAllPublic:
+    begin
+    if MarkElementAsUsed(El) then
+      ElementVisited(El,Mode)
+    else
+      begin
+      if ElementVisited(El,Mode) then exit;
+      FirstTime:=false;
+      end;
+    end;
+  paumElement:
+    if not MarkElementAsUsed(El) then exit;
+  end;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
+  {$ENDIF}
+  if El.IsForward then
+    begin
+    Ref:=El.CustomData as TResolvedReference;
+    UseClassType(Ref.Declaration as TPasClassType,Mode);
+    exit;
+    end;
+
+  ClassScope:=El.CustomData as TPasClassScope;
+  if FirstTime then
+    begin
+    UseType(ClassScope.DirectAncestor,paumElement);
+    UseType(El.HelperForType,paumElement);
+    UseExpr(El.GUIDExpr);
+    for i:=0 to El.Interfaces.Count-1 do
+      UseType(TPasType(El.Interfaces[i]),paumElement);
+    end;
+  // members
+  UsePublished:=(Mode<>paumAllExports) and (paoKeepPublished in Options);
+  for i:=0 to El.Members.Count-1 do
+    begin
+    Member:=TPasElement(El.Members[i]);
+    if FirstTime and (Member is TPasProcedure) then
+      begin
+      ProcScope:=Member.CustomData as TPasProcedureScope;
+      if ProcScope.OverriddenProc<>nil then
+        AddOverride(ProcScope.OverriddenProc,Member);
+      end;
+    if UsePublished and (Member.Visibility=visPublished) then
+      begin
+      // include published
+      if not FirstTime then continue;
+      end
+    else if Mode=paumElement then
+      continue
+    else if IsModuleInternal(Member) then
+      // private or strict private
+      continue
+    else
+      ; // else: class is in unit interface, mark all non private members
+    UseElement(Member,rraNone,true);
+    end;
+end;
+
+procedure TPasAnalyzer.UseVariable(El: TPasVariable;
+  Access: TResolvedRefAccess; UseFull: boolean);
+var
+  Usage: TPAElement;
+  UseRead, UseWrite: boolean;
+
+  procedure UpdateVarAccess(IsRead, IsWrite: boolean);
+  begin
+    if IsRead then
+      case Usage.Access of
+        paiaNone: begin Usage.Access:=paiaRead; UseRead:=true; end;
+        paiaRead: ;
+        paiaWrite: begin Usage.Access:=paiaWriteRead; UseRead:=true; end;
+        paiaReadWrite: ;
+        paiaWriteRead: ;
+        else RaiseInconsistency(20170311182420,'');
+      end;
+    if IsWrite then
+      case Usage.Access of
+        paiaNone: begin Usage.Access:=paiaWrite; UseWrite:=true; end;
+        paiaRead: begin Usage.Access:=paiaReadWrite; UseWrite:=true; end;
+        paiaWrite: ;
+        paiaReadWrite: ;
+        paiaWriteRead: ;
+        else RaiseInconsistency(20170311182536,'');
+      end;
+  end;
+
+var
+  Prop: TPasProperty;
+  i: Integer;
+  IsRead, IsWrite, CanRead, CanWrite: Boolean;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
+  {$ENDIF}
+  if El.ClassType=TPasProperty then
+    Prop:=TPasProperty(El)
+  else
+    Prop:=nil;
+
+  IsRead:=false;
+  IsWrite:=false;
+  if UseFull then
+    if (Prop<>nil) then
+      begin
+      CanRead:=Resolver.GetPasPropertyGetter(Prop)<>nil;
+      CanWrite:=Resolver.GetPasPropertySetter(Prop)<>nil;
+      if CanRead then
+        begin
+        if CanWrite then
+          Access:=rraReadAndAssign
+        else
+          Access:=rraRead;
+        end
+      else
+        if CanWrite then
+          Access:=rraAssign
+        else
+          Access:=rraNone;
+      end
+    else
+      Access:=rraRead;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170307153439,'');
+  else
+    RaiseInconsistency(20170308120949,'');
+  end;
+
+  UseRead:=false;
+  UseWrite:=false;
+  if MarkElementAsUsed(El) then
+    begin
+    // first access of this variable
+    Usage:=FindElement(El);
+    // first set flags
+    if El.Expr<>nil then
+      Usage.Access:=paiaWrite;
+    UpdateVarAccess(IsRead,IsWrite);
+    // then use recursively
+    UseType(El.VarType,paumElement);
+    UseExpr(El.Expr);
+    UseExpr(El.LibraryName);
+    UseExpr(El.ExportName);
+    if Prop<>nil then
+      begin
+      for i:=0 to Prop.Args.Count-1 do
+        UseType(TPasArgument(Prop.Args[i]).ArgType,paumElement);
+      UseExpr(Prop.IndexExpr);
+      // ToDo: Prop.ImplementsFunc
+      // ToDo: Prop.DispIDExpr
+      // ToDo: Prop.StoredAccessor;
+      // ToDo: Prop.DefaultExpr;
+      end;
+    end
+  else
+    begin
+    Usage:=FindElement(El);
+    if Usage=nil then
+      exit; // element outside of scope
+    // var is accessed another time
+
+    // first update flags
+    UpdateVarAccess(IsRead,IsWrite);
+    end;
+  // then use recursively
+  if Prop<>nil then
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseVariable Property=',Prop.FullName,
+      ' Ancestor=',GetElModName(Resolver.GetPasPropertyAncestor(Prop)),
+      ' UseRead=',UseRead,',Acc=',GetElModName(Resolver.GetPasPropertyGetter(Prop)),
+      ' UseWrite=',UseWrite,',Acc=',GetElModName(Resolver.GetPasPropertySetter(Prop)),
+      '');
+    {$ENDIF}
+    if UseRead then
+      UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
+    if UseWrite then
+      UseElement(Resolver.GetPasPropertySetter(Prop),rraAssign,false);
+    end;
+end;
+
+procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
+  );
+var
+  Usage: TPAElement;
+  IsRead, IsWrite: Boolean;
+begin
+  IsRead:=false;
+  IsWrite:=false;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170308121031,'');
+  else
+    RaiseInconsistency(20170308121037,'');
+  end;
+  if MarkElementAsUsed(El) then
+    begin
+    // first time
+    Usage:=FindElement(El);
+    end
+  else
+    begin
+    // used again
+    Usage:=FindElement(El);
+    if Usage=nil then
+      RaiseNotSupported(20170308121928,El);
+    end;
+  UpdateAccess(IsWrite, IsRead, Usage);
+end;
+
+procedure TPasAnalyzer.UseResultElement(El: TPasResultElement;
+  Access: TResolvedRefAccess);
+var
+  IsRead, IsWrite: Boolean;
+  Usage: TPAElement;
+begin
+  IsRead:=false;
+  IsWrite:=false;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170308122319,'');
+  else
+    RaiseInconsistency(20170308122324,'');
+  end;
+  if MarkElementAsUsed(El) then
+    begin
+    // first time
+    Usage:=FindElement(El);
+    end
+  else
+    begin
+    // used again
+    Usage:=FindElement(El);
+    if Usage=nil then
+      RaiseNotSupported(20170308122333,El);
+    end;
+  UpdateAccess(IsWrite, IsRead, Usage);
+end;
+
+procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
+begin
+  if El=nil then exit;
+  if El is TPasVariable then
+    EmitVariableHints(TPasVariable(El))
+  else if El is TPasType then
+    EmitTypeHints(TPasType(El))
+  else if El is TPasProcedure then
+    EmitProcedureHints(TPasProcedure(El))
+  else
+    RaiseInconsistency(20170312093126,'');
+end;
+
+procedure TPasAnalyzer.EmitSectionHints(Section: TPasSection);
+var
+  UsesList: TFPList;
+  i: Integer;
+  UsedModule, aModule: TPasModule;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
+  {$ENDIF}
+  // initialization, program or library sections
+  aModule:=Section.GetModule;
+  UsesList:=Section.UsesList;
+  for i:=0 to UsesList.Count-1 do
+    begin
+    if TObject(UsesList[i]) is TPasModule then
+      begin
+      UsedModule:=TPasModule(UsesList[i]);
+      if CompareText(UsedModule.Name,'system')=0 then continue;
+      if FindNode(UsedModule)=nil then
+        EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
+          [UsedModule.Name,aModule.Name],aModule);
+      end;
+    end;
+
+  EmitDeclarationsHints(Section);
+end;
+
+procedure TPasAnalyzer.EmitDeclarationsHints(El: TPasDeclarations);
+var
+  i: Integer;
+  Decl: TPasElement;
+  Usage: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
+  {$ENDIF}
+  for i:=0 to El.Declarations.Count-1 do
+    begin
+    Decl:=TPasElement(El.Declarations[i]);
+    if Decl is TPasVariable then
+      EmitVariableHints(TPasVariable(Decl))
+    else if Decl is TPasType then
+      EmitTypeHints(TPasType(Decl))
+    else if Decl is TPasProcedure then
+      EmitProcedureHints(TPasProcedure(Decl))
+    else
+      begin
+      Usage:=FindPAElement(Decl);
+      if Usage=nil then
+        begin
+        // declaration was never used
+        EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
+          sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
+        end;
+      end;
+    end;
+end;
+
+procedure TPasAnalyzer.EmitTypeHints(El: TPasType);
+var
+  C: TClass;
+  Usage: TPAElement;
+  i: Integer;
+  Member: TPasElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
+  {$ENDIF}
+  Usage:=FindPAElement(El);
+  if Usage=nil then
+    begin
+    // the whole type was never used
+    if (El.Visibility in [visPrivate,visStrictPrivate]) then
+      EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
+        sPAPrivateTypeXNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    exit;
+    end;
+  // emit hints for sub elements
+  C:=El.ClassType;
+  if C=TPasRecordType then
+    begin
+    for i:=0 to TPasRecordType(El).Members.Count-1 do
+      EmitVariableHints(TObject(TPasRecordType(El).Members[i]) as TPasVariable);
+    end
+  else if C=TPasClassType then
+    begin
+    if TPasClassType(El).IsForward then exit;
+    for i:=0 to TPasClassType(El).Members.Count-1 do
+      begin
+      Member:=TPasElement(TPasClassType(El).Members[i]);
+      EmitElementHints(Member);
+      end;
+    end;
+end;
+
+procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);
+var
+  Usage: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
+  {$ENDIF}
+  Usage:=FindPAElement(El);
+  if Usage=nil then
+    begin
+    // not used
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      begin
+      if El.ClassType=TPasConst then
+        EmitMessage(20170311234602,mtHint,nPAPrivateConstXNeverUsed,
+          sPAPrivateConstXNeverUsed,[El.FullName],El)
+      else if El.ClassType=TPasProperty then
+        EmitMessage(20170311234634,mtHint,nPAPrivatePropertyXNeverUsed,
+          sPAPrivatePropertyXNeverUsed,[El.FullName],El)
+      else
+        EmitMessage(20170311231412,mtHint,nPAPrivateFieldIsNeverUsed,
+          sPAPrivateFieldIsNeverUsed,[El.FullName],El);
+      end
+    else if El.ClassType=TPasVariable then
+      EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
+        sPALocalVariableNotUsed,[El.Name],El)
+    else
+      EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    end
+  else if Usage.Access=paiaWrite then
+    begin
+    // write without read
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
+        sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
+        sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);
+    end;
+end;
+
+procedure TPasAnalyzer.EmitProcedureHints(El: TPasProcedure);
+var
+  Args: TFPList;
+  i: Integer;
+  Arg: TPasArgument;
+  Usage: TPAElement;
+  ProcScope: TPasProcedureScope;
+  PosEl: TPasElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
+  {$ENDIF}
+  ProcScope:=El.CustomData as TPasProcedureScope;
+  if (ProcScope.DeclarationProc=nil) and (FindNode(El)=nil) then
+    begin
+    // procedure never used
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
+        sPAPrivateMethodIsNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    exit;
+    end;
+
+  // procedure was used
+
+  if [pmAbstract,pmAssembler,pmExternal]*El.Modifiers<>[] then exit;
+
+  if ProcScope.DeclarationProc=nil then
+    begin
+    // check parameters
+    Args:=El.ProcType.Args;
+    for i:=0 to Args.Count-1 do
+      begin
+      Arg:=TPasArgument(Args[i]);
+      Usage:=FindPAElement(Arg);
+      if (Usage=nil) or (Usage.Access=paiaNone) then
+        // parameter was never used
+        EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
+          sPAParameterNotUsed,[Arg.Name],Arg)
+      else
+        begin
+        // parameter was used
+        if (Usage.Access=paiaWrite) and (Arg.Access<>argOut) then
+          EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed,
+            sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg);
+        end;
+      end;
+    // check result
+    if (El is TPasFunction) then
+      begin
+      PosEl:=TPasFunction(El).FuncType.ResultEl;
+      if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+        PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
+      Usage:=FindPAElement(TPasFunction(El).FuncType.ResultEl);
+      if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
+        // result was never used
+        EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+          sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
+      else
+        begin
+        // result was used
+        end;
+      end;
+    end;
+
+  if El.Body<>nil then
+    begin
+    // check declarations
+    EmitDeclarationsHints(El.Body);
+    // ToDo: emit hints for statements
+    end;
+end;
+
+constructor TPasAnalyzer.Create;
+var
+  m: TPAUseMode;
+begin
+  CreateTree;
+  for m in TPAUseMode do
+    FChecked[m]:=TAVLTree.Create;
+  FOverrideLists:=TAVLTree.Create(@ComparePAOverrideLists);
+end;
+
+destructor TPasAnalyzer.Destroy;
+var
+  m: TPAUseMode;
+begin
+  Clear;
+  FreeAndNil(FOverrideLists);
+  FreeAndNil(FUsedElements);
+  for m in TPAUseMode do
+    FreeAndNil(FChecked[m]);
+  inherited Destroy;
+end;
+
+procedure TPasAnalyzer.Clear;
+var
+  m: TPAUseMode;
+begin
+  FOverrideLists.FreeAndClear;
+  FUsedElements.FreeAndClear;
+  for m in TPAUseMode do
+    FChecked[m].Clear;
+end;
+
+procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
+var
+  Mode: TPAUseMode;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeModule START ',GetElModName(aModule));
+  {$ENDIF}
+  if Resolver=nil then
+    RaiseInconsistency(20170314223032,'TPasAnalyzer.AnalyzeModule missing Resolver');
+  if FUsedElements.Count>0 then
+    RaiseInconsistency(20170315153243,'');
+  ScopeModule:=aModule;
+  if (aModule is TPasProgram) or (aModule is TPasLibrary) then
+    Mode:=paumAllExports
+  else
+    Mode:=paumAllPublic;
+  UseModule(aModule,Mode);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeModule END ',GetElModName(aModule));
+  {$ENDIF}
+end;
+
+procedure TPasAnalyzer.AnalyzeWholeProgram(aStartModule: TPasProgram);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeWholeProgram START ',GetElModName(aStartModule));
+  {$ENDIF}
+  if Resolver=nil then
+    RaiseInconsistency(20170315153201,'TPasAnalyzer.AnalyzeWholeProgram missing Resolver');
+  if FUsedElements.Count>0 then
+    RaiseInconsistency(20170315153252,'');
+  ScopeModule:=nil;
+  UseModule(aStartModule,paumAllExports);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeWholeProgram END ',GetElModName(aStartModule));
+  {$ENDIF}
+end;
+
+procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitModuleHints ',GetElModName(aModule));
+  {$ENDIF}
+  if aModule.ClassType=TPasProgram then
+    EmitSectionHints(TPasProgram(aModule).ProgramSection)
+  else if aModule.ClassType=TPasLibrary then
+    EmitSectionHints(TPasLibrary(aModule).LibrarySection)
+  else
+    begin
+    // unit
+    EmitSectionHints(aModule.InterfaceSection);
+    EmitSectionHints(aModule.ImplementationSection);
+    end;
+  //EmitBlockHints(aModule.InitializationSection);
+  //EmitBlockHints(aModule.FinalizationSection);
+end;
+
+function TPasAnalyzer.FindElement(El: TPasElement): TPAElement;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAElement(Node.Data);
+end;
+
+function TPasAnalyzer.IsUsed(El: TPasElement): boolean;
+var
+  ProcScope: TPasProcedureScope;
+begin
+  if not IsIdentifier(El) then exit(true);
+  if El is TPasProcedure then
+    begin
+    ProcScope:=El.CustomData as TPasProcedureScope;
+    if ProcScope.DeclarationProc<>nil then
+      El:=ProcScope.DeclarationProc;
+    end;
+  Result:=FindElement(El)<>nil;
+end;
+
+function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if El.ClassType=TInterfaceSection then
+    exit(false);
+  if IsExport(El) then exit(false);
+  case El.Visibility of
+  visPrivate,visStrictPrivate: exit(true);
+  visPublished: if paoKeepPublished in Options then exit(false);
+  end;
+  Result:=IsModuleInternal(El.Parent);
+end;
+
+function TPasAnalyzer.IsExport(El: TPasElement): boolean;
+begin
+  if El is TPasVariable then
+    Result:=[vmExport,vmPublic]*TPasVariable(El).VarModifiers<>[]
+  else if El is TPasProcedure then
+    Result:=[pmExport,pmPublic]*TPasProcedure(El).Modifiers<>[]
+  else
+    Result:=false;
+end;
+
+function TPasAnalyzer.IsIdentifier(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  C:=El.ClassType;
+  Result:=C.InheritsFrom(TPasType)
+      or C.InheritsFrom(TPasVariable)
+      or C.InheritsFrom(TPasProcedure)
+      or C.InheritsFrom(TPasModule);
+end;
+
+function TPasAnalyzer.IsImplBlockEmpty(El: TPasImplBlock): boolean;
+begin
+  Result:=true;
+  if (El=nil) or (El.Elements.Count=0) then exit;
+  Result:=false;
+end;
+
+procedure TPasAnalyzer.EmitMessage(const Id: int64;
+  const MsgType: TMessageType; MsgNumber: integer; Fmt: String;
+  const Args: array of const; PosEl: TPasElement);
+var
+  Msg: TPAMessage;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  //writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
+  {$ENDIF}
+  Msg:=TPAMessage.Create;
+  Msg.Id:=Id;
+  Msg.MsgType:=MsgType;
+  Msg.MsgNumber:=MsgNumber;
+  Msg.MsgPattern:=Fmt;
+  Msg.MsgText:=SafeFormat(Fmt,Args);
+  CreateMsgArgs(Msg.Args,Args);
+  Msg.PosEl:=PosEl;
+  Msg.Filename:=PosEl.SourceFilename;
+  Resolver.UnmangleSourceLineNumber(PosEl.SourceLinenumber,Msg.Row,Msg.Col);
+  EmitMessage(Msg);
+end;
+
+procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText);
+  {$ENDIF}
+  try
+    OnMessage(Self,Msg);
+  finally
+    Msg.Release;
+  end;
+end;
+
+end.
+

packages/fcl-passrc/src/pparser.pp

@@ -75,6 +75,7 @@ const
   nParserOnlyOneVariableCanBeInitialized = 2048;
   nParserExpectedTypeButGot = 2049;
   nParserPropertyArgumentsCanNotHaveDefaultValues = 2050;
+  nParserExpectedExternalClassName = 2051;
 
 // resourcestring patterns of messages
 resourcestring
@@ -128,6 +129,7 @@ resourcestring
   SParserOnlyOneVariableCanBeInitialized = 'Only one variable can be initialized';
   SParserExpectedTypeButGot = 'Expected type, but got %s';
   SParserPropertyArgumentsCanNotHaveDefaultValues = 'Property arguments can not have default values';
+  SParserExpectedExternalClassName = 'Expected external class name';
 
 type
   TPasScopeType = (
@@ -240,7 +242,7 @@ type
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
     function GetCurrentModeSwitches: TModeSwitches;
     Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
-    function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr): string;
+    function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr; ExternalClass : Boolean): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
@@ -280,9 +282,9 @@ type
     function CreatePrimitiveExpr(AParent: TPasElement; AKind: TPasExprKind; const AValue: String): TPrimitiveExpr;
     function CreateBoolConstExpr(AParent: TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean): TBoolConstExpr;
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
-    procedure AddToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
+    procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
       Element: TPasExpr; AOpCode: TExprOpCode);
-    procedure AddParamsToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
+    procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
       Params: TParamsExpr);
     {$IFDEF VerbosePasParser}
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
@@ -290,7 +292,7 @@ type
     function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
     function CreateArrayValues(AParent : TPasElement): TArrayValues;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
-             UseParentAsResultParent: Boolean): TPasFunctionType;
+             UseParentAsResultParent: Boolean; const NamePos: TPasSourcePos): TPasFunctionType;
     function CreateInheritedExpr(AParent : TPasElement): TInheritedExpr;
     function CreateSelfExpr(AParent : TPasElement): TSelfExpr;
     function CreateNilExpr(AParent : TPasElement): TNilExpr;
@@ -331,7 +333,7 @@ type
     // Type declarations
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
-    function ParseType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String = ''; Full : Boolean = False): TPasType;
+    function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs: TFPList = nil): TPasType;
     function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
     function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
     function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
@@ -343,7 +345,7 @@ type
     function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
     function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
     function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
-    Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
+    Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone; GenericArgs: TFPList = nil): TPasType;
     Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility; IsClassField: boolean) : TPasProperty;
     function ParseRangeType(AParent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; Full: Boolean = True): TPasRangeType;
     procedure ParseExportDecl(Parent: TPasElement; List: TFPList);
@@ -713,8 +715,11 @@ end;
 procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
   Args: array of const);
 begin
+  {$IFDEF VerbosePasParser}
+  writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
+  {$ENDIF}
   SetLastMsg(mtError,MsgNumber,Fmt,Args);
-  raise EParserError.Create(Format(SParserErrorAtToken,
+  raise EParserError.Create(SafeFormat(SParserErrorAtToken,
     [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
     {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},
     Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
@@ -832,8 +837,20 @@ begin
       until not (FCurToken in WhitespaceTokensToIgnore);
     except
       on e: EScannerError do
-        raise EParserError.Create(e.Message,
-          Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+        begin
+        if po_KeepScannerError in Options then
+          raise e
+        else
+          begin
+          FLastMsgType := mtError;
+          FLastMsgNumber := Scanner.LastMsgNumber;
+          FLastMsgPattern := Scanner.LastMsgPattern;
+          FLastMsg := Scanner.LastMsg;
+          FLastMsgArgs := Scanner.LastMsgArgs;
+          raise EParserError.Create(e.Message,
+            Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+          end;
+        end;
     end;
     FCurTokenString := Scanner.CurTokenString;
     FTokenBuffer[FTokenBufferSize] := FCurToken;
@@ -1080,6 +1097,11 @@ begin
       ParseExcTokenError(';');
     UnGetToken;
     end
+  else  if (CurToken = tkLessThan) then // A = B<t>;
+    begin
+    K:=stkSpecialize;
+    UnGetToken;
+    end
   else if (CurToken in [tkBraceOpen,tkDotDot]) then // A: B..C;
     begin
     K:=stkRange;
@@ -1247,7 +1269,7 @@ begin
 end;
 
 function TPasParser.ParseType(Parent: TPasElement;
-  const NamePos: TPasSourcePos; const TypeName: String; Full: Boolean
+  const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs : TFPList = Nil
   ): TPasType;
 
 Const
@@ -1280,7 +1302,7 @@ begin
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM);
+      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
       tkType:
         begin
         NextToken;
@@ -1345,7 +1367,7 @@ begin
       end;
     tkFunction:
       begin
-        Result := CreateFunctionType('', 'Result', Parent, False);
+        Result := CreateFunctionType('', 'Result', Parent, False, Scanner.CurSourcePos);
         ParseProcedureOrFunctionHeader(Result, TPasFunctionType(Result), ptFunction, True);
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
@@ -1575,7 +1597,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
   end;
 
 var
-  Last    , Expr: TPasExpr;
+  Last,func, Expr: TPasExpr;
   prm     : TParamsExpr;
   b       : TBinaryExpr;
   optk    : TToken;
@@ -1649,7 +1671,8 @@ begin
   end;
 
   Result:=Last;
-
+  func:=Last;
+  
   if Last.Kind<>pekSet then NextToken;
 
   ok:=false;
@@ -1661,8 +1684,9 @@ begin
         NextToken;
         if CurToken in [tkIdentifier,tktrue,tkfalse] then // true and false are also identifiers
           begin
-          AddToBinaryExprChain(Result,Last,
-            CreatePrimitiveExpr(AParent,pekIdent,CurTokenString), eopSubIdent);
+          expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
+          AddToBinaryExprChain(Result,expr,eopSubIdent);
+          func:=expr;
           NextToken;
           end
         else
@@ -1671,21 +1695,20 @@ begin
           ParseExcExpectedIdentifier;
           end;
         end;
-      repeat
+       repeat
         case CurToken of
           tkBraceOpen,tkSquaredBraceOpen:
             begin
             if CurToken=tkBraceOpen then
-              prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(Last))
+              prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(func))
             else
               prm:=ParseParams(AParent,pekArrayParams);
             if not Assigned(prm) then Exit;
-            AddParamsToBinaryExprChain(Result,Last,prm);
+            AddParamsToBinaryExprChain(Result,prm);
             end;
           tkCaret:
             begin
             Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
-            Last:=Result;
             NextToken;
             end;
           else
@@ -1701,7 +1724,7 @@ begin
         if Expr=nil then
           ParseExcExpectedIdentifier;
         if optk=tkDot then
-          AddToBinaryExprChain(Result,Last,Expr,TokenToExprOp(optk))
+          AddToBinaryExprChain(Result,Expr,TokenToExprOp(optk))
         else
           begin
           // a as b
@@ -1847,7 +1870,7 @@ begin
           if (CurToken<>tkBraceClose) then
             begin
             x.Release;
-            Exit;
+            CheckToken(tkBraceClose);
             end;
           NextToken;
           // for expressions like (ppdouble)^^;
@@ -1868,7 +1891,7 @@ begin
           x:=ParseExpIdent(AParent);
           end;
         if not Assigned(x) then
-          Exit;
+          ParseExcSyntaxError;
         expstack.Add(x);
 
         for i:=1 to pcount do
@@ -1901,7 +1924,7 @@ begin
         PushOper(CurToken);
         NextToken;
         end;
-      // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
+       //Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
     until NotBinary or isEndOfExp(AllowEqual);
 
     if not NotBinary then ParseExcExpectedIdentifier;
@@ -1909,6 +1932,8 @@ begin
     while opstackTop>=0 do PopAndPushOperator;
 
     // only 1 expression should be on the stack, at the end of the correct expression
+    if expstack.Count<>1 then
+      ParseExcSyntaxError;
     if expstack.Count=1 then
       begin
       Result:=TPasExpr(expstack[0]);
@@ -2477,20 +2502,20 @@ begin
         SetBlock(declProperty);
       tkProcedure, tkFunction, tkConstructor, tkDestructor,tkOperator:
         begin
+        SetBlock(declNone);
         SaveComments;
         pt:=GetProcTypeFromToken(CurToken);
         AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
-        SetBlock(declNone);
         end;
       tkClass:
         begin
+          SetBlock(declNone);
           SaveComments;
           NextToken;
           If CurToken in [tkprocedure,tkFunction,tkConstructor, tkDestructor] then
             begin
             pt:=GetProcTypeFromToken(CurToken,True);
             AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
-            SetBlock(declNone);
             end
           else
             ExpectToken(tkprocedure);
@@ -2579,6 +2604,7 @@ begin
                     Declarations.Declarations.Add(VarEl);
                     Declarations.Variables.Add(VarEl);
                   end;
+                  CheckToken(tkSemicolon);
                 finally
                   List.Free;
                 end;
@@ -2605,16 +2631,12 @@ begin
             ExpectToken(tkEqual);
             NextToken;
             Case CurToken of
+              tkObject,
               tkClass :
                  begin
                  ClassEl := TPasClassType(CreateElement(TPasClassType,
                    TypeName, Declarations, NamePos));
-                 ClassEl.ObjKind:=okGeneric;
-                 For I:=0 to List.Count-1 do
-                   begin
-                   TPasElement(List[i]).Parent:=ClassEl;
-                   ClassEl.GenericTemplateTypes.Add(List[i]);
-                   end;
+                 ClassEl.SetGenericTemplates(List);
                  NextToken;
                  DoParseClassType(ClassEl);
                  Declarations.Declarations.Add(ClassEl);
@@ -2777,6 +2799,8 @@ var
 begin
   SaveComments;
   Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
+  if Parent is TPasClassType then
+    Include(Result.VarModifiers,vmClass);
   ok:=false;
   try
     NextToken;
@@ -2908,22 +2932,9 @@ end;
 function TPasParser.ParseSpecializeType(Parent: TPasElement;
   const TypeName: String): TPasClassType;
 
-var
-  ok: Boolean;
 begin
-  Result := TPasClassType(CreateElement(TPasClassType, TypeName, Parent,
-    Scanner.CurSourcePos));
-  ok:=false;
-  try
-    Result.ObjKind := okSpecialize;
-    Result.AncestorType := ParseType(Result,Scanner.CurSourcePos);
-    Result.IsShortDefinition:=True;
-    ReadGenericArguments(TPasClassType(Result).GenericTemplateTypes,Result);
-    ok:=true;
-  finally
-    if not ok then
-      Result.Release;
-  end;
+  NextToken;
+  Result:=ParseSimpleType(Parent,Scanner.CurSourcePos,TypeName) as TPasClassType;
 end;
 
 function TPasParser.ParseProcedureType(Parent: TPasElement;
@@ -2934,7 +2945,7 @@ var
   ok: Boolean;
 begin
   if PT in [ptFunction,ptClassFunction] then
-    Result := CreateFunctionType(TypeName, 'Result', Parent, False)
+    Result := CreateFunctionType(TypeName, 'Result', Parent, False, NamePos)
   else
     Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent, NamePos));
   ok:=false;
@@ -2953,16 +2964,25 @@ var
   TypeName: String;
   NamePos: TPasSourcePos;
   OldForceCaret : Boolean;
+  List : TFPList;
 
 begin
   TypeName := CurTokenString;
   NamePos:=Scanner.CurSourcePos;
-  ExpectToken(tkEqual);
+  List:=Nil;
   OldForceCaret:=Scanner.SetForceCaret(True);
   try
-    Result:=ParseType(Parent,NamePos,TypeName,True);
+    NextToken;
+    if (CurToken=tkLessThan) and (msDelphi in CurrentModeswitches) then
+      List:=TFPList.Create;
+    UnGetToken; // ReadGenericArguments starts at <
+    if Assigned(List) then
+      ReadGenericArguments(List,Parent);
+    ExpectToken(tkEqual);
+    Result:=ParseType(Parent,NamePos,TypeName,True,List);
   finally
     Scanner.SetForceCaret(OldForceCaret);
+    List.Free;
   end;
 end;
 
@@ -2998,7 +3018,8 @@ begin
 end;
 
 function TPasParser.GetVariableModifiers(Parent: TPasElement; out
-  VarMods: TVariableModifiers; out LibName, ExportName: TPasExpr): string;
+  VarMods: TVariableModifiers; out LibName, ExportName: TPasExpr;
+  ExternalClass: Boolean): string;
 
 Var
   S : String;
@@ -3009,7 +3030,7 @@ begin
   ExportName := nil;
   VarMods := [];
   NextToken;
-  If CurTokenIsIdentifier('cvar') then
+  If CurTokenIsIdentifier('cvar') and not ExternalClass then
     begin
     Result:=';cvar';
     Include(VarMods,vmcvar);
@@ -3019,9 +3040,9 @@ begin
   s:=LowerCase(CurTokenText);
   if s='external' then
     ExtMod:=vmExternal
-  else if (s='public') then
+  else if (s='public') and not externalclass then
     ExtMod:=vmPublic
-  else if (s='export') then
+  else if (s='export') and not externalclass then
     ExtMod:=vmExport
   else
     begin
@@ -3046,7 +3067,7 @@ begin
   // external libname name exportname;
   // external name exportname;
   if (ExtMod=vmExternal) and (CurToken in [tkString,tkIdentifier])
-      and Not (CurTokenIsIdentifier('name')) then
+      and Not (CurTokenIsIdentifier('name')) and not ExternalClass then
     begin
     Result := Result + ' ' + CurTokenText;
     LibName:=DoParseExpression(Parent);
@@ -3073,7 +3094,7 @@ var
   H : TPasMemberHints;
   VarMods: TVariableModifiers;
   D,Mods,Loc: string;
-  OldForceCaret,ok: Boolean;
+  OldForceCaret,ok,ExternalClass: Boolean;
 
 begin
   Value:=Nil;
@@ -3119,13 +3140,25 @@ begin
     TPasVariable(VarList[OldListCount]).Expr:=Value;
     Value:=nil;
 
-    H:=H+CheckHint(Nil,Full);
-    if Full then
-      Mods:=GetVariableModifiers(Parent,VarMods,aLibName,aExpName)
+    // Note: external members are allowed for non external classes too
+    ExternalClass:=(msExternalClass in CurrentModeSwitches)
+                    and (Parent is TPasClassType);
+
+    H:=H+CheckHint(Nil,False);
+    if Full or Externalclass then
+      begin
+      NextToken;
+      If Curtoken<>tkSemicolon then
+        UnGetToken;
+      Mods:=GetVariableModifiers(Parent,VarMods,aLibName,aExpName,ExternalClass);
+      if (mods='') and (CurToken<>tkSemicolon) then
+        NextToken;
+      end
     else
       begin
       NextToken;
       VarMods:=[];
+      Mods:='';
       end;
     SaveComments(D);
 
@@ -3201,7 +3234,7 @@ begin
   FLastMsgType := MsgType;
   FLastMsgNumber := MsgNumber;
   FLastMsgPattern := Fmt;
-  FLastMsg := Format(Fmt,Args);
+  FLastMsg := SafeFormat(Fmt,Args);
   CreateMsgArgs(FLastMsgArgs,Args);
 end;
 
@@ -3400,11 +3433,19 @@ Var
   P : TPasProcedure;
   E : TPasExpr;
 
-begin
-  if Parent is TPasProcedure then
-    P:=TPasProcedure(Parent);
-  if Assigned(P) then
+  procedure AddModifier;
+  begin
+    if pm in P.Modifiers then
+      ParseExcSyntaxError;
     P.AddModifier(pm);
+  end;
+
+begin
+  if not (Parent is TPasProcedure) then
+    exit;
+  P:=TPasProcedure(Parent);
+  if pm<>pmPublic then
+    AddModifier;
   Case pm of
   pmExternal:
     begin
@@ -3443,16 +3484,22 @@ begin
   pmPublic:
     begin
     NextToken;
-    { Should be token Name,
-      if not we're in a class and the public section starts }
-    If (Uppercase(CurTokenString)<>'NAME') then
+    If not CurTokenIsIdentifier('name') then
       begin
-      UngetToken;
-      UngetToken;
+      if P.Parent is TPasClassType then
+        begin
+        // public section starts
+        UngetToken;
+        UngetToken;
+        exit;
+        end;
+      AddModifier;
+      CheckToken(tkSemicolon);
       exit;
       end
     else
       begin
+      AddModifier;
       NextToken;  // Should be export name string.
       if not (CurToken in [tkString,tkIdentifier]) then
         ParseExcTokenError(TokenInfos[tkString]);
@@ -3561,7 +3608,6 @@ Var
   PM : TProcedureModifier;
   Done: Boolean;
   ResultEl: TPasResultElement;
-  I : Integer;
   OK : Boolean;
 
 begin
@@ -3647,7 +3693,7 @@ begin
     UngetToken;
   Repeat
     NextToken;
-    If TokenisCallingConvention(CurTokenString,cc) then
+    If TokenIsCallingConvention(CurTokenString,cc) then
       begin
       Element.CallingConvention:=Cc;
       if cc = ccSysCall then
@@ -3696,7 +3742,9 @@ begin
         NextToken
       until CurToken = tkSquaredBraceClose;
       ExpectToken(tkSemicolon);
-      end;
+      end
+    else if CurToken<>tkSemicolon then
+      CheckToken(tkSemicolon);
     Done:=(CurToken=tkSemiColon);
     if Done then
       begin
@@ -3745,14 +3793,12 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
 
   function GetAccessorName(aParent: TPasElement; out Expr: TPasExpr): String;
   var
-    Last: TPasExpr;
     Params: TParamsExpr;
     Param: TPasExpr;
   begin
     ExpectIdentifier;
     Result := CurTokenString;
     Expr := CreatePrimitiveExpr(aParent,pekIdent,CurTokenString);
-    Last := Expr;
 
     // read .subident.subident...
     repeat
@@ -3760,7 +3806,7 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
       if CurToken <> tkDot then break;
       ExpectIdentifier;
       Result := Result + '.' + CurTokenString;
-      AddToBinaryExprChain(Expr,Last,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
+      AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
     until false;
 
     // read optional array index
@@ -3771,7 +3817,7 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
       Result := Result + '[';
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
       Params.Kind:=pekArrayParams;
-      AddParamsToBinaryExprChain(Expr,Last,Params);
+      AddParamsToBinaryExprChain(Expr,Params);
       NextToken;
       case CurToken of
         tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
@@ -3795,7 +3841,7 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
         end;
       ExpectIdentifier;
       Result := Result + '.' + CurTokenString;
-      AddToBinaryExprChain(Expr,Last,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
+      AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
     until false;
   end;
 
@@ -4057,14 +4103,16 @@ begin
   while True do
   begin
     NextToken;
-    //WriteLn('Token=',CurTokenText);
+     WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
     case CurToken of
     tkasm:
       begin
       El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
       ParseAsmBlock(TPasImplAsmStatement(El));
       CurBlock.AddElement(El);
-      NewImplElement:=El;
+      if NewImplElement=nil then NewImplElement:=CurBlock;
+      if CloseStatement(true) then
+        break;
       end;
     tkbegin:
       begin
@@ -4156,7 +4204,7 @@ begin
       begin
         NextToken;
         curblock.AddCommand('goto '+curtokenstring);
-        expecttoken(tkSemiColon);
+        // expecttoken(tkSemiColon);
       end;
     tkfor:
       begin
@@ -4167,7 +4215,6 @@ begin
         Try
           ExpectIdentifier;
           Left:=CreatePrimitiveExpr(El,pekIdent,CurTokenString);
-          Right:=Left;
           TPasImplForLoop(El).VariableName:=Left;
           repeat
             NextToken;
@@ -4185,7 +4232,7 @@ begin
               tkDot:
                 begin
                 ExpectIdentifier;
-                AddToBinaryExprChain(Left,Right,
+                AddToBinaryExprChain(Left,
                   CreatePrimitiveExpr(El,pekIdent,CurTokenString), eopSubIdent);
                 TPasImplForLoop(El).VariableName:=Left;
                 end;
@@ -4449,7 +4496,10 @@ begin
         end else
           ParseExcSyntaxError;
       end;
-    else
+    tkEOF:
+      CheckToken(tkend);
+    tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
+      begin
       left:=DoParseExpression(CurBlock);
       case CurToken of
         tkAssign,
@@ -4494,6 +4544,9 @@ begin
 
       if not (CmdElem is TPasImplLabelMark) then
         if NewImplElement=nil then NewImplElement:=CmdElem;
+      end;
+    else
+      ParseExcSyntaxError;
     end;
   end;
 end;
@@ -4534,15 +4587,33 @@ end;
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
 
   function ExpectProcName: string;
+
+  Var
+    L : TFPList;
+    I : Integer;
+
   begin
     Result:=ExpectIdentifier;
     //writeln('ExpectProcName ',Parent.Classname);
     if Parent is TImplementationSection then
     begin
       NextToken;
-      While CurToken=tkDot do
+      While CurToken in [tkDot,tkLessThan] do
         begin
-        Result:=Result+'.'+ExpectIdentifier;
+        if CurToken=tkDot then
+          Result:=Result+'.'+ExpectIdentifier
+        else
+          begin // <> can be ignored, we read the list but discard its content
+          UnGetToken;
+          L:=TFPList.Create;
+          Try
+            ReadGenericArguments(L,Parent);
+          finally
+            For I:=0 to L.Count-1 do
+              TPasElement(L[i]).Release;
+            L.Free;
+          end;
+          end;
         NextToken;
         end;
       UngetToken;
@@ -4579,7 +4650,7 @@ begin
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
     else
       begin
-      Result.ProcType := CreateFunctionType('', 'Result', Result, True);
+      Result.ProcType := CreateFunctionType('', 'Result', Result, True, Scanner.CurSourcePos);
       if (ProcType in [ptOperator, ptClassOperator]) then
         begin
         TPasOperator(Result).TokenBased:=IsTokenBased;
@@ -5009,18 +5080,23 @@ begin
         SaveComments;
         ExpectIdentifier;
         AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility,false));
-        end;
+        end
+    else
+      CheckToken(tkIdentifier);
     end;
     NextToken;
     end;
 end;
+
 procedure TPasParser.DoParseClassType(AType: TPasClassType);
 
 var
   Element : TPasElement;
   s: String;
+  CT : TPasClassType;
 
 begin
+  ct:=Nil;
   // nettism/new delphi features
   if (CurToken=tkIdentifier) and (Atype.ObjKind in [okClass,okGeneric]) then
     begin
@@ -5036,11 +5112,28 @@ begin
   if (CurToken=tkBraceOpen) then
     begin
     AType.AncestorType := ParseType(AType,Scanner.CurSourcePos);
+    NextToken;
+    if curToken=tkLessthan then
+      CT := TPasClassType(CreateElement(TPasClassType, AType.AncestorType.Name, AType.Parent, Scanner.CurSourcePos));
+    UnGetToken ;
+    if Assigned(CT) then
+      try
+        CT.ObjKind := okSpecialize;
+        CT.AncestorType := TPasUnresolvedTypeRef.Create(AType.AncestorType.Name,AType.Parent);
+        CT.IsShortDefinition:=True;
+        ReadGenericArguments(CT.GenericTemplateTypes,CT);
+        AType.AncestorType.Release;
+        AType.AncestorType:=CT;
+        CT:=Nil;
+      Finally
+        FreeAndNil(CT);
+      end;
     while True do
       begin
       NextToken;
       if CurToken = tkBraceClose then
-        break;
+        break  ;
+
       UngetToken;
       ExpectToken(tkComma);
       Element:=ParseType(AType,Scanner.CurSourcePos,'',False); // search interface.
@@ -5076,12 +5169,13 @@ end;
 
 function TPasParser.ParseClassDecl(Parent: TPasElement;
   const NamePos: TPasSourcePos; const AClassName: String;
-  AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
+  AObjKind: TPasObjKind; PackMode: TPackMode; GenericArgs: TFPList): TPasType;
 
 Var
   ok: Boolean;
   FT : TPasType;
-
+  AExternalNameSpace,AExternalName : String;
+  PCT:TPasClassType;
 begin
   NextToken;
   FT:=Nil;
@@ -5095,13 +5189,32 @@ begin
     Engine.FinishScope(stTypeDef,Result);
     exit;
     end;
+  if ((AobjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches) and  CurTokenIsIdentifier('external')) then
+    begin
+    NextToken;
+    if CurToken<>tkString then
+      UnGetToken
+    else
+      AExternalNameSpace:=CurTokenString;
+    ExpectIdentifier;
+    If Not CurTokenIsIdentifier('Name')  then
+      ParseExc(nParserExpectedExternalClassName,SParserExpectedExternalClassName);
+    ExpectToken(tkString);
+    AExternalName:=CurTokenString;
+    NextToken;
+    end
+  else
+    begin
+    AExternalNameSpace:='';
+    AExternalName:='';
+    end;
   if (CurTokenIsIdentifier('Helper')) then
     begin
     if Not (AObjKind in [okClass,okTypeHelper,okRecordHelper]) then
       ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
     Case AObjKind of
      okClass:
-        AObjKind:=okClassHelper;
+       AObjKind:=okClassHelper;
      okTypeHelper:
        begin
        ExpectToken(tkFor);
@@ -5110,14 +5223,22 @@ begin
     end;
     NextToken;
     end;
-  Result := TPasClassType(CreateElement(TPasClassType, AClassName,
+  PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
     Parent, NamePos));
-  TPasClassType(Result).HelperForType:=FT;
+  Result:=PCT;
+  PCT.HelperForType:=FT;
+  PCT.IsExternal:=(AExternalName<>'');
+  if AExternalName<>'' then
+    PCT.ExternalName:=AnsiDequotedStr(AExternalName,'''');
+  if AExternalNameSpace<>'' then
+    PCT.ExternalNameSpace:=AnsiDequotedStr(AExternalNameSpace,'''');
   ok:=false;
   try
-    TPasClassType(Result).ObjKind := AObjKind;
-    TPasClassType(Result).PackMode:=PackMode;
-    DoParseClassType(TPasClassType(Result));
+    PCT.ObjKind := AObjKind;
+    PCT.PackMode:=PackMode;
+    if Assigned(GenericArgs) then
+      PCT.SetGenericTemplates(GenericArgs);
+    DoParseClassType(PCT);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
@@ -5186,60 +5307,36 @@ begin
     end;
 end;
 
-procedure TPasParser.AddToBinaryExprChain(var ChainFirst, ChainLast: TPasExpr;
+procedure TPasParser.AddToBinaryExprChain(var ChainFirst: TPasExpr;
   Element: TPasExpr; AOpCode: TExprOpCode);
-
-  procedure RaiseInternal;
-  begin
-    raise Exception.Create('TBinaryExpr.AddToChain: internal error');
-  end;
-
-var
-  Last: TBinaryExpr;
 begin
   if Element=nil then
     exit
   else if ChainFirst=nil then
     begin
     // empty chain => simply add element, no need to create TBinaryExpr
-    if (ChainLast<>nil) then
-      RaiseInternal;
     ChainFirst:=Element;
-    ChainLast:=Element;
-    end
-  else if ChainLast is TBinaryExpr then
-    begin
-    // add a new TBinaryExpr at the end of the chain
-    Last:=TBinaryExpr(ChainLast);
-    if (Last.left=nil) or (Last.right=nil) then
-      // chain not yet full => inconsistency
-      RaiseInternal;
-    Last.right:=CreateBinaryExpr(Last,Last.right,Element,AOpCode);
-    ChainLast:=Last.right;
     end
   else
     begin
-    // one element => create a TBinaryExpr with two elements
-    if ChainFirst<>ChainLast then
-      RaiseInternal;
-    ChainLast:=CreateBinaryExpr(ChainLast.Parent,ChainLast,Element,AOpCode);
-    ChainFirst:=ChainLast;
+    // create new binary, old becomes left, Element right
+    ChainFirst:=CreateBinaryExpr(ChainFirst.Parent,ChainFirst,Element,AOpCode);
     end;
 end;
 
-procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst,
-  ChainLast: TPasExpr; Params: TParamsExpr);
-// append Params to chain, using the last element as Params.Value
+procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
+  Params: TParamsExpr);
+// append Params to chain, using the last(right) element as Params.Value
 var
   Bin: TBinaryExpr;
 begin
   if Params.Value<>nil then
     ParseExcSyntaxError;
-  if ChainLast=nil then
+  if ChainFirst=nil then
     ParseExcSyntaxError;
-  if ChainLast is TBinaryExpr then
+  if ChainFirst is TBinaryExpr then
     begin
-    Bin:=TBinaryExpr(ChainLast);
+    Bin:=TBinaryExpr(ChainFirst);
     if Bin.left=nil then
       ParseExcSyntaxError;
     if Bin.right=nil then
@@ -5251,13 +5348,10 @@ begin
     end
   else
     begin
-    if ChainFirst<>ChainLast then
-      ParseExcSyntaxError;
     Params.Value:=ChainFirst;
     Params.Parent:=ChainFirst.Parent;
     ChainFirst.Parent:=Params;
     ChainFirst:=Params;
-    ChainLast:=Params;
     end;
 end;
 
@@ -5340,11 +5434,12 @@ begin
 end;
 
 function TPasParser.CreateFunctionType(const AName, AResultName: String;
-  AParent: TPasElement; UseParentAsResultParent: Boolean): TPasFunctionType;
+  AParent: TPasElement; UseParentAsResultParent: Boolean;
+  const NamePos: TPasSourcePos): TPasFunctionType;
 begin
   Result:=Engine.CreateFunctionType(AName,AResultName,
                                     AParent,UseParentAsResultParent,
-                                    Scanner.CurSourcePos);
+                                    NamePos);
 end;
 
 function TPasParser.CreateInheritedExpr(AParent: TPasElement): TInheritedExpr;

packages/fcl-passrc/src/pscanner.pp

@@ -237,7 +237,8 @@ type
     msBlocks,              { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
     msISOLikeIO,           { I/O as it required by an ISO compatible compiler }
     msISOLikeProgramsPara, { program parameters as it required by an ISO compatible compiler }
-    msISOLikeMod           { mod operation as it is required by an iso compatible compiler }
+    msISOLikeMod,          { mod operation as it is required by an iso compatible compiler }
+    msExternalClass        { Allow external class definitions }
   );
   TModeSwitches = Set of TModeSwitch;
 
@@ -378,13 +379,14 @@ type
 
   TPOption = (
     po_delphi,               // DEPRECATED 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_asmwhole,             // store whole text between asm..end in TPasImplAsmStatement.Tokens
-    po_nooverloadedprocs,    // do not create TPasOverloadedProc for procs with same name
-    po_keepclassforward,     // disabled: delete class fowards when there is a class declaration
-    po_arrayrangeexpr,       // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
-    po_selftoken             // Self is a token. For backward compatibility.
+    po_KeepScannerError,     // default: catch EScannerError and raise an EParserError instead
+    po_CAssignments,         // allow C-operators += -= *= /=
+    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
+    po_NoOverloadedProcs,    // do not create TPasOverloadedProc for procs with same name
+    po_KeepClassForward,     // disabled: delete class fowards when there is a class declaration
+    po_ArrayRangeExpr,       // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
+    po_SelfToken             // Self is a token. For backward compatibility.
     );
   TPOptions = set of TPOption;
 
@@ -658,7 +660,8 @@ const
     'CBLOCKS',
     'ISOIO',
     'ISOPROGRAMPARAS',
-    'ISOMOD'
+    'ISOMOD',
+    'EXTERNALCLASS'
     );
 
 const
@@ -699,6 +702,7 @@ function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
 function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
 
 procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
+function SafeFormat(const Fmt: string; Args: array of const): string;
 
 implementation
 
@@ -786,7 +790,6 @@ var
 begin
   SetLength(MsgArgs, High(Args)-Low(Args)+1);
   for i:=Low(Args) to High(Args) do
-  begin
     case Args[i].VType of
       vtInteger:      MsgArgs[i] := IntToStr(Args[i].VInteger);
       vtBoolean:      MsgArgs[i] := BoolToStr(Args[i].VBoolean);
@@ -810,6 +813,26 @@ begin
       vtQWord:        MsgArgs[i] := IntToStr(Args[i].VQWord^);
       vtUnicodeString:MsgArgs[i] := AnsiString(UnicodeString(Args[i].VUnicodeString));
     end;
+end;
+
+function SafeFormat(const Fmt: string; Args: array of const): string;
+var
+  MsgArgs: TMessageArgs;
+  i: Integer;
+begin
+  try
+    Result:=Format(Fmt,Args);
+  except
+    Result:='';
+    MsgArgs:=nil;
+    CreateMsgArgs(MsgArgs,Args);
+    for i:=0 to length(MsgArgs)-1 do
+      begin
+      if i>0 then
+        Result:=Result+',';
+      Result:=Result+MsgArgs[i];
+      end;
+    Result:='{'+Fmt+'}['+Result+']';
   end;
 end;
 
@@ -1309,7 +1332,8 @@ begin
         FCurToken:=tkIdentifier;
         Result:=FCurToken;
         end;
-      Break;
+      if not (FSkipComments or PPIsSkipping) then
+        Break;
       end;
     else
       if not PPIsSkipping then
@@ -1961,7 +1985,8 @@ begin
           TokenStart := TokenStr;
           FCurTokenString := '';
           OldLength := 0;
-          while (TokenStr[0] <> '*') or (TokenStr[1] <> ')') do
+          NestingLevel:=0;
+          while (TokenStr[0] <> '*') or (TokenStr[1] <> ')') or (NestingLevel>0) do
             begin
             if TokenStr[0] = #0 then
               begin
@@ -1980,7 +2005,16 @@ begin
               TokenStart:=TokenStr;
               end
             else
+              begin
+              If (msNestedComment in CurrentModeSwitches) then
+                 begin
+                 if (TokenStr[0] = '(') and (TokenStr[1] = '*') then
+                   Inc(NestingLevel)
+                 else if (TokenStr[0] = '*') and (TokenStr[1] = ')') and not PPIsSkipping then
+                   Dec(NestingLevel);
+                 end;
               Inc(TokenStr);
+              end;
           end;
           SectionLength := TokenStr - TokenStart;
           SetLength(FCurTokenString, OldLength + SectionLength);
@@ -2006,7 +2040,7 @@ begin
           Inc(TokenStr);
           Result := tkPower;
           end 
-        else if (po_cassignments in options) then
+        else if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -2019,7 +2053,7 @@ begin
       begin
         Result:=tkPlus;
         Inc(TokenStr);
-        if (po_cassignments in options) then
+        if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -2037,7 +2071,7 @@ begin
       begin
         Result := tkMinus;
         Inc(TokenStr);
-        if (po_cassignments in options) then
+        if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -2073,7 +2107,7 @@ begin
             Move(TokenStart^, FCurTokenString[1], SectionLength);
           Result := tkComment;
           end
-        else if (po_cassignments in options) then
+        else if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -2289,7 +2323,7 @@ begin
   If (TokenStr<>Nil) then
     Result := TokenStr - PChar(CurLine)
   else
-    Result:=0;
+    Result := 0;
 end;
 
 procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
@@ -2330,8 +2364,12 @@ function TPascalScanner.FetchLine: boolean;
 begin
   if CurSourceFile.IsEOF then
   begin
-    FCurLine := '';
-    TokenStr := nil;
+    if TokenStr<>nil then
+      begin
+      FCurLine := '';
+      TokenStr := nil;
+      inc(FCurRow); // set CurRow to last line+1
+      end;
     Result := false;
   end else
   begin
@@ -2350,7 +2388,7 @@ begin
   FLastMsgType := MsgType;
   FLastMsgNumber := MsgNumber;
   FLastMsgPattern := Fmt;
-  FLastMsg := Format(Fmt,Args);
+  FLastMsg := SafeFormat(Fmt,Args);
   CreateMsgArgs(FLastMsgArgs,Args);
 end;
 

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -27,7 +27,7 @@ Type
 
   { TTestParser }
 
-  TTestParser= class(TTestCase)
+  TTestParser = class(TTestCase)
   Private
     FDeclarations: TPasDeclarations;
     FDefinition: TPasElement;
@@ -58,6 +58,7 @@ Type
     Procedure StartImplementation;
     Procedure EndSource;
     Procedure Add(Const ALine : String);
+    Procedure Add(Const Lines : array of String);
     Procedure StartParsing;
     Procedure ParseDeclarations;
     Procedure ParseModule;
@@ -630,6 +631,14 @@ begin
   FSource.Add(ALine);
 end;
 
+procedure TTestParser.Add(const Lines: array of String);
+var
+  i: Integer;
+begin
+  for i:=Low(Lines) to High(Lines) do
+    Add(Lines[i]);
+end;
+
 procedure TTestParser.StartParsing;
 
 var

packages/fcl-passrc/tests/tcclasstype.pas

@@ -5,7 +5,7 @@ unit tcclasstype;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pparser, pastree, testregistry, tctypeparser;
+  Classes, SysUtils, fpcunit, pscanner,pparser, pastree, testregistry, tctypeparser;
 
 type
 
@@ -30,6 +30,7 @@ type
     function GetT(AIndex : Integer) : TPasType;
   protected
     Procedure StartClass (AParent : String = 'TObject'; InterfaceList : String = '');
+    Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
     Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False);
     Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
@@ -91,6 +92,8 @@ type
     procedure TestHintFieldExperimental;
     procedure TestHintFieldLibraryError;
     procedure TestHintFieldUninmplemented;
+    Procedure TestOneVarFieldExternalName;
+    procedure TestOneVarFieldExternalNameSemicolon;
     Procedure TestMethodSimple;
     Procedure TestMethodSimpleComment;
     Procedure TestMethodWithDotFails;
@@ -141,6 +144,10 @@ type
     Procedure TestPropertyReadFromRecordField;
     procedure TestPropertyReadFromArrayField;
     procedure TestPropertyReadWriteFromRecordField;
+    Procedure TestExternalClass;
+    Procedure TestExternalClassNoNameSpace;
+    Procedure TestExternalClassNoNameKeyWord;
+    Procedure TestExternalClassNoName;
     Procedure TestLocalSimpleType;
     Procedure TestLocalSimpleTypes;
     Procedure TestLocalSimpleConst;
@@ -252,6 +259,21 @@ begin
   FParent:=AParent;
 end;
 
+procedure TTestClassType.StartExternalClass(AParent: String; AExternalName,
+  AExternalNameSpace: String);
+
+Var
+  S : String;
+
+begin
+  FStarted:=True;
+  S:=Format('TMyClass = Class external ''%s'' name ''%s'' ',[AExternalNameSpace,AExternalName]);
+  if (AParent<>'') then
+    S:=S+'('+AParent+')';
+  FDecl.Add(S);
+  FParent:=AParent;
+end;
+
 procedure TTestClassType.StartClassHelper(ForType: String; AParent: String);
 Var
   S : String;
@@ -762,6 +784,28 @@ begin
   AssertMemberName('unimplemented');
 end;
 
+procedure TTestClassType.TestOneVarFieldExternalName;
+begin
+  Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msExternalClass];
+  StartExternalClass('','myname','');
+  AddMember('unimplemented: integer external name ''uni''');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertNotNull('Have field',Field1);
+  AssertMemberName('unimplemented');
+end;
+
+procedure TTestClassType.TestOneVarFieldExternalNameSemicolon;
+begin
+  Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msExternalClass];
+  StartExternalClass('','myname','');
+  AddMember('unimplemented: integer; external name ''uni''');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertNotNull('Have field',Field1);
+  AssertMemberName('unimplemented');
+end;
+
 procedure TTestClassType.TestMethodSimple;
 begin
   AddMember('Procedure DoSomething');
@@ -1142,7 +1186,7 @@ end;
 procedure TTestClassType.TestPropertyRedeclareDefault;
 begin
   StartVisibility(visPublic);
-  AddMember('Property Something; default;');
+  AddMember('Property Something; default');
   ParseClass;
   AssertProperty(Property1,visPublic,'Something','','','','',0,True,False);
   AssertNull('No type',Property1.VarType);
@@ -1494,6 +1538,45 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
+procedure TTestClassType.TestExternalClass;
+begin
+  StartExternalClass('','myname','mynamespace');
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  ParseClass;
+  AssertTrue('External class ',TheClass.IsExternal);
+  AssertEquals('External name space','mynamespace',TheClass.ExternalNameSpace);
+  AssertEquals('External name ','myname',TheClass.ExternalName);
+end;
+
+procedure TTestClassType.TestExternalClassNoNameSpace;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external name ''me'' ');
+  ParseClass;
+  AssertTrue('External class ',TheClass.IsExternal);
+  AssertEquals('External name space','',TheClass.ExternalNameSpace);
+  AssertEquals('External name ','me',TheClass.ExternalName);
+end;
+
+procedure TTestClassType.TestExternalClassNoNameKeyWord;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external ''name'' ''me'' ');
+  AssertException('No name keyword raises error',EParserError,@ParseClass);
+
+end;
+
+procedure TTestClassType.TestExternalClassNoName;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external ''name'' name ');
+  AssertException('No name  raises error',EParserError,@ParseClass);
+
+end;
+
 procedure TTestClassType.TestLocalSimpleType;
 begin
   StartVisibility(visPublic);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -103,6 +103,7 @@ type
     Procedure TestFunctionCall;
     Procedure TestFunctionCall2args;
     Procedure TestFunctionCallNoArgs;
+    Procedure ParseStrWithFormatFullyQualified;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
@@ -1031,6 +1032,24 @@ begin
   AssertNotNull('Have left',AOperand);
 end;
 
+Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
+
+Var
+  P : TParamsExpr;
+  B : TBinaryExpr;
+
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','i');
+  ParseExpression('system.str(i:0:3,a)');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',theExpr,pekBinary,TBinaryExpr));
+  P:=TParamsExpr(AssertExpression('Simple identifier',B.Right,pekFuncParams,TParamsExpr));
+  AssertExpression('Name of function',P.Value,pekIdent,'str');
+  AssertEquals('2 argument',2,Length(p.params));
+  AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
+  AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
+end;
+
 initialization
 
   RegisterTest(TTestExpressions);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -0,0 +1,122 @@
+unit tcgenerics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, pastree, testregistry, pscanner, pparser, tctypeparser;
+
+Type
+
+  { TTestGenerics }
+
+  TTestGenerics = Class(TBaseTestTypeParser)
+  Published
+    Procedure TestObjectGenerics;
+    Procedure TestSpecializationDelphi;
+    Procedure TestDeclarationDelphi;
+    Procedure TestDeclarationDelphiSpecialize;
+    Procedure TestMethodImplementation;
+    Procedure TestInlineSpecializationInProcedure;
+  end;
+
+implementation
+
+procedure TTestGenerics.TestObjectGenerics;
+begin
+  Source.Add('Type');
+  Source.Add('Generic TSomeClass<T> = Object');
+  Source.Add('  b : T;');
+  Source.Add('end;');
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasClassType,'');
+end;
+
+procedure TTestGenerics.TestDeclarationDelphi;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
+  Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+procedure TTestGenerics.TestDeclarationDelphiSpecialize;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
+  Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertEquals('Name is correct','TSomeClass',T.Name);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+
+end;
+
+procedure TTestGenerics.TestMethodImplementation;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TTest<T> =  object');
+    Add('    procedure foo(v:T);');
+    Add('  end;');
+    Add('implementation');
+    Add('procedure TTest<T>.foo;');
+    Add('begin');
+    Add('end;');
+    end;
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestInlineSpecializationInProcedure;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TFoo=class');
+    Add('    procedure foo(var Node:TSomeGeneric<TBoundingBox>;const index:Integer);');
+    Add('  end;');
+    Add('implementation');
+    end;
+  ParseModule;
+end;
+
+initialization
+  RegisterTest(TTestGenerics);
+end.
+

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -130,6 +130,8 @@ type
     Procedure TestFunctionForwardInterface;
     Procedure TestProcedureForward;
     Procedure TestFunctionForward;
+    Procedure TestProcedureFar;
+    Procedure TestFunctionFar;
     Procedure TestProcedureCdeclForward;
     Procedure TestFunctionCDeclForward;
     Procedure TestProcedureCompilerProc;
@@ -943,6 +945,20 @@ begin
   AssertFunc([pmforward],ccDefault,0);
 end;
 
+procedure TTestProcedureFunction.TestProcedureFar;
+begin
+  AddDeclaration('procedure A; far;');
+  ParseProcedure;
+  AssertProc([pmfar],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionFar;
+begin
+  AddDeclaration('function A : integer; far;');
+  ParseFunction;
+  AssertFunc([pmfar],ccDefault,0);
+end;
+
 procedure TTestProcedureFunction.TestProcedureCdeclForward;
 begin
   UseImplementation:=True;

packages/fcl-passrc/tests/tcscanner.pas

@@ -81,6 +81,7 @@ type
     procedure TestNestedComment2;
     procedure TestNestedComment3;
     procedure TestNestedComment4;
+    procedure TestNestedComment5;
     procedure TestIdentifier;
     procedure TestSelf;
     procedure TestSelfNoToken;
@@ -542,6 +543,11 @@ begin
   TestToken(tkComment,'{ (* comment *) }');
 end;
 
+procedure TTestScanner.TestNestedComment5;
+begin
+  TestToken(tkComment,'(* (* comment *) *)');
+end;
+
 
 procedure TTestScanner.TestIdentifier;
 

packages/fcl-passrc/tests/tcstatements.pas

@@ -110,8 +110,9 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
-    procedure TestTryExceptRaise;
+    procedure  TestTryExceptRaise;
     Procedure TestAsm;
+    Procedure TestGotoInIfThen;
   end;
 
 implementation
@@ -401,11 +402,11 @@ begin
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as TBinaryExpr;
-  AssertExpression('Unit name part 1',B.Left,pekIdent,'Unita');
-  AssertExpression('Second part of unit name',B.Right,pekBinary,TBinaryExpr);
-  B:=B.Right as TBinaryExpr;
-  AssertExpression('Unit name part 2',B.Left,pekIdent,'ClassB');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
+  AssertExpression('First two parts of unit name',B.left,pekBinary,TBinaryExpr);
+  B:=B.left as TBinaryExpr;
+  AssertExpression('Unit name part 1',B.Left,pekIdent,'Unita');
+  AssertExpression('Unit name part 2',B.right,pekIdent,'ClassB');
 end;
 
 procedure TTestStatementParser.TestCallNoArgs;
@@ -1646,6 +1647,21 @@ begin
   AssertEquals('token 4 ','1',T.Tokens[3]);
 end;
 
+Procedure TTestStatementParser.TestGotoInIfThen;
+
+begin
+  AddStatements(['if expr then',
+  '  dosomething',
+  '   else if expr2 then',
+  '    goto try_qword',
+  '  else',
+  '    dosomething;',
+  '  try_qword:',
+  '  dosomething;',
+  'end.']);
+  ParseModule;
+end;
+
 initialization
   RegisterTests([TTestStatementParser]);
 

packages/fcl-passrc/tests/tctypeparser.pas

@@ -161,7 +161,6 @@ type
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
-    Procedure TestSpecializationDelphi;
   end;
 
   { TTestRecordTypeParser }
@@ -3306,10 +3305,6 @@ begin
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 
-procedure TTestTypeParser.TestSpecializationDelphi;
-begin
-  ParseType('TFPGList<integer>',TPasClassType,'');
-end;
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -0,0 +1,1409 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestResolver.TestEmpty
+}
+unit tcuseanalyzer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit,
+  PasTree, PScanner, PasResolver,
+  tcbaseparser, testregistry, strutils, tcresolver, PasUseAnalyzer;
+
+type
+
+  { TCustomTestUseAnalyzer }
+
+  TCustomTestUseAnalyzer = Class(TCustomTestResolver)
+  private
+    FAnalyzer: TPasAnalyzer;
+    FPAMessages: TFPList; // list of TPAMessage
+    function GetPAMessages(Index: integer): TPAMessage;
+    procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure AnalyzeModule; virtual;
+    procedure AnalyzeProgram; virtual;
+    procedure AnalyzeUnit; virtual;
+    procedure AnalyzeWholeProgram; virtual;
+    procedure CheckUsedMarkers; virtual;
+    procedure CheckHasHint(MsgType: TMessageType; MsgNumber: integer;
+      const MsgText: string; Has: boolean = true); virtual;
+    procedure CheckUnitUsed(const aFilename: string; Used: boolean);
+  public
+    property Analyzer: TPasAnalyzer read FAnalyzer;
+    function PAMessageCount: integer;
+    property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
+  end;
+
+  { TTestUseAnalyzer }
+
+  TTestUseAnalyzer = Class(TCustomTestUseAnalyzer)
+  published
+    // single module
+    procedure TestM_ProgramLocalVar;
+    procedure TestM_AssignStatement;
+    procedure TestM_BeginBlock;
+    procedure TestM_ForLoopStatement;
+    procedure TestM_AsmStatement;
+    procedure TestM_CaseOfStatement;
+    procedure TestM_IfThenElseStatement;
+    procedure TestM_WhileDoStatement;
+    procedure TestM_RepeatUntilStatement;
+    procedure TestM_TryFinallyStatement;
+    procedure TestM_TypeAlias;
+    procedure TestM_Unary;
+    procedure TestM_Const;
+    procedure TestM_Record;
+    procedure TestM_Array;
+    procedure TestM_NestedFuncResult;
+    procedure TestM_Enums;
+    procedure TestM_ProcedureType;
+    procedure TestM_Params;
+    procedure TestM_Class;
+    procedure TestM_ClassForward;
+    procedure TestM_Class_Property;
+    procedure TestM_Class_PropertyOverride;
+    procedure TestM_Class_MethodOverride;
+    procedure TestM_Class_MethodOverride2;
+    procedure TestM_TryExceptStatement;
+
+    // single module hints
+    procedure TestM_Hint_UnitNotUsed;
+    procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
+    procedure TestM_Hint_ParameterNotUsed;
+    procedure TestM_Hint_ParameterNotUsed_Abstract;
+    procedure TestM_Hint_LocalVariableNotUsed;
+    procedure TestM_Hint_InterfaceUnitVariableUsed;
+    procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
+    procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
+    procedure TestM_Hint_LocalXYNotUsed;
+    procedure TestM_Hint_PrivateFieldIsNeverUsed;
+    procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
+    procedure TestM_Hint_PrivateMethodIsNeverUsed;
+    procedure TestM_Hint_PrivateTypeNeverUsed;
+    procedure TestM_Hint_PrivateConstNeverUsed;
+    procedure TestM_Hint_PrivatePropertyNeverUsed;
+    procedure TestM_Hint_LocalClassInProgramNotUsed;
+    procedure TestM_Hint_LocalMethodInProgramNotUsed;
+    procedure TestM_Hint_AssemblerParameterIgnored;
+    procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
+    procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
+    procedure TestM_Hint_FunctionResultRecord;
+    procedure TestM_Hint_FunctionResultPassRecordElement;
+    procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
+
+    // whole program optimization
+    procedure TestWP_LocalVar;
+    procedure TestWP_UnitUsed;
+    procedure TestWP_UnitNotUsed;
+    procedure TestWP_UnitInitialization;
+    procedure TestWP_UnitFinalization;
+    procedure TestWP_CallInherited;
+    procedure TestWP_ProgramPublicDeclarations;
+    procedure TestWP_ClassDefaultProperty;
+  end;
+
+implementation
+
+{ TCustomTestUseAnalyzer }
+
+procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
+  Msg: TPAMessage);
+begin
+  Msg.AddRef;
+  FPAMessages.Add(Msg);
+end;
+
+function TCustomTestUseAnalyzer.GetPAMessages(Index: integer): TPAMessage;
+begin
+  Result:=TPAMessage(FPAMessages[Index]);
+end;
+
+procedure TCustomTestUseAnalyzer.SetUp;
+begin
+  inherited SetUp;
+  FPAMessages:=TFPList.Create;
+  FAnalyzer:=TPasAnalyzer.Create;
+  FAnalyzer.Resolver:=ResolverEngine;
+  Analyzer.OnMessage:=@OnAnalyzerMessage;
+end;
+
+procedure TCustomTestUseAnalyzer.TearDown;
+var
+  i: Integer;
+begin
+  for i:=0 to FPAMessages.Count-1 do
+    TPAMessage(FPAMessages[i]).Release;
+  FreeAndNil(FPAMessages);
+  FreeAndNil(FAnalyzer);
+  inherited TearDown;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeModule;
+begin
+  Analyzer.AnalyzeModule(Module);
+  Analyzer.EmitModuleHints(Module);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeProgram;
+begin
+  ParseProgram;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeUnit;
+begin
+  ParseUnit;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeWholeProgram;
+begin
+  ParseProgram;
+  Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUsedMarkers;
+var
+  aMarker: PSrcMarker;
+  p: SizeInt;
+  Postfix: String;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  ExpectedUsed: Boolean;
+  FoundEl: TPAElement;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
+    p:=RPos('_',aMarker^.Identifier);
+    if p>1 then
+      begin
+      Postfix:=copy(aMarker^.Identifier,p+1);
+
+      if Postfix='used' then
+        ExpectedUsed:=true
+      else if Postfix='notused' then
+        ExpectedUsed:=false
+      else
+        RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        FoundEl:=nil;
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          FoundEl:=Analyzer.FindElement(El);
+          if FoundEl<>nil then break;
+          end;
+        if FoundEl<>nil then
+          begin
+          if not ExpectedUsed then
+            RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
+          end
+        else
+          begin
+          if ExpectedUsed then
+            RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
+          end;
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+
+end;
+
+procedure TCustomTestUseAnalyzer.CheckHasHint(MsgType: TMessageType;
+  MsgNumber: integer; const MsgText: string; Has: boolean);
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: string;
+begin
+  i:=PAMessageCount-1;
+  while i>=0 do
+    begin
+    Msg:=PAMessages[i];
+    if (Msg.MsgNumber=MsgNumber) then
+      begin
+      if Has then
+        begin
+        // must have -> message type and text must match exactly
+        if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
+          exit;
+        end
+      else
+        begin
+        // must not have -> matching number is enough
+        break;
+        end;
+      end;
+    dec(i);
+    end;
+  if (not Has) and (i<0) then exit;
+
+  // mismatch
+  writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    writeln('  ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
+    end;
+  s:='';
+  str(MsgType,s);
+  Fail('Analyzer Message '+BoolToStr(Has,'not ','')+'found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
+  Used: boolean);
+var
+  aResolver: TTestEnginePasResolver;
+  PAEl: TPAElement;
+begin
+  aResolver:=FindModuleWithFilename(aFilename);
+  AssertNotNull('unit not found "'+aFilename+'"',aResolver);
+  AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
+  PAEl:=Analyzer.FindElement(aResolver.Module);
+  if PAEl<>nil then
+    begin
+    // unit is used
+    if not Used then
+      Fail('expected unit "'+aFilename+'" not used, but it is used');
+    end
+  else
+    begin
+    // unit is not used
+    if Used then
+      Fail('expected unit "'+aFilename+'" used, but it is not used');
+    end;
+end;
+
+function TCustomTestUseAnalyzer.PAMessageCount: integer;
+begin
+  Result:=FPAMessages.Count;
+end;
+
+{ TTestUseAnalyzer }
+
+procedure TTestUseAnalyzer.TestM_ProgramLocalVar;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var {#l_notused}l: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_AssignStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_notused}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('begin');
+  Add('  b:=c;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_BeginBlock;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('begin');
+  Add('  begin');
+  Add('  a:=1;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ForLoopStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  for a:=b to c do d:=a;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_AsmStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('begin');
+  Add('  asm end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_CaseOfStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('const');
+  Add('  {#a_used}a = 1;');
+  Add('  {#b_used}b = 2;');
+  Add('var');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  case a of');
+  Add('    b: c:=1;');
+  Add('  else');
+  Add('    d:=2;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_IfThenElseStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('begin');
+  Add('  if a=0 then b:=1 else c:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_WhileDoStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  while a>0 do b:=1;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_RepeatUntilStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  repeat a:=1; until b>1;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TryFinallyStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    a:=1;');
+  Add('  finally');
+  Add('    b:=2;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TypeAlias;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('var');
+  Add('  {#a_used}a: integer;');
+  Add('  {#b_used}b: integer;');
+  Add('  {#c_notused}c: integer;');
+  Add('begin');
+  Add('  a:=b;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Unary;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  a:=+b;');
+  Add('  a:=c+d;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Const;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: boolean;');
+  Add('  {#c_used}c: array of longint;');
+  Add('  {#d_used}d: string;');
+  Add('begin');
+  Add('  a:=+1;');
+  Add('  b:=true;');
+  Add('  c:=nil;');
+  Add('  d:=''foo'';');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Record;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#trec_used}TRec = record');
+  Add('    {#a_used}a: integer;');
+  Add('    {#b_notused}b: integer;');
+  Add('    {#c_used}c: integer;');
+  Add('  end;');
+  Add('var');
+  Add('  {#r_used}r: TRec;');
+  Add('begin');
+  Add('  r.a:=3;');
+  Add('  with r do c:=4;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Array;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#tarrayint_used}TArrayInt = array of integer;');
+  Add('var');
+  Add('  {#a_used}a: TArrayInt;');
+  Add('  {#b_used}b: integer;');
+  Add('  {#c_used}c: TArrayInt;');
+  Add('  {#d_used}d: integer;');
+  Add('  {#e_used}e: TArrayInt;');
+  Add('  {#f_used}f: integer;');
+  Add('  {#g_used}g: TArrayInt;');
+  Add('  {#h_used}h: TArrayInt;');
+  Add('  {#i_used}i: TArrayInt;');
+  Add('begin');
+  Add('  a[b]:=c[d];');
+  Add('  SetLength(e,f)');
+  Add('  if low(g)=high(h)+length(i) then');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_NestedFuncResult;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#tarrayint_used}TArrayInt = array of integer;');
+  Add('  function {#nestedfunc_used}NestedFunc({#b_notused}b: longint): TArrayInt;');
+  Add('  begin');
+  Add('  end;');
+  Add('var');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  NestedFunc(d);');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Enums;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt(const o);');
+  Add('type');
+  Add('  {#TEnum_used}TEnum = (red,blue);');
+  Add('  {#TEnums_used}TEnums = set of TEnum;');
+  Add('var');
+  Add('  {#a_used}a: TEnum;');
+  Add('  {#b_used}b: TEnums;');
+  Add('  {#c_used}c: TEnum;');
+  Add('  {#d_used}d: TEnums;');
+  Add('  {#e_used}e: TEnums;');
+  Add('  {#f_used}f: TEnums;');
+  Add('  {#g_used}g: TEnum;');
+  Add('  {#h_used}h: TEnum;');
+  Add('begin');
+  Add('  b:=[a];');
+  Add('  if c in d then;');
+  Add('  if low(e)=high(f) then;');
+  Add('  if pred(g)=succ(h) then;');
+  Add('end;');
+  Add('var {#s_used}s: string;');
+  Add('begin');
+  Add('  DoIt(s);');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ProcedureType;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#TProc_used}TProc = procedure;');
+  Add('  {#TFunc_used}TFunc = function(): longint;');
+  Add('var');
+  Add('  {#p_used}p: TProc;');
+  Add('  {#f_used}f: TFunc;');
+  Add('begin');
+  Add('  p:=nil;');
+  Add('  f:=nil;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Params;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt(const o);');
+  Add('type');
+  Add('  {#TEnum_used}TEnum = (red,blue);');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: string;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: TEnum;');
+  Add('begin');
+  Add('  DoIt(a);');
+  Add('  DoIt(b[c]);');
+  Add('  DoIt([d]);');
+  Add('  DoIt(red);');
+  Add('end;');
+  Add('var {#s_used}s: string;');
+  Add('begin');
+  Add('  DoIt(s);');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#a_used}a: integer;');
+  Add('  end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.a:=3;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ClassForward;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_notused}integer = longint;');
+  Add('  {#TObject_used}TObject = class end;');
+  Add('  TFelidae = class;');
+  Add('  {#TCheetah_used}TCheetah = class');
+  Add('  public');
+  Add('    {#i_notused}i: integer;');
+  Add('    {#f_used}f: TFelidae;');
+  Add('  end;');
+  Add('  {TFelidae_used}TFelidae = class');
+  Add('  end;');
+  Add('var {#c_used}c: TCheetah;');
+  Add('begin');
+  Add('  c.f:=nil;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#fa_used}Fa: integer;');
+  Add('    {#fb_used}Fb: integer;');
+  Add('    {#fc_used}Fc: integer;');
+  Add('    {#fd_used}Fd: integer;');
+  Add('    {#fe_notused}Fe: integer;');
+  Add('    function {#getfc_used}GetFC: integer;');
+  Add('    procedure {#setfd_used}SetFD({#setfd_value_used}Value: integer);');
+  Add('    property {#A_used}A: integer read Fa write Fb;');
+  Add('    property {#C_used}C: integer read GetFC write SetFD;');
+  Add('  end;');
+  Add('function TObject.GetFC: integer;');
+  Add('begin');
+  Add('  Result:=Fc;');
+  Add('end;');
+  Add('procedure TObject.SetFD({#setfd_value_impl_notused}Value: integer);');
+  Add('begin');
+  Add('  Fd:=Value;');
+  Add('end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.A:=Obj.A;');
+  Add('  Obj.C:=Obj.C;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_PropertyOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#fa_used}FA: integer;');
+  Add('    {#fb_notused}FB: integer;');
+  Add('    property {#obj_a_notused}A: integer read FA write FB;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    {#fc_used}FC: integer;');
+  Add('    property {#mob_a_used}A write FC;');
+  Add('  end;');
+  Add('var {#m_used}M: TMobile;');
+  Add('begin');
+  Add('  M.A:=M.A;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_MethodOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    procedure {#obj_doa_used}DoA; virtual; abstract;');
+  Add('    procedure {#obj_dob_notused}DoB; virtual; abstract;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    constructor {#mob_create_used}Create;');
+  Add('    procedure {#mob_doa_used}DoA; override;');
+  Add('    procedure {#mob_dob_notused}DoB; override;');
+  Add('  end;');
+  Add('constructor TMobile.Create; begin end;');
+  Add('procedure TMobile.DoA; begin end;');
+  Add('procedure TMobile.DoB; begin end;');
+  Add('var {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=TMobile.Create;'); // use TMobile before o.DoA
+  Add('  o.DoA;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_MethodOverride2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    procedure {#obj_doa_used}DoA; virtual; abstract;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    constructor {#mob_create_used}Create;');
+  Add('    procedure {#mob_doa_used}DoA; override;');
+  Add('  end;');
+  Add('constructor TMobile.Create; begin end;');
+  Add('procedure TMobile.DoA; begin end;');
+  Add('var {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o:=TMobile.Create;'); // use TMobile after o.DoA
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TryExceptStatement;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    constructor Create; external name ''create'';');
+  Add('  end;');
+  Add('  {texception_used}Exception = class(TObject);');
+  Add('  {tdivbyzero_used}EDivByZero = class(Exception);');
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: Exception;');
+  Add('  {#b_used}b: Exception;');
+  Add('  {#c_used}c: Exception;');
+  Add('  {#d_used}d: Exception;');
+  Add('  {#f_used}f: Exception;');
+  Add('begin');
+  Add('  try');
+  Add('    a:=nil;');
+  Add('  except');
+  Add('    raise b;');
+  Add('  end;');
+  Add('  try');
+  Add('    if Assigned(c) then ;');
+  Add('  except');
+  Add('    on {#e1_used}E1: Exception do raise;');
+  Add('    on {#e2_notused}E2: EDivByZero do raise d;');
+  Add('    else f:=nil;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var State: longint; external name ''state'';',
+    'procedure DoIt; external name ''doing'';',
+    '']),
+    LinesToStr([
+    ]));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  State:=3;');
+  Add('  DoIt;');
+  AnalyzeProgram;
+
+  // unit hints: no hint, even though no code is actually used
+  CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile',false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint);');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure DoIt(i: longint); virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  Add('  TObject.DoIt(3);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAParameterNotUsed,
+    sPAParameterNotUsed,false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('const');
+  Add('  a = 13;');
+  Add('  b: longint = 14;');
+  Add('var');
+  Add('  c: char;');
+  Add('  d: longint = 15;');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
+begin
+  StartUnit(true);
+  Add('interface');
+  Add('const {#a_used}a = 1;');
+  Add('const {#b_used}b: longint = 2;');
+  Add('var {#c_used}c: longint = 3;');
+  Add('type');
+  Add('  {#TColor_used}TColor = longint;');
+  Add('  {#TFlag_used}TFlag = (red,green);');
+  Add('  {#TFlags_used}TFlags = set of TFlag;');
+  Add('  {#TArrInt_used}TArrInt = array of integer;');
+  Add('implementation');
+  Add('const {#d_notused}d = 1;');
+  Add('const {#e_notused}e: longint = 2;');
+  Add('var {#f_notused}f: longint = 3;');
+  Add('type');
+  Add('  {#ImpTColor_notused}ImpTColor = longint;');
+  Add('  {#ImpTFlag_notused}ImpTFlag = (red,green);');
+  Add('  {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
+  Add('  {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
+  AnalyzeUnit;
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "a" is assigned but never used',false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint);');
+  Add('begin');
+  Add('  i:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
+    'Value parameter "i" is assigned but never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('const');
+  Add('  a: longint = 14;');
+  Add('var');
+  Add('  b: char;');
+  Add('  c: longint = 15;');
+  Add('begin');
+  Add('  a:=16;');
+  Add('  b:=#65;');
+  Add('  c:=17;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "a" is assigned but never used');
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "b" is assigned but never used');
+  CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "c" is assigned but never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('type');
+  Add('  TColor = longint;');
+  Add('  TFlag = (red,green);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TArrInt = array of integer;');
+  Add('  procedure Sub; begin end;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    a: longint;');
+  Add('  end;');
+  Add('var m: TMobile;');
+  Add('begin');
+  Add('  m:=nil;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,'Private field "TMobile.a" is never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    a: longint;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('  a:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
+    'Private field "TMobile.a" is assigned but never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    procedure DoSome; external name ''foo'';');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivateMethodIsNeverUsed,
+    'Private method "TMobile.DoSome" is never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    type t = longint;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivateTypeXNeverUsed,
+    'Private type "TMobile.t" never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    const c = 3;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivateConstXNeverUsed,
+    'Private const "TMobile.c" never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    FA: longint;');
+  Add('    property A: longint read FA;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAPrivatePropertyXNeverUsed,
+    'Private property "TMobile.A" never used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  m: TMobile;');
+  Add('begin');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
+  CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  m: TMobile;');
+  Add('begin');
+  Add('  if m=nil then ;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint); assembler;');
+  Add('type');
+  Add('  {#tcolor_notused}TColor = longint;');
+  Add('  {#tflag_notused}TFlag = (red,green);');
+  Add('  {#tflags_notused}TFlags = set of TFlag;');
+  Add('  {#tarrint_notused}TArrInt = array of integer;');
+  Add('const');
+  Add('  {#a_notused}a = 13;');
+  Add('  {#b_notused}b: longint = 14;');
+  Add('var');
+  Add('  {#c_notused}c: char;');
+  Add('  {#d_notused}d: longint = 15;');
+  Add('  procedure {#sub_notused}Sub; begin end;');
+  Add('asm end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used',false);
+  AssertEquals('no hints for assembler proc',0,PAMessageCount);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
+begin
+  StartProgram(true);
+  Add('function DoIt: longint;');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt();');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+    sPAFunctionResultDoesNotSeemToBeSet);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class function DoIt: longint; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  Add('  TObject.DoIt;');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+    sPAFunctionResultDoesNotSeemToBeSet,false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TPoint = record X,Y:longint; end;');
+  Add('function Point(Left,Top: longint): TPoint;');
+  Add('begin');
+  Add('  Result.X:=Left;');
+  Add('end;');
+  Add('begin');
+  Add('  Point(1,2);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+    sPAFunctionResultDoesNotSeemToBeSet,false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TPoint = record X,Y:longint; end;');
+  Add('procedure Three(out x: longint);');
+  Add('begin');
+  Add('  x:=3;');
+  Add('end;');
+  Add('function Point(Left,Top: longint): TPoint;');
+  Add('begin');
+  Add('  Three(Result.X)');
+  Add('end;');
+  Add('begin');
+  Add('  Point(1,2);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+    sPAFunctionResultDoesNotSeemToBeSet,false);
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(out x: longint);');
+  Add('begin');
+  Add('  x:=3;');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  DoIt(i);');
+  AnalyzeProgram;
+  CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
+    sPAValueParameterIsAssignedButNeverUsed,false);
+end;
+
+procedure TTestUseAnalyzer.TestWP_LocalVar;
+begin
+  StartProgram(false);
+  Add('var {#a_notused}a: longint;');
+  Add('var {#b_used}b: longint;');
+  Add('var {#c_used}c: longint;');
+  Add('begin');
+  Add('  b:=2;');
+  Add('  afile.c:=3;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  i:=3;');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitNotUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit2.pp',false);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitInitialization;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    '']),
+    LinesToStr([
+    'initialization',
+    'i:=2;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit1.pp',true);
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitFinalization;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    '']),
+    LinesToStr([
+    'finalization',
+    'i:=2;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit1.pp',true);
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_CallInherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TObject_used}TObject = class');
+  Add('    procedure {#TObjectDoA_used}DoA;');
+  Add('    procedure {#TObjectDoB_used}DoB;');
+  Add('  end;');
+  Add('  {#TMobile_used}TMobile = class');
+  Add('    procedure {#TMobileDoA_used}DoA;');
+  Add('    procedure {#TMobileDoC_used}DoC;');
+  Add('  end;');
+  Add('procedure TObject.DoA; begin end;');
+  Add('procedure TObject.DoB; begin end;');
+  Add('procedure TMobile.DoA;');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('procedure TMobile.DoC;');
+  Add('begin');
+  Add('  inherited DoB;');
+  Add('end;');
+  Add('var o: TMobile;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o.DoC;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#vPublic_used}vPublic: longint; public;');
+  Add('  {#vPrivate_notused}vPrivate: longint;');
+  Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
+  Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
+  Add('begin');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('    function {#getitems_notused}Getitems(Index: longint): string;');
+  Add('    procedure {#setitems_used}Setitems(Index: longint; Value: String);');
+  Add('    property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('function TObject.Getitems(Index: longint): string; begin end;');
+  Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
+  Add('var');
+  Add('  {#l_used}L: TObject;');
+  Add('begin');
+  Add('  L[0]:=''birdy'';');
+  AnalyzeWholeProgram;
+end;
+
+initialization
+  RegisterTests([TTestUseAnalyzer]);
+
+end.
+

packages/fcl-passrc/tests/tcvarparser.pas

@@ -44,6 +44,7 @@ Type
     Procedure TestVarExternal;
     Procedure TestVarExternalLib;
     Procedure TestVarExternalLibName;
+    procedure TestVarExternalNoSemiColon;
     Procedure TestVarCVar;
     Procedure TestVarCVarExternal;
     Procedure TestVarPublic;
@@ -269,6 +270,12 @@ begin
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
 end;
 
+procedure TTestVarParser.TestVarExternalNoSemiColon;
+begin
+  ParseVar('integer external','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+end;
+
 procedure TTestVarParser.TestVarExternalLib;
 begin
   ParseVar('integer; external name ''mylib''','');

packages/fcl-passrc/tests/testpassrc.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
@@ -16,9 +16,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -30,7 +27,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestStatementParser.TestCaseElseNoSemicolon"/>
+        <CommandLineParams Value="--suite=TTestGenerics.TestInlineSpecializationInProcedure"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -38,7 +35,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="13">
+    <Units Count="15">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -91,6 +88,14 @@
         <Filename Value="tcresolver.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit12>
+      <Unit13>
+        <Filename Value="tcgenerics.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="tcuseanalyzer.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit14>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -102,6 +107,20 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="../src"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-passrc/tests/testpassrc.lpr

@@ -5,7 +5,8 @@ program testpassrc;
 uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver;
+  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver, tcgenerics,
+  tcuseanalyzer;
 
 type
 

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

@@ -50,13 +50,20 @@ Type
 
   TFPWebActions = Class(TCustomWebActions)
   private
-    FCurrentAction : TCustomWebAction;
+    FCurrentAction : TFPWebAction;
+    function GetFPWebActions(Index : Integer): TFPWebAction;
+    procedure SetFPWebActions(Index : Integer; const AValue: TFPWebAction);
   protected
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean); virtual;
     Procedure GetContent(ARequest : TRequest; Content : TStream; Var Handled : Boolean); virtual;
+    Function  GetRequestAction(ARequest: TRequest) : TFPWebAction;
   Public
+    Function Add : TFPWebAction;
+    Function ActionByName(const AName : String) : TFPWebAction;
+    Function FindAction(const AName : String): TFPWebAction;
+    Property FPWebActions[Index : Integer] : TFPWebAction Read GetFPWebActions Write SetFPWebActions; Default;
     Property ActionVar;
-    Property CurrentAction: TCustomWebAction read FCurrentAction;
+    Property CurrentAction: TFPWebAction read FCurrentAction;
   end;
 
   { TTemplateVar }
@@ -553,10 +560,40 @@ end;
 
 { TFPWebActions }
 
+Function TFPWebActions.GetRequestAction(ARequest: TRequest) : TFPWebAction;
+begin
+  Result := inherited GetRequestAction(ARequest) as TFPWebAction;
+end;
+
+Function TFPWebActions.Add : TFPWebAction;
+begin
+  Result := inherited Add as TFPWebAction;
+end;
+
+Function TFPWebActions.ActionByName(const AName : String) : TFPWebAction;
+begin
+  Result := inherited ActionByName(AName) as TFPWebAction;
+end;
+
+Function TFPWebActions.FindAction(const AName : String): TFPWebAction;
+begin
+  Result := inherited FindAction(AName) as TFPWebAction;
+end;
+
+function TFPWebActions.GetFPWebActions(Index : Integer): TFPWebAction;
+begin
+  Result := Actions[Index] as TFPWebAction;
+end;
+
+procedure TFPWebActions.SetFPWebActions(Index : Integer; const AValue: TFPWebAction);
+begin
+  Actions[Index] := AValue;
+end;
+
 procedure TFPWebActions.HandleRequest(ARequest: TRequest; AResponse: TResponse; Var Handled : Boolean);
 
 Var
-  A : TCustomWebAction;
+  A : TFPWebAction;
 
 begin
 {$ifdef cgidebug}SendMethodEnter('FPWebActions.handlerequest');{$endif cgidebug}

packages/pastojs/fpmake.pp

@@ -19,7 +19,7 @@ begin
 {$endif ALLPACKAGES}
 
     P.Version:='3.0.3';
-    P.OSes := AllOses;
+    P.OSes := AllOses-[embedded,msdos,win16];
     P.Dependencies.Add('fcl-js');
     P.Dependencies.Add('fcl-passrc');
 

packages/pastojs/tests/tcconverter.pp

@@ -187,8 +187,8 @@ begin
   R:=TPasImplIfElse.Create('',Nil);
   R.ConditionExpr:=CreateCondition;
   E:=TJSIfStatement(Convert(R,TJSIfStatement));
-  AssertEquals('If branch is empty block statement',TJSEmptyBlockStatement,E.btrue.ClassType);
-  AssertNull('No else branch',E.bfalse);
+  AssertNull('If branch is empty',E.BTrue);
+  AssertNull('No else branch',E.BFalse);
   AssertIdentifier('Left hand side OK',E.Cond,'a');
 end;
 
@@ -388,7 +388,7 @@ begin
   //   for(i=1; i<=$loopend1; i++){ a:=b; }
 
   // "var $loopend1=100"
-  LoopEndVar:=DefaultVarNameLoopEnd+'1';
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
   VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
@@ -442,7 +442,7 @@ begin
   //   for(i=100; i>=$loopend1; i--){ a:=b; }
 
   // "var $loopend1=1"
-  LoopEndVar:=DefaultVarNameLoopEnd+'1';
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
   VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
@@ -646,6 +646,7 @@ Var
   ExObj: TJSElement;
   VS: TJSVariableStatement;
   V: TJSVarDeclaration;
+  ExceptObjName: String;
 
 begin
   // Try a:=B except on E : exception do  b:=c end;
@@ -668,7 +669,8 @@ begin
   // Convert
   El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
   // check "catch(exceptobject)"
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
   // check "if"
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
   // check if condition "exception.isPrototypeOf(exceptobject)"
@@ -679,14 +681,14 @@ begin
   AssertNotNull('args of exception.isPrototypeOf(exceptobject)',IC.Args);
   AssertEquals('args of exception.isPrototypeOf(exceptobject)',1,IC.Args.Elements.Count);
   ExObj:=IC.Args.Elements.Elements[0].Expr;
-  Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,lowercase(DefaultJSExceptionObject));
+  Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,ExceptObjName);
   // check statement "var e = exceptobject;"
   L:=AssertListStatement('On block is always a list',I.BTrue);
   writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
   VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
   V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject));
+  Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
   // check "b = c;"
   AssertAssignStatement('Original assignment in second statement',L.B,'b','c');
 end;
@@ -705,6 +707,7 @@ Var
   D: TJSDotMemberExpression;
   ExObj: TJSElement;
   VS: TJSVariableStatement;
+  ExceptObjName: String;
 
 begin
   // Try a:=B except on E : exception do raise; end;
@@ -712,10 +715,10 @@ begin
     Becomes:
     try {
      a=b;
-    } catch (exceptobject) {
-      if (exception.isPrototypeOf(exceptobject)) {
-        var e = exceptobject;
-        throw exceptobject;
+    } catch ($e) {
+      if (exception.isPrototypeOf($e)) {
+        var e = $e;
+        throw $e;
       }
     }
   *)
@@ -727,7 +730,8 @@ begin
   // Convert
   El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
   // check "catch(exceptobject)"
-  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
   // check "if"
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
   // check if condition "exception.isPrototypeOf(exceptobject)"
@@ -738,16 +742,16 @@ begin
   AssertNotNull('args of exception.isPrototypeOf(ExceptObject)',IC.Args);
   AssertEquals('args of exception.isPrototypeOf(ExceptObject)',1,IC.Args.Elements.Count);
   ExObj:=IC.Args.Elements.Elements[0].Expr;
-  Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,lowercase(DefaultJSExceptionObject));
+  Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,ExceptObjName);
   // check statement "var e = exceptobject;"
   L:=AssertListStatement('On block is always a list',I.BTrue);
   writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
   VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
   V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject));
+  Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
   R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B));
-  Assertidentifier('R expression is original exception ',R.A,lowercase(DefaultJSExceptionObject));
+  Assertidentifier('R expression is original exception ',R.A,ExceptObjName);
 end;
 
 Procedure TTestStatementConverter.TestVariableStatement;

packages/pastojs/tests/tcoptimizations.pas

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

packages/pastojs/tests/testpas2js.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -12,9 +12,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -34,7 +31,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="5">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -47,14 +44,41 @@
         <Filename Value="../src/fppas2js.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="tcmodules.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tcoptimizations.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
+    <Target>
+      <Filename Value="testpas2js"/>
+    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src"/>
+      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-passrc/src;../../pastojs/tests"/>
+      <UnitOutputDirectory Value="lib"/>
     </SearchPaths>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-dVerbosePas2JS"/>
+      <OtherDefines Count="1">
+        <Define0 Value="VerbosePas2JS"/>
+      </OtherDefines>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/pastojs/tests/testpas2js.pp

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

utils/pas2js/dist/rtl.js

@@ -1,4 +1,4 @@
-/*
+/*
     This file is part of the Free Pascal pas2js tool.
     Copyright (c) 2017 Mattias Gaertner
 
@@ -17,7 +17,7 @@ var pas = {};
 var rtl = {
 
   quiet: false,
-  debug_load_units: true,
+  debug_load_units: false,
 
   m_loading: 0,
   m_loading_intf: 1,
@@ -27,7 +27,7 @@ var rtl = {
   m_initialized: 5,
 
   debug: function(){
-    if (!window.console || rtl.quiet) return;
+    if (rtl.quiet || !console || !console.log) return;
     console.log(arguments);
   },