--- Merging r35883 into '.':

U    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35883 into '.':
 U   .
--- Merging r35884 into '.':
U    packages/fcl-passrc/src/pparser.pp
U    packages/fcl-passrc/tests/tcvarparser.pas
--- Recording mergeinfo for merge of r35884 into '.':
 G   .
--- Merging r35887 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35887 into '.':
 G   .
--- Merging r35888 into '.':
U    packages/pastojs/src/fppas2js.pp
U    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35888 into '.':
 G   .
--- Merging r35889 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35889 into '.':
 G   .
--- Merging r35895 into '.':
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35895 into '.':
 G   .
--- Merging r35896 into '.':
U    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35896 into '.':
 G   .
--- Merging r35897 into '.':
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35897 into '.':
 G   .
--- Merging r35898 into '.':
U    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35898 into '.':
 G   .
--- Merging r35902 into '.':
U    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/tests/tcresolver.pas
U    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35902 into '.':
 G   .
--- Merging r35903 into '.':
G    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/tests/tcconverter.pp
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35903 into '.':
 G   .
--- Merging r35904 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35904 into '.':
 G   .
--- Merging r35905 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35905 into '.':
 G   .
--- Merging r35908 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35908 into '.':
 G   .
--- Merging r35909 into '.':
G    packages/fcl-passrc/tests/tcuseanalyzer.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35909 into '.':
 G   .
--- Merging r35910 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35910 into '.':
 G   .
--- Merging r35911 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35911 into '.':
 G   .
--- Merging r35912 into '.':
U    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35912 into '.':
 G   .
--- Merging r35914 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcstatements.pas
--- Recording mergeinfo for merge of r35914 into '.':
 G   .
--- Merging r35915 into '.':
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35915 into '.':
 G   .
--- Merging r35916 into '.':
G    packages/fcl-passrc/tests/tcclasstype.pas
U    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35916 into '.':
 G   .
--- Merging r35917 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
G    packages/fcl-passrc/src/pasuseanalyzer.pas
--- Recording mergeinfo for merge of r35917 into '.':
 G   .
--- Merging r35919 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35919 into '.':
 G   .
--- Merging r35920 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35920 into '.':
 G   .
--- Merging r35923 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35923 into '.':
 G   .
--- Merging r35926 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35926 into '.':
 G   .
--- Merging r35927 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r35927 into '.':
 G   .
--- Merging r35928 into '.':
G    packages/fcl-passrc/tests/tcresolver.pas
G    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r35928 into '.':
 G   .
--- Merging r35931 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r35931 into '.':
 G   .
--- Merging r35932 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35932 into '.':
 G   .
--- Merging r35933 into '.':
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35933 into '.':
 G   .
--- Merging r35938 into '.':
U    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35938 into '.':
 G   .
--- Merging r35939 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r35939 into '.':
 G   .
--- Merging r35940 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35940 into '.':
 G   .
--- Merging r35947 into '.':
G    packages/fcl-passrc/tests/tcclasstype.pas
G    packages/fcl-passrc/tests/tcstatements.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35947 into '.':
 G   .
--- Merging r35948 into '.':
G    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r35948 into '.':
 G   .
--- Merging r35949 into '.':
G    packages/fcl-passrc/tests/tcclasstype.pas
--- Recording mergeinfo for merge of r35949 into '.':
 G   .
--- Merging r35950 into '.':
G    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r35950 into '.':
 G   .
--- Merging r35951 into '.':
U    packages/fcl-passrc/tests/tcscanner.pas
G    packages/fcl-passrc/tests/tctypeparser.pas
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35951 into '.':
 G   .
--- Merging r35960 into '.':
U    packages/fcl-passrc/tests/tcexprparser.pas
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r35960 into '.':
 G   .
--- Merging r35963 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r35963 into '.':
 G   .
--- Merging r35964 into '.':
G    packages/fcl-passrc/src/pastree.pp
U    packages/fcl-passrc/src/passrcutil.pp
U    packages/fcl-passrc/src/paswrite.pp
--- Recording mergeinfo for merge of r35964 into '.':
 G   .
--- Merging r35966 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/tests/tcexprparser.pas
--- Recording mergeinfo for merge of r35966 into '.':
 G   .

# revisions: 35883,35884,35887,35888,35889,35895,35896,35897,35898,35902,35903,35904,35905,35908,35909,35910,35911,35912,35914,35915,35916,35917,35919,35920,35923,35926,35927,35928,35931,35932,35933,35938,35939,35940,35947,35948,35949,35950,35951,35960,35963,35964,35966

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

packages/fcl-passrc/src/passrcutil.pp

@@ -192,7 +192,11 @@ procedure TPasSrcAnalysis.GetUses(ASection : TPasSection; List: TStrings);
 Var
   I : Integer;
 begin
-  If Assigned(ASection) and Assigned(ASection.UsesList) then
+  If not Assigned(ASection) then exit;
+  if ASection.UsesList.Count=length(ASection.UsesClause) then
+    For I:=0 to length(ASection.UsesClause)-1 do
+      List.Add(ASection.UsesClause[i].Identifier)
+  else
     For I:=0 to ASection.UsesList.Count-1 do
       List.Add(TPasElement(ASection.UsesList[i]).Name);
 end;

packages/fcl-passrc/src/pastree.pp

@@ -27,6 +27,11 @@ resourcestring
   // Parse tree node type names
   SPasTreeElement = 'generic element';
   SPasTreeSection = 'unit section';
+  SPasTreeProgramSection = 'program section';
+  SPasTreeLibrarySection = 'library section';
+  SPasTreeInterfaceSection = 'interface section';
+  SPasTreeImplementationSection = 'implementation section';
+  SPasTreeUsesUnit = 'uses unit';
   SPasTreeModule = 'module';
   SPasTreeUnit = 'unit';
   SPasTreeProgram = 'program';
@@ -305,6 +310,22 @@ type
     Functions, Variables, Properties, ExportSymbols: TFPList;
   end;
 
+  { TPasUsesUnit }
+
+  TPasUsesUnit = class(TPasElement)
+  public
+    destructor Destroy; override;
+    function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  public
+    Expr: TPasExpr;
+    Identifier: string; // e.g. 'name.space.unitname'
+    InFilename: TPrimitiveExpr; // Kind=pekString, can be nil
+    Module: TPasElement; // TPasUnresolvedTypeRef or TPasModule
+  end;
+  TPasUsesClause = array of TPasUsesUnit;
+
   { TPasSection }
 
   TPasSection = class(TPasDeclarations)
@@ -312,26 +333,40 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     procedure AddUnitToUsesList(const AUnitName: string);
+    function ElementTypeName: string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    UsesList: TFPList;            // TPasUnresolvedTypeRef or TPasModule elements
+    UsesList: TFPList;   // kept for compatibility, see UsesClause Module
+    UsesClause: TPasUsesClause;
   end;
 
   { TInterfaceSection }
 
   TInterfaceSection = class(TPasSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
   { TImplementationSection }
 
   TImplementationSection = class(TPasSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
+  { TProgramSection }
+
   TProgramSection = class(TImplementationSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
+  { TLibrarySection }
+
   TLibrarySection = class(TImplementationSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
   TInitializationSection = class;
@@ -842,7 +877,7 @@ type
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmInline,pmAssembler, pmPublic,
                         pmCompilerProc,pmExternal,pmForward, pmDispId, 
-                        pmNoReturn, pmfar);
+                        pmNoReturn, pmfar, pmFinal);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -1430,7 +1465,7 @@ const
                    'export', 'overload', 'message', 'reintroduce',
                    'inline','assembler','public',
                    'compilerproc','external','forward','dispid',
-                   'noreturn','far');
+                   'noreturn','far','final');
 
   VariableModifierNames : Array[TVariableModifier] of string
      = ('cvar', 'external', 'public', 'export', 'class', 'static');
@@ -1449,6 +1484,58 @@ begin
   El:=nil;
 end;
 
+{ TInterfaceSection }
+
+function TInterfaceSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeInterfaceSection;
+end;
+
+{ TLibrarySection }
+
+function TLibrarySection.ElementTypeName: string;
+begin
+  Result:=SPasTreeLibrarySection;
+end;
+
+{ TProgramSection }
+
+function TProgramSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeProgramSection;
+end;
+
+{ TImplementationSection }
+
+function TImplementationSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeImplementationSection;
+end;
+
+{ TPasUsesUnit }
+
+destructor TPasUsesUnit.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Expr));
+  ReleaseAndNil(TPasElement(InFilename));
+  ReleaseAndNil(TPasElement(Module));
+  inherited Destroy;
+end;
+
+function TPasUsesUnit.ElementTypeName: string;
+begin
+  Result := SPasTreeUsesUnit;
+end;
+
+procedure TPasUsesUnit.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
+  ForEachChildCall(aMethodCall,Arg,InFilename,false);
+  ForEachChildCall(aMethodCall,Arg,Module,true);
+end;
+
 { TPasElementBase }
 
 procedure TPasElementBase.Accept(Visitor: TPassTreeVisitor);
@@ -3931,6 +4018,10 @@ begin
   for i := 0 to UsesList.Count - 1 do
     TPasType(UsesList[i]).Release;
   FreeAndNil(UsesList);
+  {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy UsesClause');{$ENDIF}
+  for i := 0 to length(UsesClause) - 1 do
+    UsesClause[i].Release;
+  SetLength(UsesClause,0);
 
   {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy inherited');{$ENDIF}
   inherited Destroy;
@@ -3938,8 +4029,18 @@ begin
 end;
 
 procedure TPasSection.AddUnitToUsesList(const AUnitName: string);
+var
+  l: Integer;
 begin
   UsesList.Add(TPasUnresolvedTypeRef.Create(AUnitName, Self));
+  l:=length(UsesClause);
+  SetLength(UsesClause,l+1);
+  UsesClause[l]:=TPasUsesUnit.Create(AUnitName,Self);
+end;
+
+function TPasSection.ElementTypeName: string;
+begin
+  Result := SPasTreeSection;
 end;
 
 procedure TPasSection.ForEachCall(const aMethodCall: TOnForEachPasElement;
@@ -3948,8 +4049,8 @@ var
   i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to UsesList.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(UsesList[i]),true);
+  for i:=0 to length(UsesClause)-1 do
+    ForEachChildCall(aMethodCall,Arg,UsesClause[i],false);
 end;
 
 { TProcedureBody }

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1044,6 +1044,12 @@ begin
     for i:=0 to length(Params)-1 do
       UseExpr(Params[i]);
     end
+  else if C=TArrayValues then
+    begin
+    Params:=TArrayValues(El).Values;
+    for i:=0 to length(Params)-1 do
+      UseExpr(Params[i]);
+    end
   else
     RaiseNotSupported(20170307085444,El);
 end;

packages/fcl-passrc/src/paswrite.pp

@@ -182,18 +182,28 @@ procedure TPasWriter.WriteSection(ASection: TPasSection);
 var
   i: Integer;
 begin
-  if ASection.UsesList.Count > 0 then
-  begin
-    wrt('uses ');
-    for i := 0 to ASection.UsesList.Count - 1 do
+  if ASection.UsesList.Count>0 then
     begin
-      if i > 0 then
-        wrt(', ');
-      wrt(TPasElement(ASection.UsesList[i]).Name);
-    end;
+    wrt('uses ');
+    if length(ASection.UsesClause)=ASection.UsesList.Count then
+      for i := 0 to length(ASection.UsesClause)-1 do
+        begin
+        if i > 0 then
+          wrt(', ');
+        wrt(ASection.UsesClause[i].Identifier);
+        if ASection.UsesClause[i].InFilename is TPrimitiveExpr then
+          wrt(' in '''+TPrimitiveExpr(ASection.UsesClause[i].InFilename).Value+'''');
+        end
+    else
+      for i := 0 to ASection.UsesList.Count - 1 do
+        begin
+        if i > 0 then
+          wrt(', ');
+        wrt(TPasElement(ASection.UsesList[i]).Name);
+        end;
     wrtln(';');
     wrtln;
-  end;
+    end;
 
   CurDeclSection := '';
 

packages/fcl-passrc/src/pparser.pp

@@ -182,6 +182,7 @@ type
     function FindElement(const AName: String): TPasElement; virtual; abstract;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
+    function NeedArrayValues(El: TPasElement): boolean; virtual;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
     property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
@@ -239,6 +240,7 @@ type
     FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
     FDumpIndent : String;
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
+    function DoCheckHint(Element: TPasElement): Boolean;
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
     function GetCurrentModeSwitches: TModeSwitches;
     Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
@@ -327,7 +329,9 @@ type
     procedure NextToken; // read next non whitespace, non space
     procedure UngetToken;
     procedure CheckToken(tk: TToken);
+    procedure CheckTokens(tk: TTokens);
     procedure ExpectToken(tk: TToken);
+    procedure ExpectTokens(tk:  TTokens);
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
     // Expression parsing
@@ -400,9 +404,18 @@ type
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
   end;
 
+Type
+  TParseSourceOption = (poUseStreams,poSkipDefaultDefs);
+  TParseSourceOptions = set of TParseSourceOption;
+function ParseSource(AEngine: TPasTreeContainer;
+                     const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+function ParseSource(AEngine: TPasTreeContainer;
+                     const FPCCommandLine, OSTarget, CPUTarget: String;
+                     UseStreams  : Boolean): TPasModule; deprecated;
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String;
-                     UseStreams  : Boolean = False): TPasModule;
+                     Options : TParseSourceOptions): TPasModule;
+                     
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
@@ -495,9 +508,26 @@ begin
   end;
 end;
 
+function ParseSource(AEngine: TPasTreeContainer;
+  const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+
+begin
+  Result:=ParseSource(AENgine,FPCCommandLine, OSTarget, CPUTarget,[]);
+end;
+
+function ParseSource(AEngine: TPasTreeContainer;
+  const FPCCommandLine, OSTarget, CPUTarget: String; UseStreams : Boolean): TPasModule;
+
+begin
+  if UseStreams then
+    Result:=ParseSource(AENgine,FPCCommandLine, OSTarget, CPUTarget,[poUseStreams])
+  else
+    Result:=ParseSource(AENgine,FPCCommandLine, OSTarget, CPUTarget,[]);
+end;
+
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
-  UseStreams  : Boolean = False): TPasModule;
+  Options : TParseSourceOptions): TPasModule;
 var
   FileResolver: TFileResolver;
   Parser: TPasParser;
@@ -521,6 +551,8 @@ var
       case s[2] of
         'd': // -d define
           Scanner.AddDefine(UpperCase(Copy(s, 3, Length(s))));
+        'u': // -u undefine
+          Scanner.RemoveDefine(UpperCase(Copy(s, 3, Length(s))));
         'F': // -F
           if (length(s)>2) and (s[3] = 'i') then // -Fi include path
             FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
@@ -528,10 +560,18 @@ var
           FileResolver.AddIncludePath(Copy(s, 3, Length(s)));
         'S': // -S mode
           if  (length(s)>2) then
-            case S[3] of
-              'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
-              'd' : Scanner.SetCompilerMode('DELPHI');
-              '2' : Scanner.SetCompilerMode('OBJFPC');
+            begin
+            l:=3;
+            While L<=Length(S) do
+              begin
+              case S[l] of
+                'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
+                'd' : Scanner.SetCompilerMode('DELPHI');
+                '2' : Scanner.SetCompilerMode('OBJFPC');
+                'h' : ; // do nothing
+              end;
+              inc(l);
+              end;
             end;
         'M' :
            begin
@@ -555,51 +595,52 @@ begin
   Parser := nil;
   try
     FileResolver := TFileResolver.Create;
-    FileResolver.UseStreams:=UseStreams;
+    FileResolver.UseStreams:=poUseStreams in Options;
     Scanner := TPascalScanner.Create(FileResolver);
-    Scanner.AddDefine('FPK');
-    Scanner.AddDefine('FPC');
     SCanner.LogEvents:=AEngine.ScannerLogEvents;
     SCanner.OnLog:=AEngine.Onlog;
-
-    // TargetOS
-    s := UpperCase(OSTarget);
-    Scanner.AddDefine(s);
-    if s = 'LINUX' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'FREEBSD' then
-    begin
-      Scanner.AddDefine('BSD');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'NETBSD' then
-    begin
-      Scanner.AddDefine('BSD');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'SUNOS' then
-    begin
-      Scanner.AddDefine('SOLARIS');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'GO32V2' then
-      Scanner.AddDefine('DPMI')
-    else if s = 'BEOS' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'QNX' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'AROS' then
-      Scanner.AddDefine('HASAMIGA')
-    else if s = 'MORPHOS' then
-      Scanner.AddDefine('HASAMIGA')
-    else if s = 'AMIGA' then
-      Scanner.AddDefine('HASAMIGA');
-
-    // TargetCPU
-    s := UpperCase(CPUTarget);
-    Scanner.AddDefine('CPU'+s);
-    if (s='X86_64') then
-      Scanner.AddDefine('CPU64')
-    else
-      Scanner.AddDefine('CPU32');
-
+    if not (poSkipDefaultDefs in Options) then
+      begin
+      Scanner.AddDefine('FPK');
+      Scanner.AddDefine('FPC');
+      // TargetOS
+      s := UpperCase(OSTarget);
+      Scanner.AddDefine(s);
+      if s = 'LINUX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'FREEBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'NETBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'SUNOS' then
+      begin
+        Scanner.AddDefine('SOLARIS');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'GO32V2' then
+        Scanner.AddDefine('DPMI')
+      else if s = 'BEOS' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'QNX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'AROS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'MORPHOS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'AMIGA' then
+        Scanner.AddDefine('HASAMIGA');
+
+      // TargetCPU
+      s := UpperCase(CPUTarget);
+      Scanner.AddDefine('CPU'+s);
+      if (s='X86_64') then
+        Scanner.AddDefine('CPU64')
+      else
+        Scanner.AddDefine('CPU32');
+      end;
     Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
     Filename := '';
     Parser.LogEvents:=AEngine.ParserLogEvents;
@@ -691,6 +732,12 @@ begin
   Result := nil;
 end;
 
+function TPasTreeContainer.NeedArrayValues(El: TPasElement): boolean;
+begin
+  Result:=false;
+  if El=nil then ;
+end;
+
 { ---------------------------------------------------------------------
   EParserError
   ---------------------------------------------------------------------}
@@ -895,6 +942,30 @@ begin
     end;
 end;
 
+procedure TPasParser.CheckTokens(tk: TTokens);
+
+Var
+  S : String;
+  T : TToken;
+begin
+  if not (CurToken in tk) then
+    begin
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
+    {$ENDIF}
+    S:='';
+    For T in TToken do
+      if t in tk then
+        begin
+        if (S<>'') then
+          S:=S+' or ';
+        S:=S+TokenInfos[t];
+        end;
+    ParseExcTokenError(S);
+    end;
+
+end;
+
 
 procedure TPasParser.ExpectToken(tk: TToken);
 begin
@@ -902,6 +973,12 @@ begin
   CheckToken(tk);
 end;
 
+procedure TPasParser.ExpectTokens(tk: TTokens);
+begin
+  NextToken;
+  CheckTokens(tk);
+end;
+
 function TPasParser.ExpectIdentifier: String;
 begin
   ExpectToken(tkIdentifier);
@@ -1339,7 +1416,9 @@ begin
       // Always allowed
       tkIdentifier:
         begin
-        if CurTokenIsIdentifier('reference') then
+        // Bug 31709: PReference = ^Reference;
+        // Checked in Delphi: ^Reference to procedure; is not allowed !!
+        if CurTokenIsIdentifier('reference') and Not (Parent is TPasPointerType) then
           begin
           CH:=False;
           Result:=ParseReferencetoProcedureType(Parent,NamePos,TypeName)
@@ -1725,7 +1804,7 @@ begin
 
   ok:=false;
   try
-    if Last.Kind in [pekIdent,pekSelf] then
+    if Last.Kind in [pekIdent,pekSelf,pekNil] then
       begin
       while CurToken in [tkDot] do
         begin
@@ -2015,11 +2094,6 @@ begin
 end;
 
 function TPasParser.DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
-var
-  x : TPasExpr;
-  n : AnsiString;
-  r : TRecordValues;
-  a : TArrayValues;
 
   function lastfield:boolean;
 
@@ -2035,76 +2109,95 @@ var
      end;
   end;
 
+  procedure ReadArrayValues(x : TPasExpr);
+  var
+    a: TArrayValues;
+  begin
+    Result:=nil;
+    a:=nil;
+    try
+      a:=CreateArrayValues(AParent);
+      if x<>nil then
+        begin
+        a.AddValues(x);
+        x:=nil;
+        end;
+      repeat
+        NextToken;
+        a.AddValues(DoParseConstValueExpression(AParent));
+      until CurToken<>tkComma;
+      Result:=a;
+    finally
+      if Result=nil then
+        begin
+        a.Free;
+        x.Free;
+        end;
+    end;
+  end;
+
+var
+  x : TPasExpr;
+  n : AnsiString;
+  r : TRecordValues;
 begin
   if CurToken <> tkBraceOpen then
     Result:=DoParseExpression(AParent)
   else begin
     Result:=nil;
-    NextToken;
-    x:=DoParseConstValueExpression(AParent);
-    case CurToken of
-      tkComma: // array of values (a,b,c);
-        try
-          a:=CreateArrayValues(AParent);
-          a.AddValues(x);
-          x:=nil;
-          repeat
-            NextToken;
-            x:=DoParseConstValueExpression(AParent);
-            a.AddValues(x);
-            x:=nil;
-          until CurToken<>tkComma;
-          Result:=a;
-        finally
-          if Result=nil then
-            begin
-            a.Free;
-            x.Free;
-            end;
-        end;
-
-      tkColon: // record field (a:xxx;b:yyy;c:zzz);
-        begin
-          r:=nil;
-          try
-            n:=GetExprIdent(x);
-            ReleaseAndNil(TPasElement(x));
-            r:=CreateRecordValues(AParent);
-            NextToken;
-            x:=DoParseConstValueExpression(AParent);
-            r.AddField(n, x);
-            x:=nil;
-            if not lastfield then
-              repeat
-                n:=ExpectIdentifier;
-                ExpectToken(tkColon);
-                NextToken;
-                x:=DoParseConstValueExpression(AParent);
-                r.AddField(n, x);
-                x:=nil;
-              until lastfield; // CurToken<>tkSemicolon;
-            Result:=r;
-          finally
-            if Result=nil then
-              begin
-              r.Free;
-              x.Free;
-              end;
-          end;
-        end;
+    if Engine.NeedArrayValues(AParent) then
+      ReadArrayValues(nil)
     else
-      // Binary expression!  ((128 div sizeof(longint)) - 3);
-      Result:=DoParseExpression(AParent,x);
-      if CurToken<>tkBraceClose then
-        begin
-        ReleaseAndNil(TPasElement(Result));
-        ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
-        end;
+      begin
       NextToken;
-      if CurToken <> tkSemicolon then // the continue of expression
-        Result:=DoParseExpression(AParent,Result);
-      Exit;
-    end;
+      x:=DoParseConstValueExpression(AParent);
+      case CurToken of
+        tkComma: // array of values (a,b,c);
+          ReadArrayValues(x);
+
+        tkColon: // record field (a:xxx;b:yyy;c:zzz);
+          begin
+            r:=nil;
+            try
+              n:=GetExprIdent(x);
+              ReleaseAndNil(TPasElement(x));
+              r:=CreateRecordValues(AParent);
+              NextToken;
+              x:=DoParseConstValueExpression(AParent);
+              r.AddField(n, x);
+              x:=nil;
+              if not lastfield then
+                repeat
+                  n:=ExpectIdentifier;
+                  ExpectToken(tkColon);
+                  NextToken;
+                  x:=DoParseConstValueExpression(AParent);
+                  r.AddField(n, x);
+                  x:=nil;
+                until lastfield; // CurToken<>tkSemicolon;
+              Result:=r;
+            finally
+              if Result=nil then
+                begin
+                r.Free;
+                x.Free;
+                end;
+            end;
+          end;
+      else
+        // Binary expression!  ((128 div sizeof(longint)) - 3);
+        Result:=DoParseExpression(AParent,x);
+        if CurToken<>tkBraceClose then
+          begin
+          ReleaseAndNil(TPasElement(Result));
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
+          end;
+        NextToken;
+        if CurToken <> tkSemicolon then // the continue of expression
+          Result:=DoParseExpression(AParent,Result);
+        Exit;
+      end;
+      end;
     if CurToken<>tkBraceClose then
       begin
       ReleaseAndNil(TPasElement(Result));
@@ -2736,7 +2829,8 @@ begin
         if Declarations is TProcedureBody then
           begin
           Proc:=Declarations.Parent as TPasProcedure;
-          if not (pmAssembler in Proc.Modifiers) then
+          // Assembler keyword is optional in Delphi mode (bug 31690)
+          if not ((pmAssembler in Proc.Modifiers) or (msDelphi in CurrentModeswitches)) then
             ParseExc(nParserExpectTokenError,SParserExpectTokenError,['begin']);
           SetBlock(declNone);
           ParseProcAsmBlock(TProcedureBody(Declarations));
@@ -3597,6 +3691,28 @@ end;
 
 // Next token is expected to be a "(", ";" or for a function ":". The caller
 // will get the token after the final ";" as next token.
+
+function TPasParser.DoCheckHint(Element : TPasElement): Boolean;
+
+var
+  ahint : TPasMemberHint;
+
+begin
+  Result:= IsCurTokenHint(ahint);
+  if Result then  // deprecated,platform,experimental,library, unimplemented etc
+    begin
+    Element.Hints:=Element.Hints+[ahint];
+    if aHint=hDeprecated then
+      begin
+      NextToken;
+      if (CurToken<>tkString) then
+        UngetToken
+      else
+        Element.HintMessage:=CurTokenString;
+      end;
+    end;
+end;
+
 procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
 
@@ -3636,25 +3752,6 @@ procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
       UngetToken;
   end;
 
-  function DoCheckHint : Boolean;
-
-  var
-    ahint : TPasMemberHint;
-  begin
-  Result:= IsCurTokenHint(ahint);
-  if Result then  // deprecated,platform,experimental,library, unimplemented etc
-    begin
-    Element.Hints:=Element.Hints+[ahint];
-    if aHint=hDeprecated then
-      begin
-      NextToken;
-      if (CurToken<>tkString) then
-        UngetToken
-      else
-        Element.HintMessage:=CurTokenString;
-      end;
-    end;
-  end;
 
 Var
   Tok : String;
@@ -3743,9 +3840,10 @@ begin
   ModCount:=0;
   Repeat
     inc(ModCount);
+    // Writeln(modcount, curtokentext);
     LastToken:=CurToken;
     NextToken;
-    if (ModCount=1) and (CurToken = tkEqual) then
+    if (ModCount in [1,2,3]) and (CurToken = tkEqual) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -3773,7 +3871,9 @@ begin
           NextToken; // remove offset
           end;
       end;
-      ExpectToken(tkSemicolon);
+      ExpectTokens([tkSemicolon,tkEqual]);
+      if curtoken=tkEqual then
+        ungettoken;
       end
     else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
@@ -3791,7 +3891,7 @@ begin
         ExpectToken(tkSemicolon);
         end;
       end
-    else if DoCheckHint then
+    else if DoCheckHint(Element) then
       ConsumeSemi
     else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
       begin
@@ -3823,9 +3923,10 @@ begin
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;
+
 //    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
   Until Done;
-  if DoCheckHint then  // deprecated,platform,experimental,library, unimplemented etc
+  if DoCheckHint(Element) then  // deprecated,platform,experimental,library, unimplemented etc
     ConsumeSemi;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
@@ -3913,8 +4014,6 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
 
 var
   isArray , ok: Boolean;
-  h   : TPasMemberHint;
-
 begin
   Result:=TPasProperty(CreateElement(TPasProperty,AName,Parent,AVisibility));
   if IsClassField then
@@ -4010,14 +4109,10 @@ begin
         end
       end;
     // Handle hints
-    while IsCurTokenHint(h) do
-      begin
-      Result.Hints:=Result.Hints+[h];
+    while DoCheckHint(Result) do
       NextToken;
-      if CurToken=tkSemicolon then
-        NextToken;
-      end;
-    UngetToken;
+    if Result.Hints=[] then
+      UngetToken;
     ok:=true;
   finally
     if not ok then
@@ -4062,6 +4157,16 @@ begin
 end;
 
 procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
+
+Var
+  LastToken : TToken;
+
+  Function atEndofAsm : Boolean;
+
+  begin
+    Result:=(CurToken=tkEnd) and (LastToken<>tkAt);
+  end;
+
 begin
   if po_asmwhole in Options then
     begin
@@ -4094,11 +4199,12 @@ begin
     end
   else
     begin
+    LastToken:=tkEOF;
     NextToken;
-    While CurToken<>tkEnd do
+    While Not AtEndOfAsm do
       begin
-      // ToDo: allow @@end
       AsmBlock.Tokens.Add(CurTokenText);
+      LastToken:=CurToken;
       NextToken;
       end;
     end;
@@ -4177,7 +4283,7 @@ begin
       ParseAsmBlock(TPasImplAsmStatement(El));
       CurBlock.AddElement(El);
       if NewImplElement=nil then NewImplElement:=CurBlock;
-      if CloseStatement(true) then
+      if CloseStatement(False) then
         break;
       end;
     tkbegin:
@@ -4246,6 +4352,11 @@ begin
         //if .. then Raise Exception else ..
         CloseBlock;
         UngetToken;
+      end else if (CurBlock is TPasImplAsmStatement) then
+      begin
+        //if .. then asm end else ..
+        CloseBlock;
+        UngetToken;
       end else if (CurBlock is TPasImplTryExcept) then
       begin
         CloseBlock;
@@ -4544,6 +4655,8 @@ begin
       end;
     tkSemiColon:
       if CloseStatement(true) then break;
+    tkFinalization:
+      if CloseStatement(true) then break;
     tkuntil:
       begin
         if CloseStatement(true) then
@@ -4564,8 +4677,11 @@ begin
       end;
     tkEOF:
       CheckToken(tkend);
-    tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
+    tkAt,tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
       begin
+// This should in fact not be checked here.
+//      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
+//        ParseExc;
       left:=DoParseExpression(CurBlock);
       case CurToken of
         tkAssign,
@@ -5091,39 +5207,50 @@ end;
 
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
 
+Type
+  TSectionType = (stNone,stConst,stType,stVar);
+
 Var
   CurVisibility : TPasMemberVisibility;
+  CurSection : TSectionType;
 
 begin
+  CurSection:=stNone;
   CurVisibility := visDefault;
   while (CurToken<>tkEnd) do
     begin
     case CurToken of
       tkType:
-        begin
-        ExpectToken(tkIdentifier);
-        SaveComments;
-        ParseClassLocalTypes(AType,CurVisibility);
-        end;
+        CurSection:=stType;
       tkConst:
-        begin
-        ExpectToken(tkIdentifier);
-        SaveComments;
-        ParseClassLocalConsts(AType,CurVisibility);
-        end;
-      tkVar,
+        CurSection:=stConst;
+      tkVar:
+        CurSection:=stVar;
       tkIdentifier:
-        begin
-        if (AType.ObjKind in [okInterface,okDispInterface]) then
-          ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
-        if CurToken=tkVar then
-          ExpectToken(tkIdentifier);
-        SaveComments;
-        if Not CheckVisibility(CurtokenString,CurVisibility) then
-          ParseClassFields(AType,CurVisibility,false);
-        end;
+        if CheckVisibility(CurtokenString,CurVisibility) then
+          CurSection:=stNone
+        else
+          begin
+          SaveComments;
+          Case CurSection of
+          stType:
+            ParseClassLocalTypes(AType,CurVisibility);
+          stConst :
+            ParseClassLocalConsts(AType,CurVisibility);
+          stNone,
+          stvar:
+            begin
+            if (AType.ObjKind in [okInterface,okDispInterface]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
+            ParseClassFields(AType,CurVisibility,false);
+            end;
+          else
+            Raise Exception.Create('Internal error 201704251415');
+          end;
+          end;
       tkProcedure,tkFunction,tkConstructor,tkDestructor:
         begin
+        curSection:=stNone;
         SaveComments;
         if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okDispInterface,okRecordHelper]) then
           ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
@@ -5131,6 +5258,7 @@ begin
         end;
       tkclass:
         begin
+        curSection:=stNone;
          SaveComments;
          NextToken;
          if CurToken in [tkConstructor,tkDestructor,tkProcedure,tkFunction] then
@@ -5150,6 +5278,7 @@ begin
         end;
       tkProperty:
         begin
+        curSection:=stNone;
         SaveComments;
         ExpectIdentifier;
         AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility,false));

packages/fcl-passrc/src/pscanner.pp

@@ -41,6 +41,7 @@ const
   nLogIFIgnored = 1014;
   nErrInvalidMode = 1015;
   nErrInvalidModeSwitch = 1016;
+  nUserDefined = 1017;
 
 // resourcestring patterns of messages
 resourcestring
@@ -60,6 +61,7 @@ resourcestring
   SLogIFIgnored = 'IF %s found, ignoring (rejected).';
   SErrInvalidMode = 'Invalid mode: "%s"';
   SErrInvalidModeSwitch = 'Invalid mode switch: "%s"';
+  SErrUserDefined = 'User defined error: "%s"';
 
 type
   TMessageType = (
@@ -386,7 +388,8 @@ type
     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_SelfToken,            // Self is a token. For backward compatibility.
+    po_CheckModeswitches     // stop on unknown modeswitch
     );
   TPOptions = set of TPOption;
 
@@ -405,6 +408,7 @@ type
 
   TPascalScanner = class
   private
+    FAllowedModeSwitches: TModeSwitches;
     FCurrentModeSwitches: TModeSwitches;
     FForceCaret: Boolean;
     FLastMsg: string;
@@ -437,6 +441,8 @@ type
     PPSkipModeStack: array[0..255] of TPascalScannerPPSkipMode;
     PPIsSkippingStack: array[0..255] of Boolean;
     function GetCurColumn: Integer;
+    procedure SetAllowedModeSwitches(const AValue: TModeSwitches);
+    procedure SetCurrentModeSwitches(AValue: TModeSwitches);
     procedure SetOptions(AValue: TPOptions);
   protected
     function FetchLine: boolean;
@@ -454,6 +460,7 @@ type
     procedure HandleELSE(const AParam: String);
     procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
+    procedure HandleError(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
     function HandleInclude(const Param: String): TToken;virtual;
@@ -503,7 +510,8 @@ type
     property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
     property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
-    Property CurrentModeSwitches : TModeSwitches Read FCurrentModeSwitches Write FCurrentModeSwitches;
+    Property AllowedModeSwitches: TModeSwitches Read FAllowedModeSwitches Write SetAllowedModeSwitches;
+    Property CurrentModeSwitches: TModeSwitches Read FCurrentModeSwitches Write SetCurrentModeSwitches;
     Property ForceCaret : Boolean Read FForceCaret;
   end;
 
@@ -668,6 +676,8 @@ const
   AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
 
 const
+  // all mode switches supported by FPC
+  msAllFPCModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
 
   DelphiModeSwitches = [msDelphi,msClass,msObjpas,msresult,msstringpchar,
      mspointer2procedure,msautoderef,msTPprocvar,msinitfinal,msdefaultansistring,
@@ -676,6 +686,7 @@ const
 
   DelphiUnicodeModeSwitches = delphimodeswitches + [mssystemcodepage,msdefaultunicodestring];
 
+  // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
   FPCModeSwitches = [msfpc,msstringpchar,msnestedcomment,msrepeatforward,
     mscvarsupport,msinitfinal,mshintdirective, msproperty,msdefaultinline];
 
@@ -1237,6 +1248,7 @@ begin
   FDefines := CS;
   FMacros:=CS;
   FCurrentModeSwitches:=FPCModeSwitches;
+  FAllowedModeSwitches:=msAllFPCModeSwitches;
 end;
 
 destructor TPascalScanner.Destroy;
@@ -1584,6 +1596,11 @@ begin
     end;
 end;
 
+procedure TPascalScanner.HandleError(Param: String);
+begin
+  Error(nUserDefined, SErrUserDefined,[Param])
+end;
+
 procedure TPascalScanner.HandleUnDefine(Param: String);
 
 Var
@@ -1605,7 +1622,7 @@ begin
     end;
 end;
 
-Function TPascalScanner.HandleInclude(Const Param : String) : TToken;
+function TPascalScanner.HandleInclude(const Param: String): TToken;
 
 begin
   Result:=tkComment;
@@ -1619,62 +1636,46 @@ begin
     end
 end;
 
-Procedure TPascalScanner.HandleMode(Const Param : String);
+procedure TPascalScanner.HandleMode(const Param: String);
+
+  procedure SetMode(const NeededModes, NewModeSwitches: TModeSwitches;
+    IsDelphi: boolean);
+  begin
+    if not (NeededModes<=AllowedModeSwitches) then
+      Error(nErrInvalidMode,SErrInvalidMode,[Param]);
+    CurrentModeSwitches:=NewModeSwitches;
+    if IsDelphi then
+      FOptions:=FOptions+[po_delphi]
+    else
+      FOptions:=FOptions-[po_delphi];
+  end;
 
 Var
   P : String;
 
 begin
   P:=UpperCase(Param);
-  // Eventually, we'll need to make the distinction...
-  // For now, treat OBJFPC as Delphi mode.
   Case P of
+  'FPC':
+    SetMode([msFpc],FPCModeSwitches,false);
+  'OBJFPC':
+    SetMode([msObjfpc],OBJFPCModeSwitches,true);
   'DELPHI':
-     begin
-     CurrentModeSwitches:=delphimodeswitches;
-     FOptions:=FOptions+[po_delphi]
-     end;
+    SetMode([msDelphi],DelphiModeSwitches,true);
   'DELPHIUNICODE':
-     begin
-     CurrentModeSwitches:=DelphiUnicodeModeSwitches;
-     FOptions:=FOptions+[po_delphi]
-     end;
+    SetMode([msDelphi,msDefaultUnicodestring],DelphiUnicodeModeSwitches,true);
   'TP':
-     begin
-     CurrentModeSwitches:=TPModeSwitches;
-     FOptions:=FOptions-[po_delphi]
-     end;
-  'GPC':
-     begin
-     CurrentModeSwitches:=GPCModeSwitches;
-     FOptions:=FOptions-[po_delphi]
-     end;
+    SetMode([msTP7],TPModeSwitches,false);
+  'MACPAS':
+    SetMode([msMac],MacModeSwitches,false);
   'ISO':
-     begin
-     CurrentModeSwitches:=ISOModeSwitches;
-     FOptions:=FOptions-[po_delphi]
-     end;
+    SetMode([msIso],ISOModeSwitches,false);
   'EXTENDED':
-     begin
-     CurrentModeSwitches:=ExtPasModeSwitches;
-     FOptions:=FOptions-[po_delphi]
-     end;
-  'MACPAS':
-     begin
-     CurrentModeSwitches:=MacModeSwitches;
-     FOptions:=FOptions-[po_delphi]
-     end;
-  'OBJFPC':
-    begin
-    CurrentModeSwitches:=ObjFPCModeSwitches;
-    FOptions:=FOptions+[po_delphi]
-    end;
-  'FPC',
+    SetMode([msExtpas],ExtPasModeSwitches,false);
+  'GPC':
+    SetMode([msGPC],GPCModeSwitches,false);
   'DEFAULT':
-    begin
-      CurrentModeSwitches:=FPCModeSwitches;
-      FOptions:=FOptions-[po_delphi]
-    end;
+    SetMode([msFpc],FPCModeSwitches,false);
   else
     Error(nErrInvalidMode,SErrInvalidMode,[Param])
   end;
@@ -1697,16 +1698,21 @@ begin
     MSN:=Copy(MSN,1,P-1);
     end;
   While (MS<>msNone) and (SModeSwitchNames[MS]<>MSN) do
-   MS:=Pred(MS);
-  if MS=msNone then
-    Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param]);
-  if (PM='') or (PM='+') or (PM='ON') then
-    CurrentModeSwitches:=CurrentModeSwitches+[MS]
+    MS:=Pred(MS);
+  if (MS=msNone) or not (MS in AllowedModeSwitches) then
+    begin
+    if po_CheckModeswitches in Options then
+      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param])
+    else
+      exit; // ignore
+    end;
+  if (PM='-') or (PM='OFF') then
+    CurrentModeSwitches:=CurrentModeSwitches-[MS]
   else
-    CurrentModeSwitches:=CurrentModeSwitches-[MS];
+    CurrentModeSwitches:=CurrentModeSwitches+[MS];
 end;
 
-Procedure TPascalScanner.PushSkipMode;
+procedure TPascalScanner.PushSkipMode;
 
 begin
   if PPSkipStackIndex = High(PPSkipModeStack) then
@@ -1716,7 +1722,7 @@ begin
   Inc(PPSkipStackIndex);
 end;
 
-Procedure TPascalScanner.HandleIFDEF(Const AParam : String);
+procedure TPascalScanner.HandleIFDEF(const AParam: String);
 
 Var
   ADefine : String;
@@ -1747,7 +1753,7 @@ begin
     end;
 end;
 
-Procedure TPascalScanner.HandleIFNDEF(Const AParam : String);
+procedure TPascalScanner.HandleIFNDEF(const AParam: String);
 
 Var
   ADefine : String;
@@ -1779,7 +1785,7 @@ begin
     end;
 end;
 
-Procedure TPascalScanner.HandleIFOPT(Const AParam : String);
+procedure TPascalScanner.HandleIFOPT(const AParam: String);
 
 begin
   PushSkipMode;
@@ -1796,7 +1802,7 @@ begin
     DoLog(mtInfo,nLogIFOPTIgnored,sLogIFOPTIgnored,[Uppercase(AParam)])
 end;
 
-Procedure TPascalScanner.HandleIF(Const AParam : String);
+procedure TPascalScanner.HandleIF(const AParam: String);
 
 begin
   PushSkipMode;
@@ -1813,7 +1819,7 @@ begin
     end;
 end;
 
-Procedure TPascalScanner.HandleELSE(Const AParam : String);
+procedure TPascalScanner.HandleELSE(const AParam: String);
 
 begin
   if AParam='' then;
@@ -1826,7 +1832,7 @@ begin
 end;
 
 
-Procedure TPascalScanner.HandleENDIF(Const AParam : String);
+procedure TPascalScanner.HandleENDIF(const AParam: String);
 
 begin
   if AParam='' then;
@@ -1837,7 +1843,7 @@ begin
   PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
 end;
 
-Function TPascalScanner.HandleDirective(Const ADirectiveText : String) : TToken;
+function TPascalScanner.HandleDirective(const ADirectiveText: String): TToken;
 
 Var
   Directive,Param : String;
@@ -1868,6 +1874,9 @@ begin
   'DEFINE':
      if not PPIsSkipping then
        HandleDefine(Param);
+  'ERROR':
+     if not PPIsSkipping then
+       HandleError(Param);
   'UNDEF':
      if not PPIsSkipping then
        HandleUnDefine(Param);
@@ -1944,10 +1953,18 @@ begin
           Inc(TokenStr);
         until not (TokenStr[0] in ['0'..'7']);
         SectionLength := TokenStr - TokenStart;
-        SetLength(FCurTokenString, SectionLength);
-        if SectionLength > 0 then
-          Move(TokenStart^, FCurTokenString[1], SectionLength);
-        Result := tkNumber;
+        if (SectionLength=1) then // &Keyword
+          begin
+          DoFetchToken();
+          Result:=tkIdentifier;
+          end
+        else
+          begin
+          SetLength(FCurTokenString, SectionLength);
+          if SectionLength > 0 then
+            Move(TokenStart^, FCurTokenString[1], SectionLength);
+          Result := tkNumber;
+          end;
       end;
     '$':
       begin
@@ -2223,7 +2240,7 @@ begin
     '^':
       begin
       if ForceCaret or PPisSkipping or
-         (PreviousToken in [tkeof,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET]) then
+         (PreviousToken in [tkeof,tkComment,tkIdentifier,tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCARET,tkWhitespace]) then
         begin
         Inc(TokenStr);
         Result := tkCaret;
@@ -2326,6 +2343,20 @@ begin
     Result := 0;
 end;
 
+procedure TPascalScanner.SetAllowedModeSwitches(const AValue: TModeSwitches);
+begin
+  if FAllowedModeSwitches=AValue then Exit;
+  FAllowedModeSwitches:=AValue;
+  CurrentModeSwitches:=FCurrentModeSwitches*AllowedModeSwitches;
+end;
+
+procedure TPascalScanner.SetCurrentModeSwitches(AValue: TModeSwitches);
+begin
+  AValue:=AValue*AllowedModeSwitches;
+  if FCurrentModeSwitches=AValue then Exit;
+  FCurrentModeSwitches:=AValue;
+end;
+
 procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
   const Msg: String; SkipSourceInfo: Boolean);
 begin
@@ -2422,7 +2453,7 @@ begin
   Result.Column:=CurColumn;
 end;
 
-Function TPascalScanner.SetForceCaret (AValue : Boolean): Boolean;
+function TPascalScanner.SetForceCaret(AValue: Boolean): Boolean;
 
 begin
   Result:=FForceCaret;

packages/fcl-passrc/tests/tcclasstype.pas

@@ -83,6 +83,8 @@ type
     Procedure TestTwoFields;
     Procedure TestTwoFieldsB;
     Procedure TestTwoVarFieldsB;
+    procedure TestNoVarFields;
+    procedure TestVarClassFunction;
     Procedure TestTwoFieldsVisibility;
     Procedure TestConstProtectedEnd;
     Procedure TestTypeProtectedEnd;
@@ -109,6 +111,7 @@ type
     Procedure TestMethodVirtual;
     Procedure TestMethodVirtualSemicolon;
     Procedure TestMethodVirtualAbstract;
+    procedure TestMethodVirtualAbstractFinal;
     Procedure TestMethodOverride;
     procedure TestMethodDynamic;
     procedure TestMethodReintroduce;
@@ -144,6 +147,8 @@ type
     Procedure TestPropertyReadFromRecordField;
     procedure TestPropertyReadFromArrayField;
     procedure TestPropertyReadWriteFromRecordField;
+    procedure TestPropertyDeprecated;
+    procedure TestPropertyDeprecatedMessage;
     Procedure TestExternalClass;
     Procedure TestExternalClassNoNameSpace;
     Procedure TestExternalClassNoNameKeyWord;
@@ -685,6 +690,33 @@ begin
   AssertVisibility(visPublic,Members[1]);
 end;
 
+procedure TTestClassType.TestNoVarFields;
+
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('var');
+  AddMember('Function b : integer');
+  ParseClass;
+  AssertEquals('member count',1,TheClass.members.Count);
+  AssertNotNull('Have function',Members[0]);
+  AssertMemberName('b',Members[0]);
+  AssertMemberType(TPasFunction,Members[0]);
+  AssertVisibility(visPublic,Members[0]);
+end;
+
+procedure TTestClassType.TestVarClassFunction;
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('var');
+  AddMember('class Function b : integer');
+  ParseClass;
+  AssertEquals('member count',1,TheClass.members.Count);
+  AssertNotNull('Have function',Members[0]);
+  AssertMemberName('b',Members[0]);
+  AssertMemberType(TPasClassFunction,Members[0]);
+  AssertVisibility(visPublic,Members[0]);
+end;
+
 procedure TTestClassType.TestTwoFieldsVisibility;
 begin
   StartVisibility(visPublic);
@@ -1001,6 +1033,16 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
+procedure TTestClassType.TestMethodVirtualAbstractFinal;
+begin
+  AddMember('Procedure DoSomething(A : Integer) virtual; abstract; final');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('Virtual, abstract modifiers',[pmVirtual,pmAbstract,pmFinal],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
 
 procedure TTestClassType.TestMethodOverride;
 begin
@@ -1478,6 +1520,40 @@ begin
 
 end;
 
+procedure TTestClassType.TestPropertyDeprecated;
+
+begin
+  StartVisibility(visPublished);
+  AddMember('Property Something : AInterface Read FSomething; deprecated');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','FSomething','','','',0,False,False);
+  AssertNotNull('Have type',Property1.VarType);
+  AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
+  AssertEquals('Property type name','AInterface',Property1.vartype.name);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No default expression',Property1.DefaultExpr);
+  Assertequals('Default value','',Property1.DefaultValue);
+  AssertTrue('Deprecated',[hDeprecated]=Property1.Hints);
+end;
+
+procedure TTestClassType.TestPropertyDeprecatedMessage;
+
+begin
+  StartVisibility(visPublished);
+  AddMember('Property Something : AInterface Read FSomething; deprecated ''this is no longer used'' ');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','FSomething','','','',0,False,False);
+  AssertNotNull('Have type',Property1.VarType);
+  AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
+  AssertEquals('Property type name','AInterface',Property1.vartype.name);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No default expression',Property1.DefaultExpr);
+  Assertequals('Default value','',Property1.DefaultValue);
+  AssertTrue('Deprecated',[hDeprecated]=Property1.Hints);
+end;
+
 procedure TTestClassType.TestPropertyImplementsFullyQualifiedName;
 begin
   StartVisibility(visPublished);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -135,6 +135,9 @@ type
     Procedure TestTypeCast;
     procedure TestTypeCast2;
     Procedure TestCreate;
+    procedure TestChainedPointers;
+    Procedure TestNilCaret;
+    Procedure TestExpCaret;
   end;
 
 implementation
@@ -581,6 +584,47 @@ begin
   ParseExpression('ESDOSerializationException.CreateFmt(SERR_InvalidDataTypeInContext,[IntToStr(Ord(AOwner^.DataType))])');
 end;
 
+procedure TTestExpressions.TestChainedPointers;
+begin
+  // From bug report 31719
+  Source.Add('type');
+  Source.Add('    PTResourceManager=^TResourceManager;');
+  Source.Add('    TResourceManager=object');
+  Source.Add('      function LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    end;');
+  Source.Add('    function TResourceManager.LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    begin');
+  Source.Add('      result:=@self;');
+  Source.Add('    end;');
+  Source.Add('');
+  Source.Add('  var');
+  Source.Add('    ResourceManager:TResourceManager;');
+  Source.Add('');
+  Source.Add('  begin');
+  Source.Add('    ResourceManager.LoadResourceFromFile(''file1'')');
+  Source.Add('                  ^.LoadResourceFromFile(''file2'');');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestNilCaret;
+begin
+  Source.Add('{$mode objfpc}');
+  Source.Add('begin');
+  Source.Add('FillChar(nil^,10,10);');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestExpCaret;
+begin
+  Source.Add('{$mode objfpc}');
+  Source.Add('begin');
+  Source.Add('A:=B^;');
+  Source.Add('end.');
+  ParseModule;
+end;
+
 
 procedure TTestExpressions.TestUnaryMinus;
 begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -369,7 +369,6 @@ type
     Procedure TestClassAssign;
     Procedure TestClassNilAsParam;
     Procedure TestClass_Operators_Is_As;
-    Procedure TestClass_OperatorIsOnNonDescendantFail;
     Procedure TestClass_OperatorIsOnNonTypeFail;
     Procedure TestClass_OperatorAsOnNonDescendantFail;
     Procedure TestClass_OperatorAsOnNonTypeFail;
@@ -498,6 +497,7 @@ type
     Procedure TestArrayEnumTypeConstWrongTypeFail;
     Procedure TestArrayEnumTypeConstNonConstFail;
     Procedure TestArrayEnumTypeSetLengthFail;
+    Procedure TestArray_DynArrayConst;
     Procedure TestArray_AssignNilToStaticArrayFail1;
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_PassArrayElementToVarParam;
@@ -544,6 +544,7 @@ type
     Procedure TestProcType_PropertyCallWrongArgFail;
     Procedure TestProcType_Typecast;
     Procedure TestProcType_InsideFunction;
+    Procedure TestProcType_PassProcToUntyped;
 
     // pointer
     Procedure TestPointer;
@@ -555,6 +556,7 @@ type
 
     // hints
     Procedure TestHint_ElementHints;
+    Procedure TestHint_ElementHintsMsg;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -3508,7 +3510,7 @@ begin
   Add('  case i of');
   Add('  ''1'': ;');
   Add('  end;');
-  CheckResolverException('Incompatible types: got "Longint" expected "Char"',
+  CheckResolverException('Incompatible types: got "Char" expected "Longint"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -3967,10 +3969,11 @@ end;
 procedure TTestResolver.TestProcDuplicate;
 begin
   StartProgram(false);
+  Add('type integer = longint;');
   Add('procedure ProcA(i: longint);');
   Add('begin');
   Add('end;');
-  Add('procedure ProcA(i: longint);');
+  Add('procedure ProcA(i: integer);');
   Add('begin');
   Add('end;');
   Add('begin');
@@ -4254,6 +4257,8 @@ begin
   Add('  exit(''abc'');');
   Add('end;');
   Add('begin');
+  Add('  exit;');
+  Add('  exit(4);');
   ParseProgram;
 end;
 
@@ -5372,27 +5377,12 @@ begin
   Add('begin');
   Add('  if {@o}o is {@A}TClassA then;');
   Add('  if {@v}v is {@A}TClassA then;');
+  Add('  if {@v}v is {@TOBJ}TObject then;');
   Add('  if {@v}v.{@Sub}Sub is {@A}TClassA then;');
   Add('  {@v}v:={@o}o as {@A}TClassA;');
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClass_OperatorIsOnNonDescendantFail;
-begin
-  StartProgram(false);
-  Add('type');
-  Add('  {#TOBJ}TObject = class');
-  Add('  end;');
-  Add('  {#A}TClassA = class');
-  Add('  end;');
-  Add('var');
-  Add('  {#o}{=TOBJ}o: TObject;');
-  Add('  {#v}{=A}v: TClassA;');
-  Add('begin');
-  Add('  if {@v}v is {@TObj}TObject then;');
-  CheckResolverException(sTypesAreNotRelated,PasResolver.nTypesAreNotRelated);
-end;
-
 procedure TTestResolver.TestClass_OperatorIsOnNonTypeFail;
 begin
   StartProgram(false);
@@ -6963,10 +6953,11 @@ procedure TTestResolver.TestProperty1;
 begin
   StartProgram(false);
   Add('type');
+  Add('  integer = longint;');
   Add('  {#TOBJ}TObject = class');
   Add('  end;');
   Add('  {#A}TClassA = class');
-  Add('    {#FB}FB: longint;');
+  Add('    {#FB}FB: integer;');
   Add('    property {#B}B: longint read {@FB}FB write {@FB}FB;');
   Add('  end;');
   Add('var');
@@ -7890,6 +7881,26 @@ begin
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestArray_DynArrayConst;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TArrInt = array of integer;',
+  '  TArrStr = array of string;',
+  'const',
+  '  Ints: TArrInt = (1,2,3);',
+  '  Names: array of string = (''a'',''foo'');',
+  '  Aliases: TarrStr = (''foo'',''b'');',
+  '  OneInt: TArrInt = (7);',
+  '  OneStr: array of integer = (7);',
+  '  Chars: array of char = ''aoc'';',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArray_AssignNilToStaticArrayFail1;
 begin
   StartProgram(false);
@@ -8242,6 +8253,9 @@ begin
   Add('  doi({#h}f());');
   Add('  doi({#i}f(2));');
   Add('  dofconst({#j}f);');
+  Add('  if Assigned({#k}f) then;');
+  Add('  if {#l}f=nil then;');
+  Add('  if nil={#m}f then;');
   ParseProgram;
 
   aMarker:=FirstSrcMarker;
@@ -8951,6 +8965,59 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcType_PassProcToUntyped;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCallWithoutParams: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEvent = procedure of object;',
+  '  TFunc = function: longint of object;',
+  'procedure DoIt; varargs; begin end;',
+  'procedure DoSome(const a; var b; c: pointer); begin end;',
+  'var',
+  '  E: TEvent;',
+  '  F: TFunc;',
+  'begin',
+  '  DoIt({#a1}E,{#a2}F);',
+  '  DoSome({#b1}E,{#b2}E,{#b3}E);',
+  '  DoSome({#c1}F,{#c2}F,{#c3}F);',
+  '']);
+  ParseProgram;
+
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestProcType_PassProcToUntyped ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestProcType_PassProcToUntyped ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        //writeln('TTestResolver.TestProcType_PassProcToUntyped ',GetObjName(Ref.Declaration),' rrfImplicitCallWithoutParams=',rrfImplicitCallWithoutParams in Ref.Flags);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCallWithoutParams:=true;
+        break;
+        end;
+      if ActualImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('expected no implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestPointer;
 begin
   StartProgram(false);
@@ -9094,6 +9161,21 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestHint_ElementHintsMsg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TDeprecated = longint deprecated ''foo'';',
+  'var',
+  '  vDeprecated: TDeprecated;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsDeprecatedY,'Symbol "TDeprecated" is deprecated: ''foo''');
+  CheckResolverUnexpectedHints;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tcscanner.pas

@@ -194,6 +194,7 @@ type
     procedure TestXor;
     procedure TestLineEnding;
     procedure TestTab;
+    Procedure TestEscapedKeyWord;
     Procedure TestTokenSeries;
     Procedure TestTokenSeriesNoWhiteSpace;
     Procedure TestTokenSeriesComments;
@@ -407,6 +408,8 @@ begin
   FResolver.AddStream('afile.pp',TStringStream.Create(Source));
   Writeln('// '+TestName);
   Writeln(Source);
+//  FreeAndNil(FScanner);
+//  FScanner:=TTestingPascalScanner.Create(FResolver);
   FScanner.OpenFile('afile.pp');
 end;
 
@@ -426,7 +429,8 @@ begin
     if (tk=tkLineEnding) and not (t in [tkEOF,tkLineEnding]) then
       tk:=FScanner.FetchToken;
     AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken);
-    end;
+    end
+
 end;
 
 procedure TTestScanner.TestToken(t: TToken; const ASource: String;
@@ -1320,6 +1324,11 @@ begin
   TestToken(tkTab,#9);
 end;
 
+procedure TTestScanner.TestEscapedKeyWord;
+begin
+  TestToken(tkIdentifier,'&xor');
+end;
+
 procedure TTestScanner.TestTokenSeries;
 begin
   TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkthen,tkWhiteSpace,tkIdentifier],'in of then aninteger')

packages/fcl-passrc/tests/tcstatements.pas

@@ -110,11 +110,17 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
-    procedure  TestTryExceptRaise;
+    procedure TestTryExceptRaise;
     Procedure TestAsm;
+    Procedure TestAsmBlock;
+    Procedure TestAsmBlockWithEndLabel;
+    Procedure TestAsmBlockInIfThen;
     Procedure TestGotoInIfThen;
+    procedure AssignToAddress;
+    procedure FinalizationNoSemicolon;
   end;
 
+
 implementation
 
 { TTestStatementParser }
@@ -1647,6 +1653,71 @@ begin
   AssertEquals('token 4 ','1',T.Tokens[3]);
 end;
 
+procedure TTestStatementParser.TestAsmBlock;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function BitsHighest(X: Cardinal): Integer;');
+  Source.Add('asm');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestStatementParser.TestAsmBlockWithEndLabel;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function BitsHighest(X: Cardinal): Integer;');
+  Source.Add('asm');
+  Source.Add('  MOV ECX, EAX');
+  Source.Add('  MOV EAX, -1');
+  Source.Add('  BSR EAX, ECX');
+  Source.Add('  JNZ @@End');
+  Source.Add('  MOV EAX, -1');
+  Source.Add('@@End:');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestStatementParser.TestAsmBlockInIfThen;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function Get8087StatusWord(ClearExceptions: Boolean): Word;');
+  Source.Add('  begin');
+  Source.Add('    if ClearExceptions then');
+  Source.Add('    asm');
+  Source.Add('    end');
+  Source.Add('    else');
+  Source.Add('    asm');
+  Source.Add('    end;');
+  Source.Add('  end;');
+  Source.Add('  begin');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
+Procedure TTestStatementParser.AssignToAddress;
+
+begin
+  AddStatements(['@Proc:=Nil']);
+  ParseModule;
+end;
+
+procedure TTestStatementParser.FinalizationNoSemicolon;
+begin
+  Source.Add('unit afile;');
+  Source.Add('{$mode objfpc}');
+  Source.Add('interface');
+  Source.Add('implementation');
+  Source.Add('initialization');
+  Source.Add('  writeln(''qqq'')');
+  Source.Add('finalization');
+  Source.Add('  writeln(''qqq'')');
+  ParseModule;
+end;
+
 Procedure TTestStatementParser.TestGotoInIfThen;
 
 begin

packages/fcl-passrc/tests/tctypeparser.pas

@@ -161,6 +161,8 @@ type
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
+    procedure TestPointerReference;
+    Procedure TestPointerKeyWord;
   end;
 
   { TTestRecordTypeParser }
@@ -1243,6 +1245,7 @@ end;
 
 procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
 begin
+  if Hints=[] then ;
   AssertEquals('Member 1 type',TPasConst,TObject(TheRecord.Members[0]).ClassType);
   AssertEquals('Const 1 name','x',Const1.Name);
   AssertNotNull('Have 1 const expr',Const1.Expr);
@@ -3313,6 +3316,26 @@ begin
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 
+procedure TTestTypeParser.TestPointerReference;
+begin
+  Add('Type');
+  Add('  pReference = ^Reference;');
+  Add('  Reference = object');
+  Add('  end;');
+  ParseDeclarations;
+  AssertEquals('type definition count',1,Declarations.Types.Count);
+  AssertEquals('object definition count',1,Declarations.Classes.Count);
+end;
+
+procedure TTestTypeParser.TestPointerKeyWord;
+begin
+  Add('type');
+  Add('  &file = object');
+  Add('  end;');
+  ParseDeclarations;
+  AssertEquals('object definition count',1,Declarations.Classes.Count);
+end;
+
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -81,6 +81,7 @@ type
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsedTypecast;
     procedure TestM_Hint_LocalVariableNotUsed;
+    procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
     procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
     procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
@@ -95,6 +96,7 @@ type
     procedure TestM_Hint_LocalClassInProgramNotUsed;
     procedure TestM_Hint_LocalMethodInProgramNotUsed;
     procedure TestM_Hint_AssemblerParameterIgnored;
+    procedure TestM_Hint_AssemblerDelphiParameterIgnored;
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
     procedure TestM_Hint_FunctionResultRecord;
@@ -946,6 +948,22 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var i: longint;',
+  'begin',
+  '  for i:=1 to 2 do ;',
+  'end;',
+  'begin',
+  '  DoIt;',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
 begin
   StartUnit(true);
@@ -1260,6 +1278,32 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_AssemblerDelphiParameterIgnored;
+begin
+  StartProgram(true);
+  Add([
+  '{$mode Delphi}',
+  'procedure DoIt(i: longint);',
+  'type',
+  '  {#tcolor_notused}TColor = longint;',
+  '  {#tflag_notused}TFlag = (red,green);',
+  '  {#tflags_notused}TFlags = set of TFlag;',
+  '  {#tarrint_notused}TArrInt = array of integer;',
+  'const',
+  '  {#a_notused}a = 13;',
+  '  {#b_notused}b: longint = 14;',
+  'var',
+  '  {#c_notused}c: char;',
+  '  {#d_notused}d: longint = 15;',
+  '  procedure {#sub_notused}Sub; begin end;',
+  'asm end;',
+  'begin',
+  '  DoIt(1);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
 begin
   StartProgram(true);

packages/fcl-passrc/tests/tcvarparser.pas

@@ -34,6 +34,7 @@ Type
     procedure TestSimpleVarInitializedDeprecated;
     procedure TestSimpleVarInitializedPlatform;
     Procedure TestVarProcedure;
+    Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
     Procedure TestVarRecordDeprecated;
@@ -187,6 +188,12 @@ begin
   AssertVariableType(TPasProcedureType);
 end;
 
+procedure TTestVarParser.TestVarFunctionINitialized;
+begin
+  ParseVar('function (device: pointer): pointer; cdecl = nil','');
+  AssertVariableType(TPasFunctionType);
+end;
+
 procedure TTestVarParser.TestVarProcedureDeprecated;
 begin
   ParseVar('procedure','deprecated');

packages/pastojs/src/fppas2js.pp

@@ -125,6 +125,7 @@ Works:
   - function copy(array,start=0,count=max): array
   - procedure insert(item,var array,const position)
   - procedure delete(var array,const start,count)
+  - const c: dynarray = (a,b,...)
 - static arrays
   - range: enumtype
   - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
@@ -245,7 +246,10 @@ Works:
   - use 0o for octal literals
 
 ToDos:
-- bark if there is an overload in the same unit with same signature
+- constant evaluation
+- integer ranges
+- static arrays
+- property index specifier
 - RTTI
   - stored false/true
   - class property
@@ -257,9 +261,9 @@ ToDos:
 - make -Jirtl.js default for -Jc and -Tnodejs, needs #IFDEF in cfg
 - FuncName:= (instead of Result:=)
 - $modeswitch -> define <modeswitch>
+- scanner: define list of allowed modeswitches
 - $modeswitch- -> turn off
 - check memleaks
-- integer range
 - @@ compare method in delphi mode
 - make records more lightweight
 - dotted unit names, namespaces
@@ -278,6 +282,7 @@ Not in Version 1.0:
   - array of static array: setlength
   - array range char, char range, integer range, enum range
   - array of const
+  - TestArray_DynArrayConst: Chars: array of char = ''aoc'';
 - sets
   - set of char, boolean, integer range, char range, enum range
 - call array of proc element without ()
@@ -692,8 +697,8 @@ const
 
 const
   ClassVarModifiersType = [vmClass,vmStatic];
-  LowJSNativeInt = -$10000000000000;
-  HighJSNativeInt = $fffffffffffff;
+  LowJSNativeInt = MinSafeIntDouble;
+  HighJSNativeInt = MaxSafeIntDouble;
   LowJSBoolean = false;
   HighJSBoolean = true;
 Type
@@ -774,6 +779,9 @@ type
 //------------------------------------------------------------------------------
 // TPas2JSResolver
 const
+  msAllPas2jsModeSwitches = [msDelphi,msFpc,msObjfpc,
+    msExternalClass,msHintDirective,msNestedComment];
+
   btAllJSBaseTypes = [
     btChar,
     btString,
@@ -848,12 +856,16 @@ type
     procedure FinishVariable(El: TPasVariable); override;
     procedure FinishProcedureType(El: TPasProcedureType); override;
     procedure FinishPropertyOfClass(PropEl: TPasProperty); override;
+    procedure CheckConditionExpr(El: TPasExpr;
+      const ResolvedEl: TPasResolverResult); override;
     procedure CheckNewInstanceFunction(ClassScope: TPas2JSClassScope); virtual;
     function AddExternalName(const aName: string; El: TPasElement): TPasIdentifier; virtual;
     function FindExternalName(const aName: String): TPasIdentifier; virtual;
     procedure AddExternalPath(aName: string; El: TPasElement);
     procedure ClearElementData; virtual;
   protected
+    const
+      cJSValueConversion = 2*cTypeConversion;
     // additional base types
     function AddJSBaseType(const aName: string; Typ: TPas2jsBaseType): TResElDataPas2JSBaseType;
     function IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType): boolean;
@@ -1084,13 +1096,6 @@ type
       end;
       PForLoopFindData = ^TForLoopFindData;
     procedure ForLoop_OnProcBodyElement(El: TPasElement; arg: pointer);
-  private
-    type
-      TTryExceptFindData = record
-        HasRaiseWithoutObject: boolean;
-      end;
-      PTryExceptFindData = ^TTryExceptFindData;
-    procedure TryExcept_OnElement(El: TPasElement; arg: pointer);
   private
     FBuiltInNames: array[TPas2JSBuiltInName] of string;
     FOnIsElementUsed: TPas2JSIsElementUsedEvent;
@@ -1849,7 +1854,7 @@ const
   ClassFieldModifiersAllowed = [vmClass,vmStatic,vmExternal,vmPublic];
   RecordVarModifiersAllowed = [];
   LocalVarModifiersAllowed = [];
-  ImplementationVarModifiersAllowed = [];
+  ImplementationVarModifiersAllowed = [vmExternal];
   SectionVarModifiersAllowed = [vmExternal,vmPublic];
 
   procedure RaiseVarModifierNotSupported(const Allowed: TVariableModifiers);
@@ -2154,6 +2159,14 @@ begin
     end;
 end;
 
+procedure TPas2JSResolver.CheckConditionExpr(El: TPasExpr;
+  const ResolvedEl: TPasResolverResult);
+begin
+  if (ResolvedEl.BaseType=btCustom) and (IsJSBaseType(ResolvedEl,pbtJSValue)) then
+    exit;
+  inherited CheckConditionExpr(El, ResolvedEl);
+end;
+
 procedure TPas2JSResolver.CheckNewInstanceFunction(ClassScope: TPas2JSClassScope
   );
 var
@@ -2318,14 +2331,14 @@ begin
         begin
         // RHS is a value
         if (RHS.BaseType in btAllJSValueSrcTypes) then
-          Result:=cExact+1 // type cast to JSValue
+          Result:=cJSValueConversion // type cast to JSValue
         else if RHS.BaseType=btCustom then
           begin
           if IsJSBaseType(RHS,pbtJSValue) then
             Result:=cExact;
           end
         else if RHS.BaseType=btContext then
-          Result:=cExact+1;
+          Result:=cJSValueConversion;
         end
       else if RHS.BaseType=btContext then
         begin
@@ -2333,7 +2346,7 @@ begin
         if RHS.IdentEl<>nil then
           begin
           if RHS.IdentEl.ClassType=TPasClassType then
-            Result:=cExact+1; // RHS is a class type
+            Result:=cJSValueConversion; // RHS is a class type
           end;
         end;
       end;
@@ -2351,7 +2364,7 @@ begin
       begin
       // array of jsvalue := array
       Handled:=true;
-      Result:=cExact+1;
+      Result:=cJSValueConversion;
       end;
     end;
 
@@ -2370,7 +2383,7 @@ begin
   ClassScope:=ToClass.CustomData as TPasClassScope;
   if ClassScope.AncestorScope=nil then
     // type cast to root class
-    Result:=cExact+1
+    Result:=cTypeConversion+1
   else
     Result:=cIncompatible;
   if ErrorEl=nil then ;
@@ -2402,14 +2415,14 @@ begin
         if (rrfReadable in RHS.Flags) then
           begin
           if RHS.BaseType in btAllJSValueSrcTypes then
-            Result:=cExact
+            Result:=cJSValueConversion
           else if RHS.BaseType=btCustom then
             begin
             if IsJSBaseType(RHS,pbtJSValue) then
               Result:=cExact;
             end
           else if RHS.BaseType=btContext then
-            Result:=cExact+1;
+            Result:=cJSValueConversion;
           end
         else if RHS.BaseType=btContext then
           begin
@@ -2417,7 +2430,7 @@ begin
           if RHS.IdentEl<>nil then
             begin
             if RHS.IdentEl.ClassType=TPasClassType then
-              Result:=cExact+1; // RHS is a class
+              Result:=cJSValueConversion; // RHS is a class
             end;
           end;
         end;
@@ -4976,7 +4989,7 @@ var
 
       OldAccess:=ArgContext.Access;
       ArgContext.Access:=caRead;
-      Bracket.Name:=ConvertElement(El.Params[0],AContext);
+      Bracket.Name:=ConvertElement(El.Params[0],ArgContext);
       ArgContext.Access:=OldAccess;
       ConvertArrayParams:=Bracket;
       Bracket:=nil;
@@ -4985,7 +4998,7 @@ var
     end;
   end;
 
-  procedure ConvertIndexProperty(Prop: TPasProperty; AContext: TConvertContext);
+  procedure ConvertIndexedProperty(Prop: TPasProperty; AContext: TConvertContext);
   var
     Call: TJSCallExpression;
     i: Integer;
@@ -5040,7 +5053,7 @@ var
         if TargetArg.ValueExpr=nil then
           begin
           {$IFDEF VerbosePas2JS}
-          writeln('TPasToJSConverter.ConvertArrayParams.ConvertIndexProperty missing default value: Prop=',Prop.Name,' i=',i);
+          writeln('TPasToJSConverter.ConvertArrayParams.ConvertIndexedProperty missing default value: Prop=',Prop.Name,' i=',i);
           {$ENDIF}
           RaiseInconsistency(20170206185126);
           end;
@@ -5121,7 +5134,7 @@ var
 
       DotContext:=TDotContext.Create(El.Value,Left,AContext);
       DotContext.LeftResolved:=ResolvedEl;
-      ConvertIndexProperty(Prop,DotContext);
+      ConvertIndexedProperty(Prop,DotContext);
       Right:=Result;
       Result:=nil;
     finally
@@ -5179,7 +5192,7 @@ begin
     ConvertStringBracket
   else if (ResolvedEl.IdentEl is TPasProperty)
       and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
-    ConvertIndexProperty(TPasProperty(ResolvedEl.IdentEl),AContext)
+    ConvertIndexedProperty(TPasProperty(ResolvedEl.IdentEl),AContext)
   else if ResolvedEl.BaseType=btContext then
     begin
     TypeEl:=ResolvedEl.TypeEl;
@@ -6000,7 +6013,8 @@ begin
     begin
     // without parameter.
     ProcEl:=El.Parent;
-    while not (ProcEl is TPasProcedure) do ProcEl:=ProcEl.Parent;
+    while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
+      ProcEl:=ProcEl.Parent;
     if ProcEl is TPasFunction then
       // in a function, "return result;"
       TJSReturnStatement(Result).Expr:=CreateBuiltInIdentifierExpr(ResolverResultVar)
@@ -6788,8 +6802,6 @@ var
   Param: TPasExpr;
   ResultEl: TPasResultElement;
   TypeEl: TPasType;
-  Call: TJSCallExpression;
-  NeedCall: Boolean;
 begin
   Result:=nil;
   Param:=El.Params[0];
@@ -6797,7 +6809,6 @@ begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertBuiltIn_TypeInfo ',GetResolverResultDbg(ParamResolved));
   {$ENDIF}
-  NeedCall:=false;
   if (ParamResolved.BaseType=btProc) and (ParamResolved.IdentEl is TPasFunction) then
     begin
     // typeinfo(function) ->
@@ -6808,7 +6819,6 @@ begin
     {$ENDIF}
     Include(ParamResolved.Flags,rrfReadable);
     ParamResolved.IdentEl:=ResultEl;
-    NeedCall:=true;
     end;
   TypeEl:=AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl);
   if TypeEl=nil then
@@ -6825,14 +6835,6 @@ begin
     // typeinfo(classinstance) -> classinstance.$rtti
     // typeinfo(classof) -> classof.$rtti
     Result:=ConvertElement(Param,AContext);
-    if NeedCall then
-      begin
-      // typeinfo(afunction:class) -> afunction().$rtti
-      // typeinfo(afucntion:classof) -> afunction().$rtti
-      Call:=TJSCallExpression(CreateElement(TJSCallExpression,El));
-      Call.Expr:=Result;
-      Result:=Call;
-      end;
     Result:=CreateDotExpression(El,Result,CreateBuiltInIdentifierExpr(FBuiltInNames[pbivnRTTI]));
     end
   else
@@ -7422,7 +7424,10 @@ begin
       Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClass]]);
 
     // add parameter: owner. For top level class, the module is the owner.
-    OwnerName:=AContext.GetLocalName(El.GetModule);
+    if (El.Parent<>nil) and (El.Parent.ClassType=TImplementationSection) then
+      OwnerName:=AContext.GetLocalName(El.Parent)
+    else
+      OwnerName:=AContext.GetLocalName(El.GetModule);
     if OwnerName='' then
       OwnerName:='this';
     Call.AddArg(CreateBuiltInIdentifierExpr(OwnerName));
@@ -7984,14 +7989,6 @@ begin
     end;
 end;
 
-procedure TPasToJSConverter.TryExcept_OnElement(El: TPasElement; arg: pointer);
-var
-  Data: PTryExceptFindData absolute arg;
-begin
-  if (El is TPasImplRaise) and (TPasImplRaise(El).ExceptObject=nil) then
-    Data^.HasRaiseWithoutObject:=true;
-end;
-
 procedure TPasToJSConverter.SetUseEnumNumbers(const AValue: boolean);
 begin
   if AValue then
@@ -8244,20 +8241,6 @@ end;
 
 function TPasToJSConverter.ConvertTryStatement(El: TPasImplTry;
   AContext: TConvertContext): TJSElement;
-
-  function NeedExceptObject: boolean;
-  var
-    Data: TTryExceptFindData;
-  begin
-    Result:=false;
-    if El.FinallyExcept.Elements.Count=0 then exit;
-    if TPasElement(El.FinallyExcept.Elements[0]) is TPasImplExceptOn then
-      exit(true);
-    Data:=Default(TTryExceptFindData);
-    El.FinallyExcept.ForEachCall(@TryExcept_OnElement,@Data);
-    Result:=Data.HasRaiseWithoutObject;
-  end;
-
 Var
   T : TJSTryStatement;
   ExceptBlock: TPasImplTryHandler;
@@ -8279,9 +8262,8 @@ begin
       begin
       T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El));
       T.Block:=ConvertImplBlockElements(El,AContext,true);
-      if NeedExceptObject then
-        T.Ident:=TJSString(FBuiltInNames[pbivnExceptObject]);
-      //T.BCatch:=ConvertElement(El.FinallyExcept,AContext);
+      // always set the catch except object, needed by nodejs
+      T.Ident:=TJSString(FBuiltInNames[pbivnExceptObject]);
       ExceptBlock:=El.FinallyExcept;
       if (ExceptBlock.Elements.Count>0)
           and (TPasImplElement(ExceptBlock.Elements[0]) is TPasImplExceptOn) then
@@ -10519,7 +10501,7 @@ var
 begin
   Result:='';
   {$IFDEF VerbosePas2JS}
-  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' ',GetObjName(AContext.GetThis));
+  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
   //AContext.WriteStack;
   {$ENDIF}
 

packages/pastojs/tests/tcconverter.pp

@@ -604,6 +604,7 @@ Var
   F : TPasImplTryExcept;
   El : TJSTryCatchStatement;
   L : TJSStatementList;
+  ExceptObjName: String;
 
 begin
   // Try a:=b except b:=c end;
@@ -611,7 +612,7 @@ begin
     Becomes:
     try {
      a=b;
-    } catch {
+    } catch ($e) {
       b = c;
     }
   *)
@@ -621,7 +622,9 @@ begin
   F.AddElement(CreateAssignStatement('b','c'));
   // Convert
   El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('No exception object name','',String(El.Ident));
+  // check "catch(exceptobject)"
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
   // check "a=b;"
   L:=AssertListStatement('try..except block is statement list',El.Block);
   AssertAssignStatement('Correct assignment in try..except block',L.A,'a','b');

packages/pastojs/tests/tcmodules.pas

@@ -297,9 +297,10 @@ type
     Procedure TestArray_Concat;
     Procedure TestArray_Copy;
     Procedure TestArray_InsertDelete;
+    Procedure TestArray_DynArrayConst;
     Procedure TestExternalClass_TypeCastArrayToExternalArray;
     Procedure TestExternalClass_TypeCastArrayFromExternalArray;
-    // ToDo: array const
+    // ToDo: static array const
     // ToDo: SetLength(array of static array)
     // ToDo: SetLength(dim1,dim2)
 
@@ -320,6 +321,7 @@ type
     Procedure TestClass_TObjectConstructorWithParams;
     Procedure TestClass_Var;
     Procedure TestClass_Method;
+    Procedure TestClass_Implementation;
     Procedure TestClass_Inheritance;
     Procedure TestClass_AbstractMethod;
     Procedure TestClass_CallInherited_NoParams;
@@ -403,6 +405,7 @@ type
     Procedure TestExternalClass_BracketAccessor_ReadOnly;
     Procedure TestExternalClass_BracketAccessor_WriteOnly;
     Procedure TestExternalClass_BracketAccessor_MultiType;
+    Procedure TestExternalClass_BracketAccessor_Index;
 
     // proc types
     Procedure TestProcType;
@@ -419,6 +422,7 @@ type
     Procedure TestProcType_ReferenceToProc;
     Procedure TestProcType_ReferenceToMethod;
     Procedure TestProcType_Typecast;
+    Procedure TestProcType_PassProcToUntyped;
 
     // pointer
     Procedure TestPointer;
@@ -426,11 +430,13 @@ type
     Procedure TestPointer_AssignRecordFail;
     Procedure TestPointer_AssignStaticArrayFail;
     Procedure TestPointer_ArrayParamsFail;
+    Procedure TestPointer_TypeCastJSValueToPointer;
 
     // jsvalue
     Procedure TestJSValue_AssignToJSValue;
     Procedure TestJSValue_TypeCastToBaseType;
     Procedure TestJSValue_Equal;
+    Procedure TestJSValue_If;
     Procedure TestJSValue_Enum;
     Procedure TestJSValue_ClassInstance;
     Procedure TestJSValue_ClassOf;
@@ -441,6 +447,12 @@ type
     Procedure TestJSValue_ProcType_Assign;
     Procedure TestJSValue_ProcType_Equal;
     Procedure TestJSValue_AssignToPointerFail;
+    Procedure TestJSValue_OverloadDouble;
+    Procedure TestJSValue_OverloadNativeInt;
+    Procedure TestJSValue_OverloadWord;
+    Procedure TestJSValue_OverloadString;
+    Procedure TestJSValue_OverloadChar;
+    Procedure TestJSValue_OverloadPointer;
 
     // RTTI
     Procedure TestRTTI_ProcType;
@@ -640,6 +652,7 @@ begin
   FFileResolver:=TStreamResolver.Create;
   FFileResolver.OwnsStreams:=True;
   FScanner:=TPascalScanner.Create(FFileResolver);
+  FScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
   FEngine:=AddModule(Filename);
   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
   Parser.Options:=Parser.Options+po_pas2js;
@@ -2096,6 +2109,8 @@ begin
   Add('  exit(''abc'');');
   Add('end;');
   Add('begin');
+  Add('  exit;');
+  Add('  exit(1);');
   ConvertProgram;
   CheckSource('TestExit',
     LinesToStr([ // statements
@@ -2116,7 +2131,10 @@ begin
     '  return Result;',
     '};'
     ]),
-    '');
+    LinesToStr([
+    'return;',
+    'return 1;',
+    '']));
 end;
 
 procedure TTestModule.TestBreak;
@@ -3549,7 +3567,7 @@ begin
   Add('implementation');
   Add('var');
   Add('  d: double;');
-  Add('  i: longint;');
+  Add('  i: longint; external name ''$i'';');
   Add('begin');
   Add('  d:=nan;');
   Add('  d:=uNit2.nan;');
@@ -3566,13 +3584,12 @@ begin
     '$impl.d = Global.NaN;',
     '$impl.d = Global.NaN;',
     '$impl.d = Global.NaN;',
-    '$impl.i = pas.unit2.iV;',
-    '$impl.i = pas.unit2.iV;',
-    '$impl.i = pas.unit2.iV;',
+    '$i = pas.unit2.iV;',
+    '$i = pas.unit2.iV;',
+    '$i = pas.unit2.iV;',
     '']),
     LinesToStr([ // implementation
     '$impl.d = 0.0;',
-    '$impl.i = 0;',
     '']) );
 end;
 
@@ -4381,7 +4398,7 @@ begin
     LinesToStr([ // $mod.$main
     'try {',
     '  $mod.vI = 1;',
-    '} catch {',
+    '} catch ($e) {',
     '  $mod.vI = 2;',
     '};',
     'try {',
@@ -5193,6 +5210,36 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_DynArrayConst;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TArrInt = array of integer;',
+  '  TArrStr = array of string;',
+  'const',
+  '  Ints: TArrInt = (1,2,3);',
+  '  Names: array of string = (''a'',''foo'');',
+  '  Aliases: TarrStr = (''foo'',''b'');',
+  '  OneInt: TArrInt = (7);',
+  '  OneStr: array of integer = (7);',
+  //'  Chars: array of char = ''aoc'';',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_DynArrayConst',
+    LinesToStr([ // statements
+    'this.Ints = [1, 2, 3];',
+    'this.Names = ["a", "foo"];',
+    'this.Aliases = ["foo", "b"];',
+    'this.OneInt = [7];',
+    'this.OneStr = [7];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_TypeCastArrayToExternalArray;
 begin
   StartProgram(false);
@@ -5905,6 +5952,74 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClass_Implementation;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'implementation',
+  'type',
+  '  TIntClass = class',
+  '    constructor Create; reintroduce;',
+  '    class procedure DoGlob;',
+  '  end;',
+  'constructor tintclass.create;',
+  'begin',
+  '  inherited;',
+  '  inherited create;',
+  '  doglob;',
+  'end;',
+  'class procedure tintclass.doglob;',
+  'begin',
+  'end;',
+  'constructor tobject.create;',
+  'var',
+  '  iC: tintclass;',
+  'begin',
+  '  ic:=tintclass.create;',
+  '  tintclass.doglob;',
+  '  ic.doglob;',
+  'end;',
+  'initialization',
+  '  tintclass.doglob;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestClass_Implementation',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '    var iC = null;',
+    '    iC = $impl.TIntClass.$create("Create$1");',
+    '    $impl.TIntClass.DoGlob();',
+    '    iC.$class.DoGlob();',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$impl.TIntClass.DoGlob();',
+    '']),
+    LinesToStr([
+    'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
+    '  this.Create$1 = function () {',
+    '    $mod.TObject.Create.apply(this, arguments);',
+    '    $mod.TObject.Create.call(this);',
+    '    this.$class.DoGlob();',
+    '  };',
+    '  this.DoGlob = function () {',
+    '  };',
+    '});',
+    '']));
+end;
+
 procedure TTestModule.TestClass_Inheritance;
 begin
   StartProgram(false);
@@ -9413,7 +9528,7 @@ begin
   Add('  with arr do items[9]:=items[10];');
   Add('  doit(arr[7],arr[8],arr[9],arr[10]);');
   ConvertProgram;
-  CheckSource('TestExternalClass_BracketOperator',
+  CheckSource('TestExternalClass_BracketAccessor',
     LinesToStr([ // statements
     'this.DoIt = function (vI, vJ, vK, vL) {',
     '};',
@@ -9583,6 +9698,40 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_BracketAccessor_Index;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
+  Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  i: longint;');
+  Add('  IntArr: array of longint;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  v:=arr.items[i];');
+  Add('  arr[longint(v)]:=arr.items[intarr[0]];');
+  Add('  arr.items[intarr[1]]:=arr[IntArr[2]];');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_Index',
+    LinesToStr([ // statements
+    'this.Arr = null;',
+    'this.i = 0;',
+    'this.IntArr = [];',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.Arr[$mod.i];',
+    '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
+    '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);
@@ -9611,6 +9760,7 @@ begin
   Add('  b:=vp<>@doit;');
   Add('  b:=@doit<>vp;');
   Add('  b:=Assigned(vp);');
+  Add('  if Assigned(vp) then ;');
   ConvertProgram;
   CheckSource('TestProcType',
     LinesToStr([ // statements
@@ -9638,6 +9788,7 @@ begin
     '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
     '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
     '$mod.b = $mod.vP != null;',
+    'if ($mod.vP != null) ;',
     '']));
 end;
 
@@ -10607,37 +10758,50 @@ end;
 procedure TTestModule.TestProcType_Typecast;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TNotifyEvent = procedure(Sender: Pointer) of object;');
-  Add('  TEvent = procedure of object;');
-  Add('  TProcA = procedure(i: longint);');
-  Add('  TFuncB = function(i, j: longint): longint;');
-  Add('var');
-  Add('  Notify: TNotifyEvent;');
-  Add('  Event: TEvent;');
-  Add('  ProcA: TProcA;');
-  Add('  FuncB: TFuncB;');
-  Add('  p: pointer;');
-  Add('begin');
-  Add('  Notify:=TNotifyEvent(Event);');
-  Add('  Event:=TEvent(Event);');
-  Add('  Event:=TEvent(Notify);');
-  Add('  ProcA:=TProcA(FuncB);');
-  Add('  FuncB:=TFuncB(FuncB);');
-  Add('  FuncB:=TFuncB(ProcA);');
-  Add('  ProcA:=TProcA(p);');
-  Add('  FuncB:=TFuncB(p);');
-  Add('  p:=Pointer(Notify);');
-  Add('  p:=Notify;');
-  Add('  p:=Pointer(ProcA);');
-  Add('  p:=ProcA;');
-  Add('  p:=Pointer(FuncB);');
-  Add('  p:=FuncB;');
+  Add([
+  'type',
+  '  TNotifyEvent = procedure(Sender: Pointer) of object;',
+  '  TEvent = procedure of object;',
+  '  TGetter = function:longint of object;',
+  '  TProcA = procedure(i: longint);',
+  '  TFuncB = function(i, j: longint): longint;',
+  'procedure DoIt(); varargs; begin end;',
+  'var',
+  '  Notify: tnotifyevent;',
+  '  Event: tevent;',
+  '  Getter: tgetter;',
+  '  ProcA: tproca;',
+  '  FuncB: tfuncb;',
+  '  p: pointer;',
+  'begin',
+  '  notify:=tnotifyevent(event);',
+  '  event:=tevent(event);',
+  '  event:=tevent(notify);',
+  '  event:=tevent(getter);',
+  '  event:=tevent(proca);',
+  '  proca:=tproca(funcb);',
+  '  funcb:=tfuncb(funcb);',
+  '  funcb:=tfuncb(proca);',
+  '  funcb:=tfuncb(getter);',
+  '  proca:=tproca(p);',
+  '  funcb:=tfuncb(p);',
+  '  getter:=tgetter(p);',
+  '  p:=pointer(notify);',
+  '  p:=notify;',
+  '  p:=pointer(proca);',
+  '  p:=proca;',
+  '  p:=pointer(funcb);',
+  '  p:=funcb;',
+  '  doit(Pointer(notify),pointer(event),pointer(proca));',
+  '']);
   ConvertProgram;
   CheckSource('TestProcType_Typecast',
     LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '};',
     'this.Notify = null;',
     'this.Event = null;',
+    'this.Getter = null;',
     'this.ProcA = null;',
     'this.FuncB = null;',
     'this.p = null;',
@@ -10646,17 +10810,72 @@ begin
     '$mod.Notify = $mod.Event;',
     '$mod.Event = $mod.Event;',
     '$mod.Event = $mod.Notify;',
+    '$mod.Event = $mod.Getter;',
+    '$mod.Event = $mod.ProcA;',
     '$mod.ProcA = $mod.FuncB;',
     '$mod.FuncB = $mod.FuncB;',
     '$mod.FuncB = $mod.ProcA;',
+    '$mod.FuncB = $mod.Getter;',
     '$mod.ProcA = $mod.p;',
     '$mod.FuncB = $mod.p;',
+    '$mod.Getter = $mod.p;',
     '$mod.p = $mod.Notify;',
     '$mod.p = $mod.Notify;',
     '$mod.p = $mod.ProcA;',
     '$mod.p = $mod.ProcA;',
     '$mod.p = $mod.FuncB;',
     '$mod.p = $mod.FuncB;',
+    '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_PassProcToUntyped;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEvent = procedure of object;',
+  '  TFunc = function: longint;',
+  'procedure DoIt(); varargs; begin end;',
+  'procedure DoSome(const a; var b; p: pointer); begin end;',
+  'var',
+  '  Event: tevent;',
+  '  Func: TFunc;',
+  'begin',
+  '  doit(event,func);',
+  '  dosome(event,event,event);',
+  '  dosome(func,func,func);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_PassProcToUntyped',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '};',
+    'this.DoSome = function (a, b, p) {',
+    '};',
+    'this.Event = null;',
+    'this.Func = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.Event, $mod.Func);',
+    '$mod.DoSome($mod.Event, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Event;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.Event = v;',
+    '    }',
+    '}, $mod.Event);',
+    '$mod.DoSome($mod.Func, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Func;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.Func = v;',
+    '    }',
+    '}, $mod.Func);',
     '']));
 end;
 
@@ -10794,6 +11013,33 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(args: array of jsvalue); begin end;',
+  'procedure DoAll; varargs; begin end;',
+  'var',
+  '  v: jsvalue;',
+  'begin',
+  '  DoIt([pointer(v)]);',
+  '  DoAll(pointer(v));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestPointer_TypeCastJSValueToPointer',
+    LinesToStr([ // statements
+    'this.DoIt = function (args) {',
+    '};',
+    'this.DoAll = function () {',
+    '};',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt([$mod.v]);',
+    '$mod.DoAll($mod.v);',
+    '']));
+end;
+
 procedure TTestModule.TestJSValue_AssignToJSValue;
 begin
   StartProgram(false);
@@ -10986,6 +11232,31 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestJSValue_If;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  v: jsvalue;',
+  'begin',
+  '  if v then ;',
+  '  while v do ;',
+  '  repeat until v;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_If',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.v) ;',
+    'while($mod.v){',
+    '};',
+    'do{',
+    '} while(!$mod.v);',
+    '']));
+end;
+
 procedure TTestModule.TestJSValue_Enum;
 begin
   StartProgram(false);
@@ -11505,6 +11776,317 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestJSValue_OverloadDouble;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  tdatetime = double;',
+  'procedure DoIt(d: double); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadDouble',
+    LinesToStr([ // statements
+    'this.DoIt = function (d) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.d);',
+    '$mod.DoIt($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadNativeInt;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(n: nativeint); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadNativeInt',
+    LinesToStr([ // statements
+    'this.DoIt = function (n) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadWord;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(w: word); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadWord',
+    LinesToStr([ // statements
+    'this.DoIt = function (w) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt$1($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt$1($mod.smi);',
+    '$mod.DoIt$1($mod.lw);',
+    '$mod.DoIt$1($mod.li);',
+    '$mod.DoIt$1($mod.ni);',
+    '$mod.DoIt$1($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadString;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(s: string); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadString',
+    LinesToStr([ // statements
+    'this.DoIt = function (s) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadChar;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(c: char); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadChar',
+    LinesToStr([ // statements
+    'this.DoIt = function (c) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt$1($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadPointer;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  'procedure DoIt(p: pointer); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  DoIt(o);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadPointer',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (p) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.o);',
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_ProcType;
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
@@ -12119,11 +12701,11 @@ begin
   Add('  protected');
   Add('    FFlag: longint;');
   Add('  published');
-  Add('    property Flag: longint read FFlag;');
+  Add('    property Flag: longint read fflag;');
   Add('  end;');
   Add('  TSky = class');
   Add('  published');
-  Add('    property Flag: longint write FFlag;');
+  Add('    property FLAG: longint write fflag;');
   Add('  end;');
   Add('begin');
   ConvertProgram;