# revisions: 44169,44173,44201,44202,44203,44207,44208,44219,44220,44238,44292,44387,44388,44431,44432,44437,44684,45054,45069,45121,45123,45293,45294,45295,45296,45297,45309,45315,45321,45335,45349,45369,45374,45392,45414,45416,45417,45418,45419,45423,45427,45431,45432,45433,45434,45435,45442,45443,45445,45461,45462,45464,45471,45472,45473,45505,45506,45507,45508,45512,45513,45514,45515,45516,45517,45518,45523,45526,45530,45531,45535,45537,45538,45545,45562

git-svn-id: branches/fixes_3_2@46823 -

.gitattributes

@@ -8655,6 +8655,7 @@ packages/rtl-generics/tests/testrunner.rtlgenerics.lpi svneol=native#text/plain
 packages/rtl-generics/tests/testrunner.rtlgenerics.pp svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.arrayhelper.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.bugs.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.dictionary.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.hashmaps.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.sets.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.stdcollections.pas svneol=native#text/pascal

packages/fcl-js/src/jssrcmap.pas

@@ -38,7 +38,7 @@ uses
   {$ifdef pas2js}
   JS,
     {$ifdef nodejs}
-    NodeJSFS,
+    Node.FS,
     {$endif}
   {$else}
   contnrs,

packages/fcl-js/src/jstoken.pp

@@ -48,7 +48,8 @@ type
      tjsSWITCH,
      tjsTHIS, tjsTHROW, tjsTrue, tjsTRY, tjsTYPEOF,
      tjsVAR, tjsVOID,
-     tjsWHILE, tjsWITH
+     tjsWHILE, tjsWITH,
+     tjsAWAIT
    );
 
 const
@@ -83,7 +84,8 @@ const
      'switch',
      'this', 'throw', 'true', 'try', 'typeof',
      'var', 'void',
-     'while', 'with'
+     'while', 'with',
+     'await'
     );
 
 

packages/fcl-js/src/jstree.pp

@@ -126,6 +126,7 @@ Type
   TJSFuncDef = Class(TJSObject)
   private
     FBody: TJSFunctionBody;
+    FIsAsync: Boolean;
     FIsEmpty: Boolean;
     FName: TJSString;
     FParams: TStrings;
@@ -137,6 +138,7 @@ Type
     Property Body : TJSFunctionBody Read FBody Write FBody; // can be nil
     Property Name : TJSString Read FName Write FName;
     Property IsEmpty : Boolean Read FIsEmpty Write FIsEmpty;
+    Property IsAsync : Boolean Read FIsAsync Write FIsAsync;
   end;
 
   { TJSElement }
@@ -383,6 +385,13 @@ Type
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
+  { TJSAwaitExpression - e.g. 'await A' }
+
+  TJSAwaitExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; Override;
+  end;
+
   { TJSUnaryPrePlusPlusExpression - e.g. '++A' }
 
   TJSUnaryPrePlusPlusExpression = Class(TJSUnaryExpression)
@@ -1514,6 +1523,13 @@ begin
   Result:=tjsTypeOf;
 end;
 
+{ TJSAwaitExpression }
+
+class function TJSAwaitExpression.PrefixOperatorToken: tjsToken;
+begin
+  Result:=tjsAwait;
+end;
+
 { TJSUnaryDeleteExpression }
 
 Class function TJSUnaryDeleteExpression.PrefixOperatorToken : tjsToken;
@@ -1705,7 +1721,7 @@ begin
   else
     begin
     Result:=TokenInfos[t];
-    if t in [tjsTypeOf,tjsVoid,tjsDelete,tjsThrow] then
+    if t in [tjsTypeOf,tjsVoid,tjsDelete,tjsThrow,tjsAwait] then
       Result:=Result+' ';
     end;
 end;

packages/fcl-js/src/jswriter.pp

@@ -927,6 +927,8 @@ Var
 begin
   LastEl:=Writer.CurElement;
   C:=(woCompact in Options);
+  if fd.IsAsync then
+    Write('async ');
   Write('function ');
   If (FD.Name<>'') then
     Write(FD.Name);
@@ -1228,9 +1230,46 @@ procedure TJSWriter.WriteStatementList(El: TJSStatementList);
 
 Var
   C : Boolean;
-  B : Boolean;
   LastEl: TJSElement;
+  ElStack: array of TJSElement;
+  ElStackIndex: integer;
+
+  procedure WriteNonListEl(CurEl: TJSElement);
+  begin
+    if IsEmptyStatement(CurEl) then exit;
+    if (LastEl<>nil) then
+      begin
+      if FLastChar<>';' then
+        Write(';');
+      if C then
+        Write(' ')
+      else
+        Writeln('');
+      end;
+    WriteJS(CurEl);
+    LastEl:=CurEl;
+  end;
+
+  procedure Push(CurEl: TJSElement);
+  begin
+    if CurEl=nil then exit;
+    if ElStackIndex=length(ElStack) then
+      SetLength(ElStack,ElStackIndex+8);
+    ElStack[ElStackIndex]:=CurEl;
+    inc(ElStackIndex);
+  end;
 
+  function Pop: TJSElement;
+  begin
+    if ElStackIndex=0 then exit(nil);
+    dec(ElStackIndex);
+    Result:=ElStack[ElStackIndex];
+  end;
+
+var
+  B : Boolean;
+  CurEl: TJSElement;
+  List: TJSStatementList;
 begin
   //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipCurlyBrackets,true));
   //if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
@@ -1239,43 +1278,55 @@ begin
 
   C:=(woCompact in Options);
   B:= Not FSkipCurlyBrackets;
+  FSkipCurlyBrackets:=True;
   if B then
     begin
     Write('{');
     Indent;
     if not C then writeln('');
     end;
-  if not IsEmptyStatement(El.A) then
+
+  // traverse statementlist using a heap stack to avoid large stack depths
+  LastEl:=nil;
+  ElStackIndex:=0;
+  CurEl:=El;
+  while CurEl<>nil do
     begin
-    WriteJS(El.A);
-    LastEl:=El.A;
-    if Assigned(El.B) then
+    if CurEl is TJSStatementList then
       begin
-      if not (LastEl is TJSStatementList) then
+      List:=TJSStatementList(CurEl);
+      if List.A is TJSStatementList then
         begin
-        if FLastChar<>';' then
-          Write(';');
-        if C then
-          Write(' ')
+        Push(List.B);
+        CurEl:=List.A;
+        end
+      else
+        begin
+        WriteNonListEl(List.A);
+        if List.B is TJSStatementList then
+          CurEl:=List.B
         else
-          Writeln('');
+          begin
+          WriteNonListEl(List.B);
+          CurEl:=nil;
+          end;
         end;
-      FSkipCurlyBrackets:=True;
-      WriteJS(El.B);
-      LastEl:=El.B;
+      end
+    else
+      begin
+      WriteNonListEl(CurEl);
+      CurEl:=nil;
       end;
-    if (not C) and not (LastEl is TJSStatementList) then
-      writeln(';');
-    end
-  else if Assigned(El.B) and not IsEmptyStatement(El.B) then
-    begin
-    WriteJS(El.B);
-    if (not C) and not (El.B is TJSStatementList) then
-      if FLastChar=';' then
-        writeln('')
-      else
-        writeln(';');
+    if CurEl=nil then
+      CurEl:=Pop;
     end;
+
+  if (LastEl<>nil) and not C then
+    if FLastChar=';' then
+      writeln('')
+    else
+      writeln(';');
+
   if B then
     begin
     Undent;

packages/fcl-js/tests/tcwriter.pp

@@ -157,6 +157,7 @@ type
     Procedure TestStatementListOneStatementCompact;
     Procedure TestStatementListTwoStatements;
     Procedure TestStatementListTwoStatementsCompact;
+    Procedure TestStatementListTree4;
     Procedure TestStatementListFor;
     Procedure TestEmptyFunctionDef;
     Procedure TestEmptyFunctionDefCompact;
@@ -166,6 +167,7 @@ type
     Procedure TestFunctionDefBody1Compact;
     Procedure TestFunctionDefBody2;
     Procedure TestFunctionDefBody2Compact;
+    Procedure TestFunctionDefAsync;
     Procedure TestTryCatch;
     Procedure TestTryCatchCompact;
     Procedure TestTryFinally;
@@ -192,6 +194,7 @@ type
     Procedure TestUnaryDelete;
     Procedure TestUnaryVoid;
     Procedure TestUnaryTypeOf;
+    Procedure TestUnaryAwait;
     Procedure TestPrefixPlusPLus;
     Procedure TestPrefixMinusMinus;
     Procedure TestUnaryMinus;
@@ -346,6 +349,11 @@ begin
   TestUnary('typeof expresssion',TJSUnaryTypeOfExpression,'typeof a');
 end;
 
+procedure TTestExpressionWriter.TestUnaryAwait;
+begin
+  TestUnary('await expresssion',TJSAwaitExpression,'await a');
+end;
+
 procedure TTestExpressionWriter.TestPrefixPlusPLus;
 begin
   TestUnary('prefix ++ expresssion',TJSUnaryPrePlusPlusExpression,'++a');
@@ -1696,6 +1704,29 @@ begin
   AssertWrite('Statement list','{a=b; a=b}',S);
 end;
 
+procedure TTestStatementWriter.TestStatementListTree4;
+var
+  S1, S11, S12: TJSStatementList;
+begin
+  Writer.Options:=[woUseUTF8];
+  S1:=TJSStatementList.Create(0,0);
+  S11:=TJSStatementList.Create(0,0);
+  S1.A:=S11;
+  S12:=TJSStatementList.Create(0,0);
+  S1.B:=S12;
+  S11.A:=CreateAssignment(nil);
+  S11.B:=CreateAssignment(nil);
+  S12.A:=CreateAssignment(nil);
+  S12.B:=CreateAssignment(nil);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S1);
+end;
+
 procedure TTestStatementWriter.TestStatementListFor;
 Var
   S : TJSStatementList;
@@ -1878,6 +1909,21 @@ begin
   AssertWrite('Function, 2 statements, compact','function a(b) {b=b*10; return b}',FD);
 end;
 
+procedure TTestStatementWriter.TestFunctionDefAsync;
+
+Var
+  FD : TJSFunctionDeclarationStatement;
+
+begin
+  FD:=TJSFunctionDeclarationStatement.Create(0,0);
+  FD.AFunction:=TJSFuncDef.Create;
+  FD.AFunction.IsAsync:=true;
+  FD.AFunction.Name:='a';
+  AssertWrite('Async function',
+     'async function a() {'+sLineBreak
+    +'}',FD);
+end;
+
 procedure TTestStatementWriter.TestTryCatch;
 
 Var

packages/fcl-json/src/fpjsonrtti.pp

@@ -54,8 +54,6 @@ Type
     function IsChildStored: boolean;
     function StreamChildren(AComp: TComponent): TJSONArray;
   protected
-    Function GetPropertyList(aObject : TObject) : TPropInfoList; virtual;
-    Procedure StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject); virtual;
     function StreamClassProperty(Const AObject: TObject): TJSONData; virtual;
     Function StreamProperty(Const AObject : TObject; Const PropertyName : String) : TJSONData;
     Function StreamProperty(Const AObject : TObject; PropertyInfo : PPropInfo) : TJSONData;
@@ -811,36 +809,12 @@ begin
   Result:=(GetChildProperty<>'Children');
 end;
 
-Function TJSONStreamer.GetPropertyList(aObject : TObject) : TPropInfoList;
-
-begin
-  result:=TPropInfoList.Create(AObject,tkProperties);
-end;
-
-Procedure TJSONStreamer.StreamProperties(aObject : TObject;aList : TPropInfoList; aParent : TJSONObject);
-
-Var
-  I : Integer;
-  PD : TJSONData;
-
-begin
-  For I:=0 to aList.Count-1 do
-    begin
-    PD:=StreamProperty(AObject,aList.Items[i]);
-    If (PD<>Nil) then 
-      begin
-      if jsoLowerPropertyNames in Options then
-        aParent.Add(LowerCase(aList.Items[I]^.Name),PD)
-      else
-        aParent.Add(aList.Items[I]^.Name,PD);
-      end;
-    end;
-end;
-
 function TJSONStreamer.ObjectToJSON(Const AObject: TObject): TJSONObject;
 
 Var
   PIL : TPropInfoList;
+  PD : TJSONData;
+  I : Integer;
 
 begin
   Result:=Nil;
@@ -860,12 +834,20 @@ begin
       Result.Add('Objects', StreamTList(TList(AObject)))
     else
       begin
-      PIL:=GetPropertyList(aObject);
-//      TPropInfoList.Create(AObject,tkProperties);
+      PIL:=TPropInfoList.Create(AObject,tkProperties);
       try
-        StreamProperties(aObject,PIL,Result);
+        For I:=0 to PIL.Count-1 do
+          begin
+          PD:=StreamProperty(AObject,PIL.Items[i]);
+            If (PD<>Nil) then begin
+              if jsoLowerPropertyNames in Options then
+                Result.Add(LowerCase(PIL.Items[I]^.Name),PD)
+              else
+            Result.Add(PIL.Items[I]^.Name,PD);
+          end;
+          end;
       finally
-        FreeAndNil(Pil);
+        FReeAndNil(Pil);
       end;
       If (jsoStreamChildren in Options) and (AObject is TComponent) then
         Result.Add(ChildProperty,StreamChildren(TComponent(AObject)));

packages/fcl-passrc/src/pasresolveeval.pas

@@ -206,6 +206,7 @@ const
   nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
   nParamOfThisTypeCannotHaveDefVal = 3141;
   nClassTypesAreNotRelatedXY = 3142;
+  nDirectiveXNotAllowedHere = 3143;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -359,6 +360,7 @@ resourcestring
   sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
   sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
   sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
+  sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pastree.pp

@@ -22,10 +22,11 @@ unit PasTree;
 {$if defined(debugrefcount) or defined(VerbosePasTreeMem) or defined(VerbosePasResolver)}
   {$define EnablePasTreeGlobalRefCount}
 {$endif}
+{$inline on}
 
 interface
 
-uses Classes;
+uses SysUtils, Classes;
 
 resourcestring
   // Parse tree node type names
@@ -90,6 +91,7 @@ resourcestring
   SPasTreeDestructorImpl = 'destructor implementation';
 
 type
+  EPasTree = Class(Exception);
 
   // Visitor pattern.
   TPassTreeVisitor = class;
@@ -114,8 +116,12 @@ type
     visStrictPrivate, visStrictProtected);
 
   TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
-                        ccOldFPCCall,ccSafeCall,ccSysCall);
-  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo);
+                        ccOldFPCCall,ccSafeCall,ccSysCall,ccMWPascal,
+                        ccHardFloat,ccSysV_ABI_Default,ccSysV_ABI_CDecl,
+                        ccMS_ABI_Default,ccMS_ABI_CDecl,
+                        ccVectorCall);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
+                       ptmReferenceTo,ptmAsync);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -650,8 +656,8 @@ type
     Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
     ElType: TPasType; // nil means array-of-const
-    function IsGenericArray : Boolean;
-    function IsPacked : Boolean;
+    function IsGenericArray : Boolean; inline;
+    function IsPacked : Boolean; inline;
     procedure AddRange(Range: TPasExpr);
   end;
 
@@ -734,8 +740,8 @@ type
     Members: TFPList;
     Constructor Create(const AName: string; AParent: TPasElement); override;
     Destructor Destroy; override;
-    Function IsPacked: Boolean;
-    Function IsBitPacked : Boolean;
+    Function IsPacked: Boolean; inline;
+    Function IsBitPacked : Boolean; inline;
     Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   end;
@@ -762,12 +768,14 @@ type
     okObject, okClass, okInterface,
     // okGeneric  removed in FPC 3.3.1  check instead GenericTemplateTypes<>nil
     // okSpecialize removed in FPC 3.1.1
-    okClassHelper,okRecordHelper,okTypeHelper,
-    okDispInterface);
+    okClassHelper, okRecordHelper, okTypeHelper,
+    okDispInterface, okObjcClass, okObjcCategory,
+    okObjcProtocol);
 const
-  okWithFields = [okObject, okClass];
+  okWithFields = [okObject, okClass, okObjcClass, okObjcCategory];
   okAllHelpers = [okClassHelper,okRecordHelper,okTypeHelper];
   okWithClassFields = okWithFields+okAllHelpers;
+  okObjCClasses = [okObjcClass, okObjcCategory, okObjcProtocol];
 
 type
 
@@ -801,6 +809,7 @@ type
     ExternalNameSpace : String;
     ExternalName : String;
     InterfaceType: TPasClassInterfaceType;
+    Function IsObjCClass : Boolean;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function InterfaceGUID : string;
@@ -832,9 +841,11 @@ type
 
   TPasProcedureType = class(TPasGenericType)
   private
-    function GetIsNested: Boolean;
-    function GetIsOfObject: Boolean;
-    function GetIsReference: Boolean;
+    function GetIsAsync: Boolean; inline;
+    function GetIsNested: Boolean; inline;
+    function GetIsOfObject: Boolean; inline;
+    function GetIsReference: Boolean; inline;
+    procedure SetIsAsync(const AValue: Boolean);
     procedure SetIsNested(const AValue: Boolean);
     procedure SetIsOfObject(const AValue: Boolean);
     procedure SetIsReference(AValue: Boolean);
@@ -856,10 +867,11 @@ type
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsNested : Boolean read GetIsNested write SetIsNested;
     property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
+    property IsAsync: Boolean read GetIsAsync write SetIsAsync;
   end;
   TPasProcedureTypeClass = class of TPasProcedureType;
 
-  { TPasResultElement }
+  { TPasResultElement - parent is TPasFunctionType }
 
   TPasResultElement = class(TPasElement)
   public
@@ -973,7 +985,7 @@ type
   private
     FArgs: TFPList;
     FResolvedType : TPasType;
-    function GetIsClass: boolean;
+    function GetIsClass: boolean; inline;
     procedure SetIsClass(AValue: boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -1047,8 +1059,8 @@ type
 
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
-                        pmInline,pmAssembler, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward, pmDispId, 
+                        pmInline, pmAssembler, pmPublic,
+                        pmCompilerProc, pmExternal, pmForward, pmDispId,
                         pmNoReturn, pmFar, pmFinal);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
@@ -1091,17 +1103,19 @@ type
     Body : TProcedureBody;
     NameParts: TProcedureNameParts; // only used for generic aka parametrized functions
     Procedure AddModifier(AModifier : TProcedureModifier);
-    Function IsVirtual : Boolean;
-    Function IsDynamic : Boolean;
-    Function IsAbstract : Boolean;
-    Function IsOverride : Boolean;
-    Function IsExported : Boolean;
-    Function IsExternal : Boolean;
-    Function IsOverload : Boolean;
-    Function IsMessage: Boolean;
-    Function IsReintroduced : Boolean;
-    Function IsStatic : Boolean;
-    Function IsForward: Boolean;
+    Function IsVirtual : Boolean; inline;
+    Function IsDynamic : Boolean; inline;
+    Function IsAbstract : Boolean; inline;
+    Function IsOverride : Boolean; inline;
+    Function IsExported : Boolean; inline;
+    Function IsExternal : Boolean; inline;
+    Function IsOverload : Boolean; inline;
+    Function IsMessage: Boolean; inline;
+    Function IsReintroduced : Boolean; inline;
+    Function IsStatic : Boolean; inline;
+    Function IsForward: Boolean; inline;
+    Function IsAssembler: Boolean; inline;
+    Function IsAsync: Boolean; inline;
     Function GetProcTypeEnum: TProcType; virtual;
     procedure SetNameParts(Parts: TProcedureNameParts);
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
@@ -1539,7 +1553,9 @@ type
   TPasImplCaseElse = class(TPasImplBlock)
   end;
 
-  { TPasImplForLoop }
+  { TPasImplForLoop
+    - for VariableName in StartExpr do Body
+    - for VariableName := StartExpr to EndExpr do Body }
 
   TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
@@ -1555,7 +1571,7 @@ type
     EndExpr : TPasExpr; // if LoopType=ltIn this is nil
     Body: TPasImplElement;
     Variable: TPasVariable; // not used by TPasParser
-    Function Down: boolean; // downto, backward compatibility
+    Function Down: boolean; inline;// downto, backward compatibility
     Function StartValue : String;
     Function EndValue: string;
   end;
@@ -1678,7 +1694,8 @@ const
   ObjKindNames: array[TPasObjKind] of string = (
     'object', 'class', 'interface',
     'class helper','record helper','type helper',
-    'dispinterface');
+    'dispinterface', 'ObjcClass', 'ObjcCategory',
+    'ObjcProtocol');
 
   InterfaceTypeNames: array[TPasClassInterfaceType] of string = (
     'COM',
@@ -1734,9 +1751,12 @@ const
   cPasMemberHint : Array[TPasMemberHint] of string =
       ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
   cCallingConventions : Array[TCallingConvention] of string =
-      ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
+      ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall','MWPascal',
+                        'HardFloat','SysV_ABI_Default','SysV_ABI_CDecl',
+                        'MS_ABI_Default','MS_ABI_CDecl',
+                        'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs','reference to');
+      ('of Object', 'is nested','static','varargs','reference to','async');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
@@ -1754,6 +1774,8 @@ procedure ReleaseElementList(ElList: TFPList{$IFDEF CheckPasTreeRefCount}; const
 function GenericTemplateTypesAsString(List: TFPList): string;
 procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
+function dbgs(const s: TProcTypeModifiers): string; overload;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 function GetPTDumpStack: string;
@@ -1761,7 +1783,6 @@ function GetPTDumpStack: string;
 
 implementation
 
-uses SysUtils;
 
 procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
 begin
@@ -1855,6 +1876,19 @@ begin
   NameParts:=nil;
 end;
 
+function dbgs(const s: TProcTypeModifiers): string;
+var
+  m: TProcTypeModifier;
+begin
+  Result:='';
+  for m in s do
+    begin
+    if Result<>'' then Result:=Result+',';
+    Result:=Result+ProcTypeModifiers[m];
+    end;
+  Result:='['+Result+']';
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 Var
   I,CurrLen,CurrPos : Integer;
@@ -2774,7 +2808,7 @@ begin
     writeln('ERROR: TPasElement.ChangeRefId ',Name,':',ClassName,' Old="'+OldId+'" New="'+NewId+'" Old not found');
     writeln(RefIds.Text);
     {AllowWriteln-}
-    raise Exception.Create('');
+    raise EPasTree.Create('');
     end;
   RefIds.Delete(i);
   RefIds.Add(NewId);
@@ -2820,7 +2854,7 @@ begin
       end;
     FreeAndNil(RefIds);
     {$ENDIF}
-    raise Exception.Create('');
+    raise EPasTree.Create(ClassName+'Destroy called wrong');
     end;
   {$IFDEF CheckPasTreeRefCount}
   FreeAndNil(RefIds);
@@ -2928,7 +2962,7 @@ begin
     {$if defined(VerbosePasResolver) or defined(VerbosePCUFiler)}
     Writeln('TPasElement.Released : ',ClassName,' ',Name);
     {$endif}
-    raise Exception.Create('');
+    raise EPasTree.Create(ClassName+': Destroy called wrong');
     end
   else
     begin
@@ -3024,7 +3058,7 @@ function TPasElement.GetModule: TPasModule;
 Var
   p : TPaselement;
 begin
-  if self is  TPasPackage then
+  if Self is TPasPackage then
     Result := nil
   else
     begin
@@ -3412,6 +3446,12 @@ begin
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
 end;
 
+function TPasClassType.IsObjCClass: Boolean;
+
+begin
+  Result:=ObjKind in okObjCClasses;
+end;
+
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
 
 Var
@@ -3494,21 +3534,38 @@ end;
 
 { TPasProcedureType }
 
+// inline
+function TPasProcedureType.GetIsAsync: Boolean;
+begin
+  Result:=ptmAsync in Modifiers;
+end;
+
+// inline
 function TPasProcedureType.GetIsNested: Boolean;
 begin
   Result:=ptmIsNested in Modifiers;
 end;
 
+// inline
 function TPasProcedureType.GetIsOfObject: Boolean;
 begin
   Result:=ptmOfObject in Modifiers;
 end;
 
+// inline
 function TPasProcedureType.GetIsReference: Boolean;
 begin
   Result:=ptmReferenceTo in Modifiers;
 end;
 
+procedure TPasProcedureType.SetIsAsync(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmAsync)
+  else
+    Exclude(Modifiers,ptmAsync);
+end;
+
 procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
 begin
   if AValue then
@@ -3794,7 +3851,7 @@ begin
     Element.AddRef{$IFDEF CheckPasTreeRefCount}('TPasImplIfElse.ElseBranch'){$ENDIF};
     end
   else
-    raise Exception.Create('TPasImplIfElse.AddElement if and else already set - please report this bug');
+    raise EPasTree.Create('TPasImplIfElse.AddElement if and else already set - please report this bug');
 end;
 
 function TPasImplIfElse.CloseOnSemicolon: boolean;
@@ -3816,7 +3873,9 @@ end;
 function TPasImplIfElse.Condition: string;
 begin
   If Assigned(ConditionExpr) then
-    Result:=ConditionExpr.GetDeclaration(True);
+    Result:=ConditionExpr.GetDeclaration(True)
+  else
+    Result:='';
 end;
 
 destructor TPasImplForLoop.Destroy;
@@ -3838,7 +3897,7 @@ begin
     Body.AddRef{$IFDEF CheckPasTreeRefCount}('TPasImplForLoop.Body'){$ENDIF};
     end
   else
-    raise Exception.Create('TPasImplForLoop.AddElement body already set - please report this bug');
+    raise EPasTree.Create('TPasImplForLoop.AddElement body already set - please report this bug');
 end;
 
 procedure TPasImplForLoop.ForEachCall(const aMethodCall: TOnForEachPasElement;
@@ -4613,6 +4672,8 @@ function TPasVariable.Value: String;
 begin
   If Assigned(Expr) then
     Result:=Expr.GetDeclaration(True)
+  else
+    Result:='';
 end;
 
 function TPasProperty.GetDeclaration (full : boolean) : string;
@@ -4622,6 +4683,7 @@ Var
   I : Integer;
 
 begin
+  Result:='';
   If Assigned(VarType) then
     begin
     If VarType.Name='' then
@@ -4827,6 +4889,16 @@ begin
   Result:=pmForward in FModifiers;
 end;
 
+function TPasProcedure.IsAssembler: Boolean;
+begin
+  Result:=pmAssembler in FModifiers;
+end;
+
+function TPasProcedure.IsAsync: Boolean;
+begin
+  Result:=ProcType.IsAsync;
+end;
+
 function TPasProcedure.GetProcTypeEnum: TProcType;
 begin
   Result:=ptProcedure;
@@ -5080,7 +5152,7 @@ var
   l: Integer;
 begin
   if (InFilename<>nil) and (InFilename.Kind<>pekString) then
-    raise Exception.Create('');
+    raise EPasTree.Create('Wrong In expression for '+aUnitName);
   if aModule=nil then
     aModule:=TPasUnresolvedUnitRef.Create(AUnitName, Self);
   l:=length(UsesClause);
@@ -5090,8 +5162,8 @@ begin
     UsesUnit:=TPasUsesUnit.Create(AUnitName,Self);
     if aName<>nil then
       begin
-      Result.SourceFilename:=aName.SourceFilename;
-      Result.SourceLinenumber:=aName.SourceLinenumber;
+      UsesUnit.SourceFilename:=aName.SourceFilename;
+      UsesUnit.SourceLinenumber:=aName.SourceLinenumber;
       end;
     end;
   UsesClause[l]:=UsesUnit;
@@ -5173,7 +5245,7 @@ begin
     Body.AddRef{$IFDEF CheckPasTreeRefCount}('TPasImplWhileDo.Body'){$ENDIF};
     end
   else
-    raise Exception.Create('TPasImplWhileDo.AddElement body already set');
+    raise EPasTree.Create('TPasImplWhileDo.AddElement body already set');
 end;
 
 procedure TPasImplWhileDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
@@ -5188,7 +5260,9 @@ end;
 function TPasImplWhileDo.Condition: string;
 begin
   If Assigned(ConditionExpr) then
-    Result:=ConditionExpr.GetDeclaration(True);
+    Result:=ConditionExpr.GetDeclaration(True)
+  else
+    Result:='';
 end;
 
 { TPasImplCaseOf }
@@ -5270,7 +5344,7 @@ begin
     Body.AddRef{$IFDEF CheckPasTreeRefCount}('TPasImplCaseStatement.Body'){$ENDIF};
     end
   else
-    raise Exception.Create('TPasImplCaseStatement.AddElement body already set');
+    raise EPasTree.Create('TPasImplCaseStatement.AddElement body already set');
 end;
 
 procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
@@ -5319,7 +5393,7 @@ begin
     Body.AddRef{$IFDEF CheckPasTreeRefCount}('TPasImplWithDo.Body'){$ENDIF};
     end
   else
-    raise Exception.Create('TPasImplWithDo.AddElement body already set');
+    raise EPasTree.Create('TPasImplWithDo.AddElement body already set');
 end;
 
 procedure TPasImplWithDo.AddExpression(const Expression: TPasExpr);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1173,12 +1173,13 @@ var
   C: TClass;
   Members, Args: TFPList;
   i: Integer;
-  Member: TPasElement;
+  Member, Param: TPasElement;
   MemberResolved: TPasResolverResult;
   Prop: TPasProperty;
   ProcType: TPasProcedureType;
   ClassEl: TPasClassType;
   ArrType: TPasArrayType;
+  SpecType: TPasSpecializeType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
@@ -1270,7 +1271,18 @@ begin
       UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
     end
   else if C=TPasSpecializeType then
-    UseSubEl(TPasSpecializeType(El).DestType)
+    begin
+    SpecType:=TPasSpecializeType(El);
+    // SpecType.DestType is the generic type, which is never used
+    if SpecType.CustomData is TPasSpecializeTypeData then
+      UseSubEl(TPasSpecializeTypeData(El.CustomData).SpecializedType);
+    for i:=0 to SpecType.Params.Count-1 do
+      begin
+      Param:=TPasElement(SpecType.Params[i]);
+      if Param is TPasGenericTemplateType then continue;
+      UseSubEl(Param);
+      end;
+    end
   else if C=TPasGenericTemplateType then
     begin
     if ScopeModule=nil then
@@ -1546,7 +1558,7 @@ begin
     begin
     // while-do
     UseExpr(TPasImplWhileDo(El).ConditionExpr);
-    UseImplBlock(TPasImplWhileDo(El),false);
+    UseImplElement(TPasImplWhileDo(El).Body);
     end
   else if C=TPasImplWithDo then
     begin
@@ -1554,7 +1566,7 @@ begin
     WithDo:=TPasImplWithDo(El);
     for i:=0 to WithDo.Expressions.Count-1 do
       UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
-    UseImplBlock(WithDo,false);
+    UseImplElement(WithDo.Body);
     end
   else if C=TPasImplExceptOn then
     begin
@@ -2385,7 +2397,7 @@ var
   i: Integer;
 begin
   if not MarkElementAsUsed(El) then exit;
-  // El.DestType is TPasGenericType, which is never be used
+  // El.DestType is the generic type, which is never used
   if El.CustomData is TPasSpecializeTypeData then
     UseElType(El,TPasSpecializeTypeData(El.CustomData).SpecializedType,Mode);
   for i:=0 to El.Params.Count-1 do
@@ -2690,7 +2702,7 @@ begin
         begin
         // declaration was never used
         if IsSpecializedGenericType(Decl) then
-          continue;
+          continue; // no hints for not used specializations
         EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
           sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
         end;
@@ -2726,7 +2738,7 @@ begin
           begin
           SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
           if FindElement(SpecEl)<>nil then
-            exit; // a specialization of this generic type is used
+            exit; // a specialization of this generic type is used -> the generic is used
           end;
       end;
 
@@ -2832,7 +2844,7 @@ begin
     ImplProc:=ProcScope.ImplProc;
   if (ProcScope.ClassRecScope<>nil)
       and (ProcScope.ClassRecScope.SpecializedFromItem<>nil) then
-    exit; // specialized proc
+    exit; // no hints for not used specializations
 
   if not PAElementExists(DeclProc) then
     begin

packages/fcl-passrc/src/pparser.pp

@@ -38,7 +38,7 @@ interface
 
 uses
   {$ifdef NODEJS}
-  NodeJSFS,
+  Node.FS,
   {$endif}
   SysUtils, Classes, Types, PasTree, PScanner;
 
@@ -101,6 +101,7 @@ const
   nParserOnlyOneVariableCanBeAbsolute = 2055;
   nParserXNotAllowedInY = 2056;
   nFileSystemsNotSupported = 2057;
+  nInvalidMessageType = 2058;
 
 // resourcestring patterns of messages
 resourcestring
@@ -161,6 +162,7 @@ resourcestring
   SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute';
   SParserXNotAllowedInY = '%s is not allowed in %s';
   SErrFileSystemNotSupported = 'No support for filesystems enabled';
+  SErrInvalidMessageType = 'Invalid message type: string or integer expression expected';
 
 type
   TPasScopeType = (
@@ -369,8 +371,8 @@ type
     function ParseExprOperand(AParent : TPasElement): TPasExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr; deprecated 'use ParseExprOperand instead'; // since fpc 3.3.1
     procedure DoParseClassType(AType: TPasClassType);
-    procedure DoParseClassExternalHeader(AObjKind: TPasObjKind;
-      out AExternalNameSpace, AExternalName: string);
+    Function DoParseClassExternalHeader(AObjKind: TPasObjKind;
+      out AExternalNameSpace, AExternalName: string) : Boolean;
     procedure DoParseArrayType(ArrType: TPasArrayType);
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
@@ -453,7 +455,7 @@ type
     procedure ParseInitialization;
     procedure ParseFinalization;
     procedure ParseDeclarations(Declarations: TPasDeclarations);
-    procedure ParseStatement(Parent: TPasImplBlock;  out NewImplElement: TPasImplElement);
+    procedure ParseStatement(Parent: TPasImplBlock; out NewImplElement: TPasImplElement);
     procedure ParseLabels(AParent: TPasElement);
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     procedure ParseProcAsmBlock(Parent: TProcedureBody);
@@ -630,7 +632,9 @@ Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 
 Var
   CCNames : Array[TCallingConvention] of String
-         = ('','register','pascal','cdecl','stdcall','oldfpccall','safecall','syscall');
+         = ('','register','pascal','cdecl','stdcall','oldfpccall','safecall','syscall',
+           'mwpascal', 'hardfloat','sysv_abi_default','sysv_abi_cdecl',
+           'ms_abi_default','ms_abi_cdecl','vectorcall');
 Var
   C : TCallingConvention;
 
@@ -1354,11 +1358,9 @@ begin
     if Parent is TPasClassType then
       begin
       if PM in [pmPublic,pmForward] then exit(false);
-      case TPasClassType(Parent).ObjKind of
-      okInterface,okDispInterface:
-        if not (PM in [pmOverload, pmMessage,
-                        pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
-      end;
+      if TPasClassType(Parent).ObjKind in [okInterface,okDispInterface] then
+        if not (PM in [pmOverload, pmMessage, pmDispId,pmNoReturn,pmFar,pmFinal]) then
+          exit(false);
       exit;
       end
     else if Parent is TPasRecordType then
@@ -1378,7 +1380,11 @@ function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
 begin
   Result:=IsProcModifier(S,PM);
   if not Result then exit;
-  Result:=PM in [pmAssembler];
+  case PM of
+  pmAssembler: Result:=true;
+  else
+    Result:=false;
+  end;
   if Parent=nil then ;
 end;
 
@@ -1395,6 +1401,11 @@ begin
     Result:=true;
     PTM:=ptmStatic;
     end
+  else if (CompareText(S,ProcTypeModifiers[ptmAsync])=0) and (po_AsyncProcs in Options) then
+    begin
+    Result:=true;
+    PTM:=ptmAsync;
+    end
   else
    Result:=false;
   if Parent=nil then;
@@ -1452,7 +1463,7 @@ begin
   if (Result<>pmNone) then
      begin
      NextToken;
-     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass, tkSet]) then
+     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass, tkObjCClass, tkSet]) then
        ParseExcTokenError('SET, ARRAY, RECORD, OBJECT or CLASS');
      end;
 end;
@@ -1860,14 +1871,23 @@ function TPasParser.ParseType(Parent: TPasElement;
   const NamePos: TPasSourcePos; const TypeName: String; Full: Boolean
   ): TPasType;
 
+Type
+  TLocalClassType = (lctClass,lctObjcClass,lctObjcCategory,lctHelper);
+
 Const
   // These types are allowed only when full type declarations
-  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkInterface,tkDispInterface,tkType];
+  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkObjCClass,tkInterface,tkObjcProtocol,tkDispInterface,tkType];
   // Parsing of these types already takes care of hints
   NoHintTokens = [tkProcedure,tkFunction];
+  InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol);
+  ClassKindTypes : Array[TLocalClassType] of TPasObjKind = (okClass,okObjCClass,okObjcCategory,okClassHelper);
+
+
 var
   PM: TPackMode;
-  CH, isHelper, ok: Boolean;
+  CH, ok, isHelper : Boolean;
+  lClassType : TLocalClassType;
+
 begin
   Result := nil;
   // NextToken and check pack mode
@@ -1887,27 +1907,37 @@ begin
       tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM);
       tkDispInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface,PM);
+      tkObjcProtocol,
       tkInterface:
-        Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface,PM);
+        begin
+        Result := ParseClassDecl(Parent, NamePos, TypeName, InterfaceKindTypes[(CurToken=tkObjcProtocol)],PM);
+        end;
       tkSpecialize:
         Result:=ParseSimpleType(Parent,CurSourcePos,TypeName);
+      tkObjCClass,
+      tkobjccategory,
       tkClass:
         begin
-        isHelper:=false;
-        NextToken;
-        if CurTokenIsIdentifier('Helper') then
+        If (CurToken=tkObjCClass) then
+          lClassType:=lctObjcClass
+        else if (CurToken=tkobjccategory) then
+          lClassType:=lctObjcCategory
+        else
           begin
-          // class helper: atype end;
-          // class helper for atype end;
+          lClassType:=lctClass;
           NextToken;
-          isHelper:=CurToken in [tkfor,tkBraceOpen];
-          UnGetToken;
+          if CurTokenIsIdentifier('Helper') then
+            begin
+            // class helper: atype end;
+            // class helper for atype end;
+            NextToken;
+            if CurToken in [tkfor,tkBraceOpen] then
+              lClassType:=lctHelper;
+            UnGetToken;
+            end;
+          UngetToken;
           end;
-        UngetToken;
-        if isHelper then
-          Result:=ParseClassDecl(Parent,NamePos,TypeName,okClassHelper, PM)
-        else
-          Result:=ParseClassDecl(Parent, NamePos, TypeName, okClass, PM);
+        Result:=ParseClassDecl(Parent,NamePos,TypeName,ClassKindTypes[lClasstype], PM);
         end;
       tkType:
         begin
@@ -1997,6 +2027,7 @@ begin
    tkprocedure : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
    tkfunction : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
   else
+    result:=Nil; // Fool compiler
     ParseExcTokenError('procedure or function');
   end;
   Result.IsReferenceTo:=True;
@@ -2066,18 +2097,21 @@ function TPasParser.isEndOfExp(AllowEqual : Boolean = False; CheckHints : Boolea
 const
   EndExprToken = [
     tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
-    tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
+    tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto, tkotherwise
   ];
 begin
-  Result:=(CurToken in EndExprToken) or (CheckHints and IsCurTokenHint);
-  if Not (Result or AllowEqual) then
-    Result:=(Curtoken=tkEqual);
+  if (CurToken in EndExprToken) or (CheckHints and IsCurTokenHint) then
+    exit(true);
+  if AllowEqual and (CurToken=tkEqual) then
+    exit(true);
+  Result:=false;
 end;
 
 function TPasParser.ExprToText(Expr: TPasExpr): String;
 var
   C: TClass;
 begin
+  Result:='';
   C:=Expr.ClassType;
   if C=TPrimitiveExpr then
     Result:=TPrimitiveExpr(Expr).Value
@@ -2263,6 +2297,7 @@ begin
     tkDot                   : Result:=eopSubIdent;
     tkCaret                 : Result:=eopDeref;
   else
+    result:=eopAdd; // Fool compiler
     ParseExc(nParserNotAnOperand,SParserNotAnOperand,[AToken,TokenInfos[AToken]]);
   end;
 end;
@@ -2938,6 +2973,7 @@ var
   OldMember: TPasElement;
   OverloadedProc: TPasOverloadedProc;
 begin
+  OldMember:=nil;
   With Decs do
     begin
     if not (po_nooverloadedprocs in Options) then
@@ -3394,6 +3430,7 @@ end;
 function TPasParser.GetProcTypeFromToken(tk: TToken; IsClass: Boolean
   ): TProcType;
 begin
+  Result:=ptProcedure;
   Case tk of
     tkProcedure :
       if IsClass then
@@ -3470,7 +3507,7 @@ begin
   HadTypeSection:=false;
   while True do
   begin
-    if CurBlock in [DeclNone,declConst,declType] then
+    if CurBlock in [DeclNone,declConst,declType,declVar] then
       Scanner.SetTokenOption(toOperatorToken)
     else
       Scanner.UnSetTokenOption(toOperatorToken);
@@ -4357,6 +4394,8 @@ function TPasParser.ParseGenericTypeDecl(Parent: TPasElement;
     ProcTypeEl: TPasProcedureType;
     ProcType: TProcType;
   begin
+    ProcTypeEl:=Nil;
+    ProcType:=ptProcedure;
     case CurToken of
     tkFunction:
       begin
@@ -4613,7 +4652,8 @@ begin
       case CurToken of
       tkColon: break;
       tkComma: ExpectIdentifier;
-      else     ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
+      else
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
       end;
     Until (CurToken=tkColon);
     OldForceCaret:=Scanner.SetForceCaret(True);
@@ -5080,8 +5120,13 @@ begin
       begin
       TPasProcedure(Parent).MessageName:=TPrimitiveExpr(E).Value;
       case E.Kind of
-      pekNumber, pekUnary: TPasProcedure(Parent).Messagetype:=pmtInteger;
-      pekString: TPasProcedure(Parent).Messagetype:=pmtString;
+        pekNumber, pekUnary:
+          TPasProcedure(Parent).Messagetype:=pmtInteger;
+        pekString:
+          TPasProcedure(Parent).Messagetype:=pmtString;
+        pekIdent : ; // unknown at this time
+      else
+        ParseExc(nInvalidMessageType,SErrInvalidMessageType);
       end;
       end;
     if CurToken<>tkSemicolon then
@@ -5094,6 +5139,8 @@ begin
     if CurToken<>tkSemicolon then
       UngetToken;
     end;
+  else
+    // Do nothing, satisfy compiler
   end; // Case
 end;
 
@@ -5222,6 +5269,7 @@ begin
             or (CurModule is TPasProgram))
           then
         begin
+        OK:=False;
         if Assigned(CurModule.InterfaceSection) then
           OK:=FindInSection(Parent.Name,CurModule.InterfaceSection)
         else if (CurModule is TPasProgram) and Assigned(TPasProgram(CurModule).ProgramSection) then
@@ -5256,6 +5304,8 @@ begin
           ParseExc(nParserExpectedColonID,SParserExpectedColonID);
         ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
       end;
+  else
+    resultEl:=Nil;
   end;
   if OfObjectPossible then
     begin
@@ -5479,6 +5529,7 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
     else
       begin
       Result := Result + '[';
+      Param:=Nil;
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
       Params.Kind:=pekArrayParams;
       Params.Value:=Expr;
@@ -5531,6 +5582,16 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
     until CurToken<>tkComma;
   end;
 
+  procedure ConsumeSemi;
+  begin
+    if (CurToken = tkSemicolon) then
+      begin
+      NextToken;
+      if IsCurTokenHint then
+        UngetToken;
+      end;
+  end;
+
 var
   isArray , ok, IsClass: Boolean;
   ObjKind: TPasObjKind;
@@ -5616,7 +5677,7 @@ begin
       end;
     if CurTokenIsIdentifier('DEFAULT') then
       begin
-      if not (ObjKind in [okClass]) then
+      if not (ObjKind in [okClass,okClassHelper]) then // FPC allows it in type helpers
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['DEFAULT',ObjKindNames[ObjKind]]);
       if isArray then
         ParseExc(nParserArrayPropertiesCannotHaveDefaultValue,SParserArrayPropertiesCannotHaveDefaultValue);
@@ -5650,8 +5711,11 @@ begin
         end;
       // Handle hints
       while DoCheckHint(Result) do
-        NextToken;
-      if Result.Hints=[] then
+        begin
+        NextToken; // eat Hint token
+        ConsumeSemi; // Now on hint token or semicolon
+        end;
+//      if Result.Hints=[] then
         UngetToken;
       end
     else if CurToken=tkend then
@@ -5674,6 +5738,10 @@ var
 begin
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
+  // these can be used in code for typecasts
+  Scanner.SetNonToken(tkobjccategory);
+  Scanner.SetNonToken(tkobjcprotocol);
+  Scanner.SetNonToken(tkobjcclass);
   repeat
     NextToken;
 //    writeln('TPasParser.ParseProcBeginBlock ',curtokenstring);
@@ -5687,6 +5755,10 @@ begin
         ExpectToken(tkend);
     end;
   until false;
+  // A declaration can follow...
+  Scanner.UnSetNonToken(tkobjccategory);
+  Scanner.UnSetNonToken(tkobjcprotocol);
+  Scanner.UnSetNonToken(tkobjcclass);
   Proc:=Parent.Parent as TPasProcedure;
   if Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction] then
     NextToken
@@ -5802,7 +5874,7 @@ var
   begin
     if CurBlock=Parent then exit(true);
     while CurBlock.CloseOnSemicolon
-    or (CloseIfs and (CurBlock is TPasImplIfElse)) do
+        or (CloseIfs and (CurBlock is TPasImplIfElse)) do
       if CloseBlock then exit(true);
     Result:=false;
   end;
@@ -5814,19 +5886,19 @@ var
     if NewImplElement=nil then NewImplElement:=CurBlock;
   end;
 
-  procedure CheckSemicolon;
+  procedure CheckStatementCanStart;
   var
     t: TToken;
   begin
-    if (CurBlock.Elements.Count=0) then exit;
+    if (CurBlock.Elements.Count=0) then
+      exit; // at start of block
     t:=GetPrevToken;
-    if t in [tkSemicolon,tkColon] then
-      exit;
-    if (CurBlock.ClassType=TPasImplIfElse) and (t=tkelse) then
+    if t in [tkSemicolon,tkColon,tkElse,tkotherwise] then
       exit;
     {$IFDEF VerbosePasParser}
     writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
     {$ENDIF}
+    // last statement not complete -> semicolon is missing
     ParseExcTokenError('Semicolon');
   end;
 
@@ -5860,11 +5932,11 @@ begin
     while True do
     begin
       NextToken;
-      //WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
+      //WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
       case CurToken of
       tkasm:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock,CurTokenPos));
         ParseAsmBlock(TPasImplAsmStatement(El));
         CurBlock.AddElement(El);
@@ -5875,98 +5947,85 @@ begin
         end;
       tkbegin:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock,CurTokenPos));
         CreateBlock(TPasImplBeginBlock(El));
         El:=nil;
         end;
       tkrepeat:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock,CurTokenPos));
         CreateBlock(TPasImplRepeatUntil(El));
         El:=nil;
         end;
       tkIf:
         begin
-          CheckSemicolon;
-          SrcPos:=CurTokenPos;
-          NextToken;
-          Left:=DoParseExpression(CurBlock);
-          UngetToken;
-          El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock,SrcPos));
-          TPasImplIfElse(El).ConditionExpr:=Left;
-          Left.Parent:=El;
-          Left:=nil;
-          //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
-          CreateBlock(TPasImplIfElse(El));
-          El:=nil;
-          ExpectToken(tkthen);
+        CheckStatementCanStart;
+        SrcPos:=CurTokenPos;
+        NextToken;
+        Left:=DoParseExpression(CurBlock);
+        UngetToken;
+        El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock,SrcPos));
+        TPasImplIfElse(El).ConditionExpr:=Left;
+        Left.Parent:=El;
+        Left:=nil;
+        //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
+        CreateBlock(TPasImplIfElse(El));
+        El:=nil;
+        ExpectToken(tkthen);
         end;
-      tkelse:
-        if (CurBlock is TPasImplIfElse) then
-        begin
-          if TPasImplIfElse(CurBlock).IfBranch=nil then
-          begin
-            // empty then statement  e.g. if condition then else
-            El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock,CurTokenPos));
-            CurBlock.AddElement(El);
-            El:=nil;
-          end;
-          if TPasImplIfElse(CurBlock).ElseBranch<>nil then
-          begin
-            // this and the following 3 may solve TPasImplIfElse.AddElement BUG
-            // ifs without begin end
-            // if .. then
-            //  if .. then
-            //   else
-            // else
+      tkelse,tkotherwise:
+        // ELSE can close multiple blocks, similar to semicolon
+        repeat
+          {$IFDEF VerbosePasParser}
+          writeln('TPasParser.ParseStatement ELSE CurBlock=',CurBlock.ClassName);
+          {$ENDIF}
+          if CurBlock is TPasImplIfElse then
+            begin
+            if TPasImplIfElse(CurBlock).IfBranch=nil then
+            begin
+              // empty THEN statement  e.g. if condition then else
+              El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock,CurTokenPos));
+              CurBlock.AddElement(El); // this sets TPasImplIfElse(CurBlock).IfBranch:=El
+              El:=nil;
+            end;
+            if (CurToken=tkelse) and (TPasImplIfElse(CurBlock).ElseBranch=nil) then
+              break; // add next statement as ElseBranch
+            end
+          else if (CurBlock is TPasImplTryExcept) and (CurToken=tkelse) then
+            begin
+            // close TryExcept handler and open an TryExceptElse handler
             CloseBlock;
-            CloseStatement(false);
-          end;
-        end else if (CurBlock is TPasImplCaseStatement) then
-        begin
-          // Case ... else without semicolon in front.
-          UngetToken;
-          CloseStatement(False);
-          break;
-        end else if (CurBlock is TPasImplWhileDo) then
-        begin
-          CloseBlock;
-          UngetToken;
-        end else if (CurBlock is TPasImplForLoop) then
-        begin
-          //if .. then for .. do smt else ..
-          CloseBlock;
-          UngetToken;
-        end else if (CurBlock is TPasImplWithDo) then
-        begin
-          //if .. then with .. do smt else ..
-          CloseBlock;
-          UngetToken;
-        end else if (CurBlock is TPasImplRaise) then
-        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
+            El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock,CurTokenPos));
+            TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
+            CurBlock:=TPasImplTryExceptElse(El);
+            El:=nil;
+            break;
+            end
+          else if (CurBlock is TPasImplCaseStatement) then
+            begin
+            UngetToken;
+            // Note: a TPasImplCaseStatement is parsed by a call of ParseStatement,
+            //       so it must be the top level block
+            if CurBlock<>Parent then
+              CheckToken(tkSemicolon);
+            exit;
+            end
+          else if (CurBlock is TPasImplWhileDo)
+              or (CurBlock is TPasImplForLoop)
+              or (CurBlock is TPasImplWithDo)
+              or (CurBlock is TPasImplRaise)
+              or (CurBlock is TPasImplExceptOn) then
+            // simply close block
+          else
+            ParseExcSyntaxError;
           CloseBlock;
-          El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock,CurTokenPos));
-          TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
-          CurBlock:=TPasImplTryExceptElse(El);
-          El:=nil;
-        end else
-          ParseExcSyntaxError;
+        until false;
       tkwhile:
         begin
           // while Condition do
-          CheckSemicolon;
+          CheckStatementCanStart;
           SrcPos:=CurTokenPos;
           NextToken;
           Left:=DoParseExpression(CurBlock);
@@ -5982,7 +6041,7 @@ begin
         end;
       tkgoto:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         NextToken;
         CurBlock.AddCommand('goto '+curtokenstring);
         // expecttoken(tkSemiColon);
@@ -5991,7 +6050,7 @@ begin
         begin
           // for VarName := StartValue to EndValue do
           // for VarName in Expression do
-          CheckSemicolon;
+          CheckStatementCanStart;
           El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock,CurTokenPos));
           ExpectIdentifier;
           Expr:=CreatePrimitiveExpr(El,pekIdent,CurTokenString);
@@ -6044,7 +6103,7 @@ begin
         begin
           // with Expr do
           // with Expr, Expr do
-          CheckSemicolon;
+          CheckStatementCanStart;
           SrcPos:=CurTokenPos;
           NextToken;
           El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
@@ -6068,7 +6127,7 @@ begin
         end;
       tkcase:
         begin
-          CheckSemicolon;
+          CheckStatementCanStart;
           SrcPos:=CurTokenPos;
           NextToken;
           Left:=DoParseExpression(CurBlock);
@@ -6091,7 +6150,7 @@ begin
                 ParseExc(nParserExpectCase,SParserExpectCase);
               break; // end without else
               end;
-            tkelse:
+            tkelse,tkotherwise:
               begin
                 // create case-else block
                 El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock,CurTokenPos));
@@ -6102,50 +6161,41 @@ begin
               end
             else
               // read case values
-              if (curToken=tkIdentifier) and (LowerCase(CurtokenString)='otherwise') then
-                begin
-                // create case-else block
-                El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock,CurTokenPos));
-                TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(El);
-                CreateBlock(TPasImplCaseElse(El));
-                El:=nil;
-                break;
-                end
-              else
-                repeat
-                  SrcPos:=CurTokenPos;
-                  Left:=DoParseExpression(CurBlock);
-                  //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
-                  if CurBlock is TPasImplCaseStatement then
-                    begin
-                    TPasImplCaseStatement(CurBlock).AddExpression(Left);
-                    Left:=nil;
-                    end
-                  else
-                    begin
-                    El:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock,SrcPos));
-                    TPasImplCaseStatement(El).AddExpression(Left);
-                    Left:=nil;
-                    CreateBlock(TPasImplCaseStatement(El));
-                    El:=nil;
-                    end;
-                  //writeln(i,'CASE after value Token=',CurTokenText);
-                  if (CurToken=tkComma) then
-                    NextToken
-                  else if (CurToken<>tkColon) then
-                    ParseExcTokenError(TokenInfos[tkComma]);
-                until Curtoken=tkColon;
+              repeat
+                SrcPos:=CurTokenPos;
+                Left:=DoParseExpression(CurBlock);
+                //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
+                if CurBlock is TPasImplCaseStatement then
+                  begin
+                  TPasImplCaseStatement(CurBlock).AddExpression(Left);
+                  Left:=nil;
+                  end
+                else
+                  begin
+                  El:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock,SrcPos));
+                  TPasImplCaseStatement(El).AddExpression(Left);
+                  Left:=nil;
+                  CreateBlock(TPasImplCaseStatement(El));
+                  El:=nil;
+                  end;
+                //writeln(i,'CASE after value Token=',CurTokenText);
+                if (CurToken=tkComma) then
+                  NextToken
+                else if (CurToken<>tkColon) then
+                  ParseExcTokenError(TokenInfos[tkComma]);
+              until Curtoken=tkColon;
               // read statement
               ParseStatement(CurBlock,SubBlock);
+              // CurToken is now at last token of case-statement
               CloseBlock;
               if CurToken<>tkSemicolon then
-              begin
                 NextToken;
-                if not (CurToken in [tkSemicolon,tkelse,tkend]) then
-                  ParseExcTokenError(TokenInfos[tkSemicolon]);
-                if CurToken<>tkSemicolon then
-                  UngetToken;
-              end;
+              if (CurToken in [tkSemicolon,tkelse,tkend,tkotherwise]) then
+                // ok
+              else
+                ParseExcTokenError(TokenInfos[tkSemicolon]);
+              if CurToken<>tkSemicolon then
+                UngetToken;
             end;
           until false;
           if CurToken=tkend then
@@ -6156,7 +6206,7 @@ begin
         end;
       tktry:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock,CurTokenPos));
         CreateBlock(TPasImplTry(El));
         El:=nil;
@@ -6196,11 +6246,11 @@ begin
         end;
       tkraise:
         begin
-        CheckSemicolon;
+        CheckStatementCanStart;
         ImplRaise:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock,CurTokenPos));
         CreateBlock(ImplRaise);
         NextToken;
-        If Curtoken in [tkElse,tkEnd,tkSemicolon] then
+        If Curtoken in [tkElse,tkEnd,tkSemicolon,tkotherwise] then
           UnGetToken
         else
           begin
@@ -6210,19 +6260,23 @@ begin
             NextToken;
             ImplRaise.ExceptAddr:=DoParseExpression(ImplRaise);
             end;
-          if Curtoken in [tkElse,tkEnd,tkSemicolon] then
+          If Curtoken in [tkElse,tkEnd,tkSemicolon,tkotherwise] then
             UngetToken
           end;
         end;
       tkend:
         begin
+          // Note: ParseStatement should return with CurToken at last token of the statement
           if CloseStatement(true) then
           begin
+            // there was none requiring an END
             UngetToken;
             break;
           end;
+          // still a block left
           if CurBlock is TPasImplBeginBlock then
           begin
+            // close at END
             if CloseBlock then break; // close end
             if CloseStatement(false) then break;
           end else if CurBlock is TPasImplCaseElse then
@@ -6276,7 +6330,7 @@ begin
         // Do not check this here:
         //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
         //        ParseExc;
-        CheckSemicolon;
+        CheckStatementCanStart;
 
         // On is usable as an identifier
         if lowerCase(CurTokenText)='on' then
@@ -6387,7 +6441,8 @@ var
 begin
   Labels:=TPasLabels(CreateElement(TPasLabels, '', AParent));
   repeat
-    Labels.Labels.Add(ExpectIdentifier);
+    expectTokens([tkIdentifier,tkNumber]);
+    Labels.Labels.Add(CurTokenString);
     NextToken;
     if not (CurToken in [tkSemicolon, tkComma]) then
       ParseExcTokenError(TokenInfos[tkSemicolon]);
@@ -6398,6 +6453,7 @@ end;
 function TPasParser.GetProcedureClass(ProcType: TProcType): TPTreeElement;
 
 begin
+  Result:=Nil;
   Case ProcType of
     ptFunction       : Result:=TPasFunction;
     ptClassFunction  : Result:=TPasClassFunction;
@@ -6615,6 +6671,7 @@ begin
             Case OperatorType of
               otPositive : OperatorType:=otPlus;
               otNegative : OperatorType:=otMinus;
+            else
             end;
             Name:=OperatorNames[OperatorType];
             TPasOperator(Result).CorrectName;
@@ -6819,7 +6876,7 @@ begin
         end;
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
-      tkGeneric,tkSelf, // Counts as field name
+      tkabsolute,tkGeneric,tkSelf, // Counts as field name
       tkIdentifier :
         begin
         If AllowVisibility and CheckVisibility(CurTokenString,v) then
@@ -7027,6 +7084,7 @@ Var
   T : TPasType;
   Done : Boolean;
 begin
+  Done:=False;
   //Writeln('Parsing local types');
   while (CurToken=tkSquaredBraceOpen)
       and (msPrefixedAttributes in CurrentModeswitches) do
@@ -7290,7 +7348,7 @@ begin
       begin
       case AType.ObjKind of
       okClass,okObject,
-      okClassHelper,okRecordHelper,okTypeHelper: ;
+      okClassHelper,okRecordHelper,okTypeHelper, okObjCClass, okObjcCategory, okObjcProtocol : ;
       else
         ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
       end;
@@ -7348,7 +7406,7 @@ begin
       CheckToken(tkend);
     NextToken;
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
-    if AType.ObjKind=okClass then
+    if AType.ObjKind in [okClass,okObjCClass] then
       while CurToken=tkComma do
         begin
         NextToken;
@@ -7381,17 +7439,27 @@ begin
     end;
 end;
 
-procedure TPasParser.DoParseClassExternalHeader(AObjKind: TPasObjKind; out
-  AExternalNameSpace, AExternalName: string);
+function TPasParser.DoParseClassExternalHeader(AObjKind: TPasObjKind; out AExternalNameSpace, AExternalName: string): Boolean;
 begin
-  if ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)
-      and CurTokenIsIdentifier('external')) then
+  Result:=False;
+  if ((aObjKind in [okObjcCategory,okObjcClass]) or
+      ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)))
+      and CurTokenIsIdentifier('external') then
     begin
+    Result:=True;
     NextToken;
     if CurToken<>tkString then
       UnGetToken
     else
       AExternalNameSpace:=CurTokenString;
+    if (aObjKind in [okObjcCategory,okObjcClass]) then
+      begin
+      // Name is optional in objcclass/category
+      NextToken;
+      if CurToken=tkBraceOpen then
+        exit;
+      UnGetToken;
+      end;
     ExpectIdentifier;
     If Not CurTokenIsIdentifier('Name')  then
       ParseExc(nParserExpectedExternalClassName,SParserExpectedExternalClassName);
@@ -7472,9 +7540,10 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
   AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
 
 Var
-  ok: Boolean;
+  isExternal,ok: Boolean;
   AExternalNameSpace,AExternalName : String;
   PCT:TPasClassType;
+
 begin
   NextToken;
   if (AObjKind = okClass) and (CurToken = tkOf) then
@@ -7494,7 +7563,7 @@ begin
     end;
     exit;
     end;
-  DoParseClassExternalHeader(AObjKind,AExternalNameSpace,AExternalName);
+  isExternal:=DoParseClassExternalHeader(AObjKind,AExternalNameSpace,AExternalName);
   if AObjKind in okAllHelpers then
     begin
     if not CurTokenIsIdentifier('Helper') then
@@ -7507,7 +7576,7 @@ begin
   ok:=false;
   try
     PCT.HelperForType:=nil;
-    PCT.IsExternal:=(AExternalName<>'');
+    PCT.IsExternal:=IsExternal;
     if AExternalName<>'' then
       PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');
     if AExternalNameSpace<>'' then

packages/fcl-passrc/src/pscanner.pp

@@ -39,7 +39,7 @@ uses
   {$ifdef pas2js}
   js,
   {$IFDEF NODEJS}
-  NodeJSFS,
+  Node.FS,
   {$ENDIF}
   Types,
   {$endif}
@@ -220,10 +220,14 @@ type
     tkmod,
     tknil,
     tknot,
+    tkobjccategory,
+    tkobjcclass,
+    tkobjcprotocol,
     tkobject,
     tkof,
     tkoperator,
     tkor,
+    tkotherwise,
     tkpacked,
     tkprocedure,
     tkprogram,
@@ -666,7 +670,8 @@ type
     po_StopOnErrorDirective, // error on user $Error, $message error|fatal
     po_ExtConstWithoutExpr,  // allow typed const without expression in external class and with external modifier
     po_StopOnUnitInterface,  // parse only a unit name and stop at interface keyword
-    po_IgnoreUnknownResource // Ignore resources for which no handler is registered.
+    po_IgnoreUnknownResource,// Ignore resources for which no handler is registered.
+    po_AsyncProcs            // allow async procedure modifier
     );
   TPOptions = set of TPOption;
 
@@ -1002,10 +1007,14 @@ const
     'mod',
     'nil',
     'not',
+    'objccategory',
+    'objcclass',
+    'objcprotocol',
     'object',
     'of',
     'operator',
     'or',
+    'otherwise',
     'packed',
     'procedure',
     'program',
@@ -1948,6 +1957,8 @@ begin
             dec(Lvl);
             if Lvl=0 then break;
             end;
+          else
+            // Do nothing, satisfy compiler
           end;
           NextToken;
         until false;
@@ -2096,6 +2107,8 @@ begin
               tkshr: R:=IntToStr(AInt shr BInt);
               tkPlus: R:=IntToStr(AInt+BInt);
               tkMinus: R:=IntToStr(AInt-BInt);
+            else
+              // Do nothing, satisfy compiler
             end
           else if IsExtended(B,BFloat) then
             case Op of
@@ -2146,6 +2159,8 @@ begin
           tkGreaterThan: R:=CondDirectiveBool[AInt>BInt];
           tkLessEqualThan: R:=CondDirectiveBool[AInt<=BInt];
           tkGreaterEqualThan: R:=CondDirectiveBool[AInt>=BInt];
+          else
+          // Do nothing, satisfy compiler
           end
         else if IsExtended(A,AFloat) and IsExtended(B,BFloat) then
           case Op of
@@ -2155,6 +2170,8 @@ begin
           tkGreaterThan: R:=CondDirectiveBool[AFloat>BFloat];
           tkLessEqualThan: R:=CondDirectiveBool[AFloat<=BFloat];
           tkGreaterEqualThan: R:=CondDirectiveBool[AFloat>=BFloat];
+          else
+          // Do nothing, satisfy compiler
           end
         else
           case Op of
@@ -2164,6 +2181,8 @@ begin
           tkGreaterThan: R:=CondDirectiveBool[A>B];
           tkLessEqualThan: R:=CondDirectiveBool[A<=B];
           tkGreaterEqualThan: R:=CondDirectiveBool[A>=B];
+          else
+          // Do nothing, satisfy compiler
           end;
         end;
       else
@@ -3086,6 +3105,7 @@ var
   end;
 
 begin
+  Result:=tkEOF;
   FCurTokenString := '';
   StartPos:=FTokenPos;
   {$ifndef UsePChar}
@@ -3607,7 +3627,8 @@ procedure TPascalScanner.HandleMode(const Param: String);
   procedure SetMode(const LangMode: TModeSwitch;
     const NewModeSwitches: TModeSwitches; IsDelphi: boolean;
     const AddBoolSwitches: TBoolSwitches = [];
-    const RemoveBoolSwitches: TBoolSwitches = []
+    const RemoveBoolSwitches: TBoolSwitches = [];
+    UseOtherwise: boolean = true
     );
   var
     Handled: Boolean;
@@ -3626,6 +3647,10 @@ procedure TPascalScanner.HandleMode(const Param: String);
         FOptions:=FOptions+[po_delphi]
       else
         FOptions:=FOptions-[po_delphi];
+      if UseOtherwise then
+        UnsetNonToken(tkotherwise)
+      else
+        SetNonToken(tkotherwise);
       end;
     Handled:=false;
     if Assigned(OnModeChanged) then
@@ -3643,33 +3668,47 @@ begin
   P:=Trim(UpperCase(Param));
   Case P of
   'FPC','DEFAULT':
+    begin
     SetMode(msFpc,FPCModeSwitches,false,bsFPCMode);
+    SetNonToken(tkobjcclass);
+    SetNonToken(tkobjcprotocol);
+    SetNonToken(tkobjcCategory);
+    end;
   'OBJFPC':
     begin
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
     UnsetNonToken(tkgeneric);
     UnsetNonToken(tkspecialize);
+    SetNonToken(tkobjcclass);
+    SetNonToken(tkobjcprotocol);
+    SetNonToken(tkobjcCategory);
     end;
   'DELPHI':
     begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
     SetNonToken(tkspecialize);
+    SetNonToken(tkobjcclass);
+    SetNonToken(tkobjcprotocol);
+    SetNonToken(tkobjcCategory);
     end;
   'DELPHIUNICODE':
     begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
     SetNonToken(tkspecialize);
+    SetNonToken(tkobjcclass);
+    SetNonToken(tkobjcprotocol);
+    SetNonToken(tkobjcCategory);
     end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);
   'MACPAS':
     SetMode(msMac,MacModeSwitches,false,bsMacPasMode);
   'ISO':
-    SetMode(msIso,ISOModeSwitches,false);
+    SetMode(msIso,ISOModeSwitches,false,[],[],false);
   'EXTENDED':
-    SetMode(msExtpas,ExtPasModeSwitches,false);
+    SetMode(msExtpas,ExtPasModeSwitches,false,[],[],false);
   'GPC':
     SetMode(msGPC,GPCModeSwitches,false);
   else
@@ -3687,6 +3726,7 @@ Var
   Enable: Boolean;
 
 begin
+  Enable:=False;
   PM:=Param;
   p:=1;
   while (p<=length(PM)) and (PM[p] in ['a'..'z','A'..'Z','_','0'..'9']) do
@@ -4090,7 +4130,10 @@ begin
   else if CompareText(Param,'off')=0 then
     NewValue:=false
   else
+    begin
+    NewValue:=True;// Fool compiler
     Error(nErrXExpectedButYFound,SErrXExpectedButYFound,['on',Param]);
+    end;
   if (bs in CurrentBoolSwitches)=NewValue then exit;
   if bs in ReadOnlyBoolSwitches then
     DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
@@ -4148,6 +4191,7 @@ var
   end;
 
 begin
+  TokenStart:={$ifdef UsePChar}nil{$else}0{$endif};
   Result:=tkLineEnding;
   if FTokenPos {$ifdef UsePChar}= nil{$else}<1{$endif} then
     if not FetchLine then
@@ -4885,6 +4929,18 @@ begin
     UnDefine(LetterSwitchNames['H'],true);
     Exclude(FCurrentBoolSwitches,bsLongStrings);
     end;
+  if ([msObjectiveC1,msObjectiveC2] * FCurrentModeSwitches) = [] then
+    begin
+    SetNonToken(tkobjcclass);
+    SetNonToken(tkobjcprotocol);
+    SetNonToken(tkobjccategory);
+    end
+  else
+    begin
+    UnSetNonToken(tkobjcclass);
+    UnSetNonToken(tkobjcprotocol);
+    UnSetNonToken(tkobjccategory);
+    end
 end;
 
 procedure TPascalScanner.SetCurrentValueSwitch(V: TValueSwitch;
@@ -5234,12 +5290,14 @@ end;
 
 function TPascalScanner.IgnoreMsgType(MsgType: TMessageType): boolean;
 begin
+  Result:=false;
   case MsgType of
     mtWarning: if not (bsWarnings in FCurrentBoolSwitches) then exit(true);
     mtNote: if not (bsNotes in FCurrentBoolSwitches) then exit(true);
     mtHint: if not (bsHints in FCurrentBoolSwitches) then exit(true);
+  else
+    // Do nothing, satisfy compiler
   end;
-  Result:=false;
 end;
 
 end.

packages/fcl-passrc/tests/tcclasstype.pas

@@ -5,12 +5,12 @@ unit tcclasstype;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pscanner,pparser, pastree, testregistry, tctypeparser;
+  Classes, SysUtils, fpcunit, pscanner, pparser, pastree, testregistry, tctypeparser;
 
 type
 
   { TTestClassType }
-
+  TClassDeclType = (cdtClass,cdtObjCClass,cdtObjCCategory);
   TTestClassType = Class(TBaseTestTypeParser)
   Private
     FDecl : TStrings;
@@ -30,10 +30,10 @@ type
     function GetP2: TPasProperty;
     function GetT(AIndex : Integer) : TPasType;
   protected
-    Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = '');
+    Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = ''; aClassType : TClassDeclType = cdtClass);
     Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
     Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
-    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False);
+    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False; UseObjcClass : Boolean = False);
     Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartVisibility(A : TPasMemberVisibility);
     Procedure EndClass(AEnd : String = 'end');
@@ -69,6 +69,8 @@ type
     procedure TestEmptyDeprecated;
     procedure TestEmptyEnd;
     procedure TestEmptyEndNoParent;
+    procedure TestEmptyObjC;
+    procedure TestEmptyObjCCategory;
     Procedure TestOneInterface;
     Procedure TestTwoInterfaces;
     procedure TestOneSpecializedClass;
@@ -101,6 +103,8 @@ type
     Procedure TestMethodSimple;
     Procedure TestMethodSimpleComment;
     Procedure TestMethodWithDotFails;
+    Procedure TestMethodWithDotOK;
+    Procedure TestMethodFunctionWithDotOK;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
@@ -165,6 +169,7 @@ type
     procedure TestClassHelperParentedEmpty;
     procedure TestClassHelperOneMethod;
     procedure TestInterfaceEmpty;
+    procedure TestObjcProtocolEmpty;
     procedure TestInterfaceDisp;
     procedure TestInterfaceParentedEmpty;
     procedure TestInterfaceOneMethod;
@@ -250,7 +255,7 @@ begin
   Result:=TPasConst(Members[AIndex]);
 end;
 
-procedure TTestClassType.StartClass(AncestorName: String; InterfaceList: String);
+procedure TTestClassType.StartClass(AncestorName: String; InterfaceList: String = ''; aClassType : TClassDeclType = cdtClass);
 
 Var
   S : String;
@@ -258,7 +263,20 @@ begin
   if FStarted then
     Fail('TTestClassType.StartClass already started');
   FStarted:=True;
-  S:='TMyClass = Class';
+  case aClassType of
+  cdtObjCClass:
+    begin
+    FDecl.Add('{$modeswitch objectivec1}');
+    S:='TMyClass = ObjCClass';
+    end;
+  cdtObjCCategory:
+    begin
+    FDecl.Add('{$modeswitch objectivec1}');
+    S:='TMyClass = ObjCCategory(aParent)';
+    end;
+  else
+    S:='TMyClass = Class';
+  end;
   if (AncestorName<>'') then
     begin
     S:=S+'('+AncestorName;
@@ -302,12 +320,17 @@ begin
 end;
 
 procedure TTestClassType.StartInterface(AParent: String; UUID: String;
-  Disp: Boolean = False);
+  Disp: Boolean = False; UseObjcClass : Boolean = False);
 Var
   S : String;
 begin
   FStarted:=True;
-  if Disp then
+  if UseObjCClass then
+    begin
+    FDecl.Add('{$modeswitch objectivec1}');
+    S:='TMyClass = objcprotocol'
+    end
+  else if Disp then
     S:='TMyClass = DispInterface'
   else
     S:='TMyClass = Interface';
@@ -516,6 +539,23 @@ begin
   AssertEquals('No members',0,TheClass.Members.Count);
 end;
 
+procedure TTestClassType.TestEmptyObjC;
+begin
+  StartClass('','',cdtObjCClass);
+  ParseClass;
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+end;
+
+procedure TTestClassType.TestEmptyObjCCategory;
+begin
+  StartClass('','',cdtObjCCategory);
+  ParseClass;
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertEquals('Is interface',okObjcCategory,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+end;
+
 procedure TTestClassType.TestOneInterface;
 begin
   StartClass('TObject','ISomething');
@@ -910,7 +950,29 @@ begin
   ParseClassFail('Expected ";"',nParserExpectTokenError);
 end;
 
+procedure TTestClassType.TestMethodWithDotOK;
+
+begin
+  AddMember('Procedure DoSomething.Stupid=me');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 method resolution procedure',TPasMethodResolution,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertNotNull('1 method resolution procedure',TPasMethodResolution(members[0]).ImplementationProc);
+end;
+
+procedure TTestClassType.TestMethodFunctionWithDotOK;
+begin
+  AddMember('Function DoSomething.Stupid=me');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 method resolution procedure',TPasMethodResolution,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertNotNull('1 method resolution procedure',TPasMethodResolution(members[0]).ImplementationProc);
+end;
+
 procedure TTestClassType.TestClassMethodSimple;
+
 begin
   AddMember('Class Procedure DoSomething');
   ParseClass;
@@ -925,6 +987,7 @@ begin
 end;
 
 procedure TTestClassType.TestClassMethodSimpleComment;
+
 begin
   AddComment:=True;
   AddMember('{c} Class Procedure DoSomething');
@@ -1855,6 +1918,17 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestObjcProtocolEmpty;
+begin
+  StartInterface('','',False,True);
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
+  AssertTrue('Is objectivec',TheClass.IsObjCClass);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
 procedure TTestClassType.TestInterfaceDisp;
 
 begin

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -115,6 +115,13 @@ type
     Procedure TestFunctionStdCall;
     Procedure TestProcedureOldFPCCall;
     Procedure TestFunctionOldFPCCall;
+    procedure TestCallingConventionHardFloat;
+    procedure TestCallingConventionMS_ABI_CDecl;
+    procedure TestCallingConventionMS_ABI_Default;
+    procedure TestCallingConventionMWPascal;
+    procedure TestCallingConventionSysV_ABI_CDec;
+    procedure TestCallingConventionSysV_ABI_Default;
+    procedure TestCallingConventionVectorCall;
     Procedure TestProcedurePublic;
     Procedure TestProcedurePublicIdent;
     Procedure TestFunctionPublic;
@@ -775,6 +782,49 @@ begin
   AssertArrayArg(FuncType,0,'B',argConst,'');
 end;
 
+procedure TTestProcedureFunction.TestCallingConventionSysV_ABI_Default;
+begin
+  ParseProcedure('; SysV_ABI_Default');
+  AssertProc([],[],ccSysV_ABI_Default,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionSysV_ABI_CDec;
+begin
+  ParseProcedure('; SysV_ABI_CDecl');
+  AssertProc([],[],ccSysV_ABI_CDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionMS_ABI_Default;
+begin
+  ParseProcedure('; MS_ABI_Default');
+  AssertProc([],[],ccMS_ABI_Default,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionMS_ABI_CDecl;
+begin
+  ParseProcedure('; MS_ABI_CDecl');
+  AssertProc([],[],ccMS_ABI_CDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionVectorCall;
+begin
+  ParseProcedure('; VectorCall');
+  AssertProc([],[],ccVectorCall,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionHardFloat;
+begin
+  ParseProcedure('; HardFloat');
+  AssertProc([],[],ccHardFloat,0);
+end;
+
+procedure TTestProcedureFunction.TestCallingConventionMWPascal;
+
+begin
+  ParseProcedure('; mwpascal');
+  AssertProc([],[],ccMWPascal,0);
+end;
+
 procedure TTestProcedureFunction.TestProcedureCdecl;
 begin
   ParseProcedure('; cdecl');

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -87,11 +87,15 @@ type
     procedure TestGen_Class_Enums_NotPropagating;
     procedure TestGen_Class_Self;
     procedure TestGen_Class_MemberTypeConstructor;
+    procedure TestGen_Class_AliasMemberType;
+    procedure TestGen_Class_AccessGenericMemberTypeFail;
+    procedure TestGen_Class_ReferenceTo; // ToDo
     procedure TestGen_Class_List;
     // ToDo: different modeswitches at parse time and specialize time
 
     // generic external class
     procedure TestGen_ExtClass_Array;
+    procedure TestGen_ExtClass_VarargsOfType;
 
     // generic interface
     procedure TestGen_ClassInterface;
@@ -104,6 +108,7 @@ type
 
     // generic procedure type
     procedure TestGen_ProcType;
+    procedure TestGen_ProcType_AnonymousFunc_Delphi;
 
     // pointer of generic
     procedure TestGen_PointerDirectSpecializeFail;
@@ -169,7 +174,8 @@ type
     procedure TestGenMethod_TemplNameDifferFail;
     procedure TestGenMethod_ImplConstraintFail;
     procedure TestGenMethod_NestedSelf;
-    procedure TestGenMethod_OverloadTypeParamCnt;
+    procedure TestGenMethod_OverloadTypeParamCntObjFPC;
+    procedure TestGenMethod_OverloadTypeParamCntDelphi;
     procedure TestGenMethod_OverloadArgs;
   end;
 
@@ -1387,6 +1393,87 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_AliasMemberType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TObject = class end;',
+  '',
+  '  generic TBird<T> = class',
+  '  public type',
+  '    TRun = reference to function (aValue : T) : T;',
+  '  end;',
+  '  TBirdWord = specialize TBird<Word>;',
+  '  TBirdWordRun = TBirdWord.TRun;',
+  '',
+  '  generic TExt<T> = class external name ''Ext''',
+  '  public type',
+  '    TRun = reference to function (aValue : T) : T;',
+  '  end;',
+  '  TExtWord = specialize TExt<Word>;',
+  '  TExtWordRun = TExtWord.TRun;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_AccessGenericMemberTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '',
+  '  generic TBird<T> = class',
+  '  public type',
+  '    TRun = reference to function (aValue : T) : T;',
+  '  end;',
+  '  TBirdRun = TBird.TRun;',
+  'begin',
+  '']);
+  CheckResolverException('Generics without specialization cannot be used as a type for a reference',
+    nGenericsWithoutSpecializationAsType);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_ReferenceTo;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TGJSPromise<T> = class',
+  '  public type',
+  '    TGJSPromiseResolver = reference to function (aValue : T) : T;',
+  '    TGJSPromiseExecutor = reference to procedure (resolve,reject : TGJSPromiseResolver);',
+  '  public',
+  '    constructor new(Executor : TGJSPromiseExecutor);',
+  '  end;',
+  'constructor TGJSPromise.new(Executor : TGJSPromiseExecutor);',
+  'begin',
+  'end;',
+  '',
+  'type',
+  '  TJSPromise = specialize TGJSPromise<Word>;',
+  '  TJSPromiseResolver = reference to function (aValue : Word) : Word;',
+  '',
+  '  TURLLoader = Class(TObject)',
+  '    procedure dofetch(resolve, reject: TJSPromiseResolver); virtual; abstract;',
+  '    Function fetch : TJSPromise;',
+  '  end;',
+  'function TURLLoader.fetch : TJSPromise;',
+  'begin',
+  '  Result:=TJSPromise.New(@Dofetch);',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_List;
 begin
   StartProgram(false);
@@ -1476,6 +1563,33 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ExtClass_VarargsOfType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '  end;',
+  '  generic TGJSSet<T> = class external name ''Set''',
+  '    constructor new(aElement1: T); varargs of T; overload;',
+  '    function bind(thisArg: TJSObject): T; varargs of T;',
+  '  end;',
+  '  TJSWordSet = specialize TGJSSet<word>;',
+  'var',
+  '  s: TJSWordSet;',
+  '  w: word;',
+  'begin',
+  '  s:=TJSWordSet.new(3);',
+  '  s:=TJSWordSet.new(3,5);',
+  '  w:=s.bind(nil);',
+  '  w:=s.bind(nil,6);',
+  '  w:=s.bind(nil,7,8);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ClassInterface;
 begin
   StartProgram(false);
@@ -1617,6 +1731,51 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ProcType_AnonymousFunc_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  IInterface = interface',
+  '  end;',
+  '  Integer = longint;',
+  '  IComparer<T> = interface',
+  '    function Compare(const Left, Right: T): Integer; overload;',
+  '  end;',
+  '  TOnComparison<T> = function(const Left, Right: T): Integer of object;',
+  '  TComparisonFunc<T> = reference to function(const Left, Right: T): Integer;',
+  '  TComparer<T> = class(TObject, IComparer<T>)',
+  '  public',
+  '    function Compare(const Left, Right: T): Integer; overload;',
+  '    class function Construct(const AComparison: TOnComparison<T>): IComparer<T>; overload;',
+  '    class function Construct(const AComparison: TComparisonFunc<T>): IComparer<T>; overload;',
+  '  end;',
+  'function TComparer<T>.Compare(const Left, Right: T): Integer; overload;',
+  'begin',
+  'end;',
+  'class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;',
+  'begin',
+  'end;',
+  'class function TComparer<T>.Construct(const AComparison: TComparisonFunc<T>): IComparer<T>;',
+  'begin',
+  'end;',
+  'procedure Test;',
+  'var',
+  '  aComparer : IComparer<Integer>;',
+  'begin',
+  '  aComparer:=TComparer<Integer>.Construct(function (Const a,b : integer) : integer',
+  '    begin',
+  '      Result:=a-b;',
+  '    end);',
+  'end;',
+  'begin',
+  '  Test;']);
+  ParseModule;
+end;
+
 procedure TTestResolveGenerics.TestGen_PointerDirectSpecializeFail;
 begin
   StartProgram(false);
@@ -2544,7 +2703,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCnt;
+procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntObjFPC;
 begin
   StartProgram(false);
   Add([
@@ -2569,6 +2728,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure {#A}Run<T>(a: T); overload;',
+  '    procedure {#B}Run<M,N>(a: M); overload;',
+  '  end;',
+  'procedure TObject.Run<T>(a: T);',
+  'begin',
+  'end;',
+  'procedure TObject.Run<M,N>(a: M);',
+  'begin',
+  '  {@A}Run<M>(a);',
+  '  {@B}Run<double,char>(1.3);',
+  'end;',
+  'var obj: TObject;',
+  'begin',
+  '  obj.{@A}Run<word>(3);',
+  '  obj.{@B}Run<word,char>(4);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_OverloadArgs;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcresolver.pas

@@ -432,6 +432,7 @@ type
     Procedure TestNestedForwardProcUnresolved;
     Procedure TestForwardProcFuncMismatch;
     Procedure TestForwardFuncResultMismatch;
+    Procedure TestForwardProcAssemblerMismatch;
     Procedure TestUnitIntfProc;
     Procedure TestUnitIntfProcUnresolved;
     Procedure TestUnitIntfMismatchArgName;
@@ -475,7 +476,7 @@ type
     Procedure TestAnonymousProc_Typecast_ObjFPC;
     Procedure TestAnonymousProc_Typecast_Delphi;
     Procedure TestAnonymousProc_TypecastToResultFail;
-    Procedure TestAnonymousProc_With;
+    Procedure TestAnonymousProc_WithDo;
     Procedure TestAnonymousProc_ExceptOn;
     Procedure TestAnonymousProc_Nested;
     Procedure TestAnonymousProc_ForLoop;
@@ -485,9 +486,9 @@ type
     Procedure TestRecordVariant;
     Procedure TestRecordVariantNested;
     Procedure TestRecord_WriteConstParamFail;
-    Procedure TestRecord_WriteConstParam_WithFail;
+    Procedure TestRecord_WriteConstParam_WithDoFail;
     Procedure TestRecord_WriteNestedConstParamFail;
-    Procedure TestRecord_WriteNestedConstParamWithFail;
+    Procedure TestRecord_WriteNestedConstParamWithDoFail;
     Procedure TestRecord_TypeCast;
     Procedure TestRecord_NewDispose;
     Procedure TestRecord_Const;
@@ -601,6 +602,7 @@ type
     Procedure TestClass_StaticWithoutClassFail;
     Procedure TestClass_SelfInStaticFail;
     Procedure TestClass_SelfDotInStaticFail;
+    Procedure TestClass_ProcStaticMismatchFail;
     Procedure TestClass_PrivateProtectedInSameUnit;
     Procedure TestClass_PrivateInMainBeginFail;
     Procedure TestClass_PrivateInDescendantFail;
@@ -612,9 +614,10 @@ type
     Procedure TestClass_ConDestructor_CallInherited;
     Procedure TestClass_Constructor_Inherited;
     Procedure TestClass_SubObject;
-    Procedure TestClass_WithClassInstance;
+    Procedure TestClass_WithDoClassInstance;
     Procedure TestClass_ProcedureExternal;
-    Procedure TestClass_ReintroducePublicVarFail;
+    Procedure TestClass_ReintroducePublicVarObjFPCFail;
+    Procedure TestClass_ReintroducePublicVarDelphi;
     Procedure TestClass_ReintroducePrivateVar;
     Procedure TestClass_ReintroduceProc;
     Procedure TestClass_UntypedParam_TypeCast;
@@ -765,11 +768,11 @@ type
     Procedure TestClassInterface_PassTypecastIntfToClassAsVarParamFail;
     Procedure TestClassInterface_GUID;
 
-    // with
-    Procedure TestWithBlock1;
-    Procedure TestWithBlock2;
-    Procedure TestWithBlockFuncResult;
-    Procedure TestWithBlockConstructor;
+    // with-do
+    Procedure TestWithDo1;
+    Procedure TestWithDo2;
+    Procedure TestWithDoFuncResult;
+    Procedure TestWithDoConstructor;
 
     // arrays
     Procedure TestDynArrayOfLongint;
@@ -778,6 +781,7 @@ type
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfCharDelphi;
     Procedure TestStaticArrayOfRangeElCheckFail;
+    Procedure TestArrayOfChar_String;
     Procedure TestArrayOfArray;
     Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestFunctionReturningArray;
@@ -812,6 +816,7 @@ type
     Procedure TestArray_OpenArrayAsDynArray;
     Procedure TestArray_OpenArrayDelphi;
     Procedure TestArray_OpenArrayChar;
+    Procedure TestArray_DynArrayChar;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestArray_CopyMismatchFail;
@@ -853,6 +858,7 @@ type
     Procedure TestAssignProcToFunctionFail;
     Procedure TestAssignProcWrongArgsFail;
     Procedure TestAssignProcWrongArgAccessFail;
+    Procedure TestProcType_SameSignatureObjFPC;
     Procedure TestProcType_AssignNestedProcFail;
     Procedure TestArrayOfProc;
     Procedure TestProcType_Assigned;
@@ -924,8 +930,9 @@ type
     Procedure TestClassHelper_NestedInheritedParentFail;
     Procedure TestClassHelper_AccessFields;
     Procedure TestClassHelper_HelperDotClassMethodFail;
-    Procedure TestClassHelper_WithHelperFail;
+    Procedure TestClassHelper_WithDoHelperFail;
     Procedure TestClassHelper_AsTypeFail;
+    Procedure TestClassHelper_WithDo;
     Procedure TestClassHelper_ClassMethod;
     Procedure TestClassHelper_Enumerator;
     Procedure TestClassHelper_FromUnitInterface;
@@ -4003,7 +4010,7 @@ begin
   Add('  f: TFlag;');
   Add('begin');
   Add('  if f=nil then ;');
-  CheckResolverException('Incompatible types: got "TFlag" expected "Pointer"',
+  CheckResolverException('Incompatible types: got "nil" expected "TFlag"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -7105,6 +7112,17 @@ begin
     nResultTypeMismatchExpectedButFound);
 end;
 
+procedure TTestResolver.TestForwardProcAssemblerMismatch;
+begin
+  StartProgram(false);
+  Add('procedure Run; assembler; forward;');
+  Add('procedure Run;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckParserException('Expected "asm"',nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestUnitIntfProc;
 begin
   StartUnit(false);
@@ -7865,7 +7883,7 @@ begin
     nIllegalTypeConversionTo);
 end;
 
-procedure TTestResolver.TestAnonymousProc_With;
+procedure TTestResolver.TestAnonymousProc_WithDo;
 begin
   StartProgram(false);
   Add([
@@ -8051,7 +8069,7 @@ begin
   CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
-procedure TTestResolver.TestRecord_WriteConstParam_WithFail;
+procedure TTestResolver.TestRecord_WriteConstParam_WithDoFail;
 begin
   StartProgram(false);
   Add('type');
@@ -8084,7 +8102,7 @@ begin
   CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
-procedure TTestResolver.TestRecord_WriteNestedConstParamWithFail;
+procedure TTestResolver.TestRecord_WriteNestedConstParamWithDoFail;
 begin
   StartProgram(false);
   Add('type');
@@ -8593,7 +8611,7 @@ begin
   'begin',
   '  w:=w+1;',
   'end;',
-  'class procedure TRec.Create;',
+  'class procedure TRec.Create; static;',
   'begin',
   '  w:=w+1;',
   'end;',
@@ -10510,6 +10528,21 @@ begin
   CheckResolverException('identifier not found "Self"',nIdentifierNotFound);
 end;
 
+procedure TTestResolver.TestClass_ProcStaticMismatchFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure Run;',
+  '  end;',
+  'procedure TObject.Run; static;',
+  'begin',
+  'end;',
+  'begin']);
+  CheckResolverException('Directive "static" not allowed here',nDirectiveXNotAllowedHere);
+end;
+
 procedure TTestResolver.TestClass_PrivateProtectedInSameUnit;
 begin
   StartProgram(false);
@@ -10926,7 +10959,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClass_WithClassInstance;
+procedure TTestResolver.TestClass_WithDoClassInstance;
 var
   aMarker: PSrcMarker;
   Elements: TFPList;
@@ -11009,22 +11042,59 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClass_ReintroducePublicVarFail;
+procedure TTestResolver.TestClass_ReintroducePublicVarObjFPCFail;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('  public');
-  Add('    Some: longint;');
-  Add('  end;');
-  Add('  TCar = class(tobject)');
-  Add('  public');
-  Add('    Some: longint;');
-  Add('  end;');
-  Add('begin');
+  Add([
+  'type',
+  '  TObject = class',
+  '  public',
+  '    Some: longint;',
+  '  end;',
+  '  TCar = class(tobject)',
+  '  public',
+  '    Some: longint;',
+  '  end;',
+  'begin']);
   CheckResolverException('Duplicate identifier "Some" at afile.pp(5,5)',nDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestClass_ReintroducePublicVarDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  public',
+  '    {#Obj_Some}Some: longint;',
+  '    {#Obj_Foo}Foo: word;',
+  '    function {#Obj_Bar}Bar: string;',
+  '  end;',
+  '  TCar = class(tobject)',
+  '  public',
+  '    {#Car_Some}Some: double;',
+  '    function {#Car_Foo}Foo: boolean;',
+  '    {#Car_Bar}Bar: single;',
+  '  end;',
+  'function TObject.Bar: string;',
+  'begin',
+  'end;',
+  'function TCar.Foo: boolean;',
+  'begin',
+  '  {@Car_Some}Some:=3.3;',
+  '  {@Car_Bar}Bar:=4.3;',
+  '  inherited {@Obj_Bar}Bar;',
+  '  inherited {@Obj_Bar}Bar();',
+  '  inherited {@Obj_Foo}Foo := 4;',
+  '  if inherited {@Obj_Some}Some = 5 then ;',
+  'end;',
+  'var C: TCar;',
+  'begin',
+  '  C.Some:=1.3;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass_ReintroducePrivateVar;
 begin
   StartProgram(false);
@@ -13929,7 +13999,7 @@ begin
   CheckResolverException('not readable',nNotReadable);
 end;
 
-procedure TTestResolver.TestWithBlock1;
+procedure TTestResolver.TestWithDo1;
 begin
   StartProgram(false);
   Add('type');
@@ -13946,7 +14016,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestWithBlock2;
+procedure TTestResolver.TestWithDo2;
 begin
   StartProgram(false);
   Add('type');
@@ -13974,7 +14044,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestWithBlockFuncResult;
+procedure TTestResolver.TestWithDoFuncResult;
 begin
   StartProgram(false);
   Add('type');
@@ -14002,7 +14072,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestWithBlockConstructor;
+procedure TTestResolver.TestWithDoConstructor;
 begin
   StartProgram(false);
   Add('type');
@@ -14137,6 +14207,25 @@ begin
     'range check error while evaluating constants (300 is not between -128 and 127)');
 end;
 
+procedure TTestResolver.TestArrayOfChar_String;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#a}Run(const s: string); overload;',
+  'begin end;',
+  'procedure {#b}Run(const a: array of char); overload;',
+  'begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  'begin',
+  '  {@a}Run(''foo'');',
+  '  {@a}Run(s);',
+  '  {@a}Run(c);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArrayOfArray;
 begin
   StartProgram(false);
@@ -14305,7 +14394,8 @@ begin
   Add('begin');
   Add('  doit({#a}getarr[1+1]);');
   Add('  doit({#b}getarr()[2+1]);');
-  Add('  doit({#b}getarr(7)[3+1]);');
+  Add('  doit({#c}getarr(7)[3+1]);');
+  ParseProgram;
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
     begin
@@ -14617,7 +14707,7 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  a:=nil;');
-  CheckResolverException('Incompatible types: got "Nil" expected "static array"',
+  CheckResolverException('Incompatible types: got "nil" expected "static array[] of Longint"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -14801,6 +14891,26 @@ begin
   'var Key: Char;',
   'begin',
   '  if CharInSet(Key, [^V, ^X, ^C]) then ;',
+  '  CharInSet(Key,''abc'');',
+  '  CharInSet(Key,Key);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_DynArrayChar;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type TArrChr = array of char;',
+  'var',
+  '  Key: Char;',
+  '  s: string;',
+  '  a: TArrChr;',
+  'begin',
+  '  a:=''Foo'';',
+  '  a:=Key;',
+  '  a:=s;',
   '']);
   ParseProgram;
 end;
@@ -15137,7 +15247,7 @@ begin
   '  args:=nil;',
   'end;',
   'begin']);
-  CheckResolverException('Incompatible types: got "Nil" expected "array of const"',nIncompatibleTypesGotExpected);
+  CheckResolverException('Incompatible types: got "nil" expected "array of const"',nIncompatibleTypesGotExpected);
 end;
 
 procedure TTestResolver.TestArrayOfConst_SetLengthFail;
@@ -15630,6 +15740,25 @@ begin
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestProcType_SameSignatureObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TRun = procedure(a: Word);',
+  '  TRunIt = procedure(a: TRun);',
+  '  TFly = procedure(a: Word);',
+  'procedure FlyIt(a: TFly);',
+  'begin',
+  'end;',
+  'var RunIt: TRunIt;',
+  'begin',
+  '  RunIt:=@FlyIt;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcType_AssignNestedProcFail;
 begin
   StartProgram(false);
@@ -17190,7 +17319,7 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
-procedure TTestResolver.TestClassHelper_WithHelperFail;
+procedure TTestResolver.TestClassHelper_WithDoHelperFail;
 begin
   StartProgram(false);
   Add([
@@ -17218,6 +17347,92 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
+procedure TTestResolver.TestClassHelper_WithDo;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualWith, ExpectedWith: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    procedure Run;',
+  '  end;',
+  '  THelper = class helper for TBird',
+  '    procedure Foo(w: word = 1);',
+  '  end;',
+  'procedure TBird.Run;',
+  'var b: TBird;',
+  'begin',
+  '  b.{#a1_not}Foo;',
+  '  b.{#b1_not}Foo();',
+  '  b.{#c1_not}Foo(2);',
+  '  with b do begin',
+  '    {#d1_with}Foo;',
+  '    {#e1_with}Foo();',
+  '    {#f1_with}Foo(3);',
+  '  end;',
+  'end;',
+  'procedure THelper.Foo(w: word);',
+  'var b: TBird;',
+  'begin',
+  '  b.{#a2_not}Foo;',
+  '  b.{#b2_not}Foo();',
+  '  b.{#c2_not}Foo(2);',
+  '  with b do begin',
+  '    {#d2_with}Foo;',
+  '    {#e2_with}Foo();',
+  '    {#f2_with}Foo(3);',
+  '  end;',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  b.{#a3_not}Foo;',
+  '  b.{#b3_not}Foo();',
+  '  b.{#c3_not}Foo(4);',
+  '  with b do begin',
+  '    {#d3_with}Foo;',
+  '    {#e3_with}Foo();',
+  '    {#f3_with}Foo(5);',
+  '  end;',
+  '']);
+  ParseProgram;
+
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClassHelper_WithDo ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualWith:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        writeln('TTestResolver.TestClassHelper_WithDo ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if Ref.WithExprScope<>nil then
+          ActualWith:=true;
+        break;
+        end;
+      ExpectedWith:=RightStr(aMarker^.Identifier,5)='_with';
+      if ActualWith<>ExpectedWith then
+        if ExpectedWith then
+          RaiseErrorAtSrcMarker('expected Ref.WithExprScope<>nil at "#'+aMarker^.Identifier+'"',aMarker)
+        else
+          RaiseErrorAtSrcMarker('expected Ref.WithExprScope=nil at "#'+aMarker^.Identifier+'"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestClassHelper_ClassMethod;
 begin
   StartProgram(false);
@@ -17321,9 +17536,10 @@ begin
     '  TObject = class',
     '  public',
     '    Id: word;',
+    '    FSize: string;',
     '  end;',
-    '  TObjHelper = class helper for TObject',
-    '    property Size: word read ID write ID;',
+    '  TOb21Helper = class helper for TObject',
+    '    property Size: string read FSize write FSize;',
     '  end;',
     '']),
     '');
@@ -17331,7 +17547,7 @@ begin
     LinesToStr([
     'uses unit2;',
     'type',
-    '  TObjHelper = class helper for TObject',
+    '  TOb3Helper = class helper for TObject',
     '    property Size: word read ID write ID;',
     '  end;',
     '']),
@@ -17341,6 +17557,7 @@ begin
   'uses unit2, unit3;',
   'var o: TObject;',
   'begin',
+  '  o.Size:=3;', // last unit wins
   '  o.Size:=o.Size;']);
   ParseProgram;
 end;

packages/fcl-passrc/tests/tcscanner.pas

@@ -197,6 +197,12 @@ type
     procedure TestWith;
     procedure TestXor;
     procedure TestLineEnding;
+    procedure TestObjCClass;
+    procedure TestObjCClass2;
+    procedure TestObjCProtocol;
+    procedure TestObjCProtocol2;
+    procedure TestObjCCategory;
+    procedure TestObjCCategory2;
     procedure TestTab;
     Procedure TestEscapedKeyWord;
     Procedure TestTokenSeries;
@@ -1358,6 +1364,37 @@ begin
   TestToken(tkLineEnding,#10);
 end;
 
+procedure TTestScanner.TestObjCClass;
+begin
+  TestToken(tkObjCClass,'objcclass');
+end;
+
+procedure TTestScanner.TestObjCClass2;
+begin
+  TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objcclass');
+end;
+
+procedure TTestScanner.TestObjCProtocol;
+begin
+  TestToken(tkObjCProtocol,'objcprotocol');
+end;
+
+procedure TTestScanner.TestObjCProtocol2;
+begin
+  TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objcprotocol');
+end;
+
+procedure TTestScanner.TestObjCCategory;
+
+begin
+  TestToken(tkObjCCategory,'objccategory');
+end;
+
+procedure TTestScanner.TestObjCCategory2;
+begin
+  TestTokens([tkComment,tkWhitespace,tkidentifier],'{$mode fpc} objccategory');
+end;
+
 
 procedure TTestScanner.TestTab;
 

packages/fcl-passrc/tests/tcstatements.pas

@@ -100,6 +100,8 @@ Type
     Procedure TestCaseIfCaseElse;
     Procedure TestCaseIfElse;
     Procedure TestCaseElseNoSemicolon;
+    Procedure TestCaseIfElseNoSemicolon;
+    procedure TestCaseIfOtherwiseNoSemicolon;
     Procedure TestRaise;
     Procedure TestRaiseEmpty;
     Procedure TestRaiseAt;
@@ -113,6 +115,7 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
+    Procedure TestTryExceptOnElseNoSemicolo;
     procedure TestTryExceptRaise;
     Procedure TestAsm;
     Procedure TestAsmBlock;
@@ -1277,6 +1280,54 @@ begin
   AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
 end;
 
+procedure TTestStatementParser.TestCaseIfElseNoSemicolon;
+Var
+  C : TPasImplCaseOf;
+  S : TPasImplCaseStatement;
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : dosomething;','2: if b then',' dosomething','else  dosomethingmore','else','a:=1;','end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
+  AssertEquals('case label count',3,C.Elements.Count);
+  S:=TPasImplCaseStatement(C.Elements[0]);
+  AssertEquals('case 1',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
+  S:=TPasImplCaseStatement(C.Elements[1]);
+  AssertEquals('case 2',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
+  AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
+procedure TTestStatementParser.TestCaseIfOtherwiseNoSemicolon;
+Var
+  C : TPasImplCaseOf;
+  S : TPasImplCaseStatement;
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : dosomething;','2: if b then',' dosomething','else  dosomethingmore','otherwise','a:=1;','end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
+  AssertEquals('case label count',3,C.Elements.Count);
+  S:=TPasImplCaseStatement(C.Elements[0]);
+  AssertEquals('case 1',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
+  S:=TPasImplCaseStatement(C.Elements[1]);
+  AssertEquals('case 2',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
+  AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
+
+
 procedure TTestStatementParser.TestRaise;
 
 Var
@@ -1655,6 +1706,44 @@ begin
   AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
 end;
 
+procedure TTestStatementParser.TestTryExceptOnElseNoSemicolo;
+Var
+  T : TPasImplTry;
+  S : TPasImplSimple;
+  E : TPasImplTryExcept;
+  O : TPasImplExceptOn;
+  EE : TPasImplTryExceptElse;
+begin
+  TestStatement(['Try','  DoSomething;','except','On E : Exception do','DoSomethingElse','else','DoSomethingMore','end']);
+  T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
+  AssertEquals(1,T.Elements.Count);
+  AssertNotNull(T.FinallyExcept);
+  AssertNotNull(T.ElseBranch);
+  AssertNotNull(T.Elements[0]);
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  S:=TPasImplSimple(T.Elements[0]);
+  AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
+  E:=TPasImplTryExcept(T.FinallyExcept);
+  AssertEquals(1,E.Elements.Count);
+  AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
+  O:=TPasImplExceptOn(E.Elements[0]);
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
+  AssertEquals(1,O.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
+  S:=TPasImplSimple(O.Elements[0]);
+  AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
+  AssertEquals('Except Else statement',TPasImplTryExceptElse,T.ElseBranch.ClassType);
+  EE:=TPasImplTryExceptElse(T.ElseBranch);
+  AssertEquals(1,EE.Elements.Count);
+  AssertNotNull(EE.Elements[0]);
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(EE.Elements[0]).ClassType);
+  S:=TPasImplSimple(EE.Elements[0]);
+  AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
+end;
+
 procedure TTestStatementParser.TestTryExceptRaise;
 Var
   T : TPasImplTry;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -135,6 +135,7 @@ type
     procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
     procedure TestM_Hint_GenFunctionResultArgNotUsed;
+    procedure TestM_Hint_GenFunc_LocalInsideImplUsed;
 
     // whole program optimization
     procedure TestWP_LocalVar;
@@ -159,6 +160,7 @@ type
     procedure TestWP_TypeInfo;
     procedure TestWP_TypeInfo_PropertyEnumType;
     procedure TestWP_TypeInfo_Alias;
+    procedure TestWP_TypeInfo_Specialize;
     procedure TestWP_ForInClass;
     procedure TestWP_AssertSysUtils;
     procedure TestWP_RangeErrorSysUtils;
@@ -2305,6 +2307,49 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_GenFunc_LocalInsideImplUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<T>;',
+  'var',
+  '  WhileV: T;',
+  '  RepeatV: T;',
+  '  ForR, ForV: T;',
+  '  IfCond: boolean;',
+  '  IfThenV,IfElseV: T;',
+  '  CaseV, CaseSt, CaseElse: T;',
+  '  TryFinallyV, TryFinallyX: T;',
+  '  TryExceptV, TryExceptOn, TryExceptElse: T;',
+  '  WithExpr: TObject;',
+  '  WithV: T;',
+  'begin',
+  '  while true do WhileV:=WhileV+1;',
+  '  repeat RepeatV:=RepeatV+1; until false;',
+  '  for ForR:=1 to 3 do ForV:=ForV+1;',
+  '  if IfCond then IfThenV:=IfThenV+1 else IfElseV:=IfElseV+1;',
+  '  case CaseV of',
+  '  1: CaseSt:=CaseSt+1;',
+  '  else',
+  '    CaseElse:=CaseElse+1;',
+  '  end;',
+  '  try TryFinallyV:=TryFinallyV+1; finally TryFinallyX:=TryFinallyX+1; end;',
+  '  try',
+  '    TryExceptV:=TryExceptV+1;',
+  '  except',
+  '  on TryExceptE: TObject do TryExceptOn:=TryExceptOn+1;',
+  '  else',
+  '    TryExceptElse:=TryExceptElse+1;',
+  '  end;',
+  '  with WithExpr do WithV:=WithV+1',
+  'end;',
+  'begin',
+  '  Run<word>();']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 begin
   StartProgram(false);
@@ -2825,6 +2870,30 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_TypeInfo_Specialize;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TProc<T> = procedure(a: T) of object;',
+  '  TWordProc = specialize TProc<word>;',
+  '  {$M+}',
+  '  TPersistent = class',
+  '  private',
+  '    FWordProc: TWordProc;',
+  '  published',
+  '    property Proc: TWordProc read FWordProc write FWordProc;',
+  '  end;',
+  '  {$M-}',
+  'var',
+  '  {#p_notypeinfo}p: pointer;',
+  'begin',
+  '  p:=typeinfo(TPersistent);',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestWP_ForInClass;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/testpassrc.lpi

@@ -1,15 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="10"/>
+    <Version Value="12"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
@@ -21,14 +21,19 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestRecordTypeParser.TestFieldAndClassVar"/>
+        <CommandLineParams Value="--suite=TTestScanner.TestObjCClass2"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=TTestScanner.TestObjCClass2"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="1">
       <Item1>

packages/pastojs/fpmake.pp

@@ -57,6 +57,11 @@ begin
     T:=P.Targets.AddUnit('pas2jspparser.pp');
     T:=P.Targets.AddUnit('pas2jsuseanalyzer.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
+    T:=P.Targets.AddUnit('pas2jsresstrfile.pp');
+      T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('pas2jsresources.pp');
+    T:=P.Targets.AddUnit('pas2jshtmlresources.pp');
+    T:=P.Targets.AddUnit('pas2jsjsresources.pp');
     T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
       T.Dependencies.AddUnit('pas2jscompiler');
     T:=P.Targets.AddUnit('pas2jspcucompiler.pp');

packages/pastojs/src/pas2jscompiler.pp

@@ -4889,13 +4889,13 @@ var
   begin
     if s='' then exit;
     if Flags='' then
-      Flags:=Space(Log.Indent)
+      Flags:=StringOfChar(' ',Log.Indent)
     else
       Flags:=Flags+',';
     if length(Flags)+length(s)>Log.LineLen then
     begin
       Log.LogPlain(Flags);
-      Flags:=Space(Log.Indent);
+      Flags:=StringOfChar(' ',Log.Indent);
     end;
     Flags:=Flags+s;
   end;

packages/pastojs/src/pas2jscompilercfg.pp

@@ -24,7 +24,7 @@ interface
 
 uses
   {$IFDEF NodeJS}
-  NodeJSFS,
+  node.fs,
   {$ENDIF}
   Classes, SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
 

packages/pastojs/src/pas2jsfilecache.pp

@@ -27,7 +27,7 @@ interface
 uses
   {$IFDEF Pas2js}
     {$IFDEF NodeJS}
-    JS, NodeJSFS,
+    JS, node.fs,
     {$ENDIF}
   {$ENDIF}
   Classes, SysUtils,
@@ -925,7 +925,7 @@ begin
       Filename:=ChompPathDelim(ResolveDots(Filename));
       if not FilenameIsAbsolute(Filename) then
         Filename:=WorkingDirectory+Filename;
-      Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Filename);
+      Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Filename);
       end;
     end;
 end;
@@ -939,7 +939,7 @@ begin
   if Info.Dir<>nil then
     Result:=Info.Dir.IndexOfFile(Info.ShortFilename)>=0
   else
-    Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename);
+    Result:={$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename);
 end;
 
 function TPas2jsCachedDirectories.FileExistsI(var Filename: string): integer;
@@ -952,7 +952,7 @@ begin
   if not GetFileInfo(Info) then exit;
   if Info.Dir=nil then
   begin
-    if {$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename) then
+    if {$IFDEF pas2js}Node.FS{$ELSE}SysUtils{$ENDIF}.FileExists(Info.Filename) then
       Result:=1;
   end
   else

packages/pastojs/src/pas2jsfileutils.pp

@@ -29,7 +29,7 @@ uses
   BaseUnix,
   {$ENDIF}
   {$IFDEF Pas2JS}
-  JS, NodeJS, NodeJSFS,
+  JS, NodeJS, Node.FS,
   {$ENDIF}
   SysUtils, Classes;
 

packages/pastojs/src/pas2jslogger.pp

@@ -30,7 +30,7 @@ uses
   {$IFDEF Pas2JS}
   JS,
   {$IFDEF NodeJS}
-  NodeJSFS,
+  Node.FS,
   {$ENDIF}
   {$ENDIF}
   pas2jsutils,

packages/pastojs/tests/tcfiler.pas

@@ -16,7 +16,7 @@
  Examples:
    ./testpas2js --suite=TTestPrecompile.TestPC_EmptyUnit
 }
-unit tcfiler;
+unit TCFiler;
 
 {$mode objfpc}{$H+}
 
@@ -31,7 +31,7 @@ uses
 
 type
   TPCCheckFlag = (
-    PCCGeneric
+    PCCGeneric // inside generic proc body
     );
   TPCCheckFlags = set of TPCCheckFlag;
 
@@ -81,6 +81,7 @@ type
     procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredGenericParamScope(const Path: string; Orig, Rest: TPasGenericParamsScope; Flags: TPCCheckFlags); virtual;
+    procedure CheckRestoredSpecializeTypeData(const Path: string; Orig, Rest: TPasSpecializeTypeData; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
     procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject; Flags: TPCCheckFlags); virtual;
@@ -195,7 +196,6 @@ type
     procedure TestPC_ClassInterface;
     procedure TestPC_Attributes;
 
-    procedure TestPC_GenericClass; // ToDo
     procedure TestPC_GenericFunction_Assign;
     procedure TestPC_GenericFunction_Asm;
     procedure TestPC_GenericFunction_RepeatUntil;
@@ -209,6 +209,28 @@ type
     procedure TestPC_GenericFunction_TryExcept;
     procedure TestPC_GenericFunction_LocalProc;
     procedure TestPC_GenericFunction_AnonymousProc;
+    procedure TestPC_GenericClass;
+    procedure TestPC_GenericMethod;
+    procedure TestPC_SpecializeClassSameUnit; // ToDo
+    // ToDo: specialize local generic type in unit interface
+    // ToDo: specialize local generic type in unit implementation
+    // ToDo: specialize local generic type in proc decl
+    // ToDo: specialize local generic type in proc body
+    // ToDo: inline specialize local generic type in unit interface
+    // ToDo: inline specialize local generic type in unit implementation
+    // ToDo: inline specialize local generic type in proc decl
+    // ToDo: inline specialize local generic type in proc body
+    // ToDo: specialize extern generic type in unit interface
+    // ToDo: specialize extern generic type in unit implementation
+    // ToDo: specialize extern generic type in proc decl
+    // ToDo: specialize extern generic type in proc body
+    // ToDo: inline specialize extern generic type in unit interface
+    // ToDo: inline specialize extern generic type in unit implementation
+    // ToDo: inline specialize extern generic type in proc decl
+    // ToDo: inline specialize extern generic type in proc body
+    // ToDo: half specialize TBird<T> = class a: TAnt<word,T>; end;
+    // ToDo: no specialize: TBird<T> = class a: TBird<T>; end;
+    // ToDo: constraints
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -958,6 +980,13 @@ begin
   if Flags=[] then ;
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredSpecializeTypeData(
+  const Path: string; Orig, Rest: TPasSpecializeTypeData; Flags: TPCCheckFlags);
+begin
+  if Flags<>[] then ;
+  CheckRestoredReference(Path+'.SpecializedType',Orig.SpecializedType,Rest.SpecializedType);
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredResolvedReference(
   const Path: string; Orig, Rest: TResolvedReference; Flags: TPCCheckFlags);
 var
@@ -1088,6 +1117,8 @@ begin
     CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest),Flags)
   else if C=TPasGenericParamsScope then
     CheckRestoredGenericParamScope(Path+'[TPasGenericParamScope]',TPasGenericParamsScope(Orig),TPasGenericParamsScope(Rest),Flags)
+  else if C=TPasSpecializeTypeData then
+    CheckRestoredSpecializeTypeData(Path+'[TPasSpecializeTypeData]',TPasSpecializeTypeData(Orig),TPasSpecializeTypeData(Rest),Flags)
   else if C.InheritsFrom(TResEvalValue) then
     CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
   else
@@ -1156,7 +1187,17 @@ begin
 
   AModule:=Orig.GetModule;
   if AModule<>Module then
+    begin
+    if (Orig is TPasUnresolvedSymbolRef) then
+      begin
+      // built-in identifier
+      if not SameText(Orig.Name,Rest.Name) then
+        AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
+      if not CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData) then exit;
+      exit;
+      end;
     Fail(Path+' wrong module: Orig='+GetObjName(AModule)+' '+GetObjName(Module));
+    end;
 
   AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
   AssertEquals(Path+'.SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
@@ -2679,28 +2720,6 @@ begin
   WriteReadUnit;
 end;
 
-procedure TTestPrecompile.TestPC_GenericClass;
-begin
-  StartUnit(false);
-  Add([
-  'interface',
-  'type',
-  '  TObject = class',
-  '  end;',
-  '  generic TBird<T> = class',
-  '    a: T;',
-  '    function Run: T;',
-  '  end;',
-  'implementation',
-  'function TBird.Run: T;',
-  'var b: T;',
-  'begin',
-  '  b:=a; Result:=b;',
-  'end;',
-  '']);
-  WriteReadUnit;
-end;
-
 procedure TTestPrecompile.TestPC_GenericFunction_Assign;
 begin
   StartUnit(false);
@@ -3011,6 +3030,74 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_GenericClass;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  generic TBird<T> = class',
+  '    a: T;',
+  '    function Run: T;',
+  '  end;',
+  'implementation',
+  'function TBird.Run: T;',
+  'var b: T;',
+  'begin',
+  '  b:=a; Result:=b;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_GenericMethod;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class',
+  '    function Run<T>(a: T): T;',
+  '  end;',
+  'implementation',
+  'function TBird.Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  b:=a;',
+  '  Result:=b;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_SpecializeClassSameUnit;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird<T> = class',
+  '    a: T;',
+  '  end;',
+  '  TBigBird = TBIrd<double>;',
+  'var',
+  '  b: TBigBird;',
+  'implementation',
+  'begin',
+  '  b.a:=1.3;',
+  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',

packages/pastojs/tests/tcgenerics.pas

@@ -35,11 +35,18 @@ type
     Procedure TestGen_Class_ClassConstructor;
     // ToDo: rename local const T
     Procedure TestGen_Class_TypeCastSpecializesWarn;
+    Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn;
+    procedure TestGen_Class_VarArgsOfType;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
-    // ToDo: TestGen_ExtClass_GenJSValueAssign  TExt<JSValue> := TExt<Word>
-    // ToDo: TestGen_ExtClass_TypeCastJSValue  TExt<Word>(aTExt<JSValue>) and vice versa
+    procedure TestGen_ExtClass_GenJSValueAssign;
+    procedure TestGen_ExtClass_AliasMemberType;
+    Procedure TestGen_ExtClass_RTTI;
+
+    // class interfaces
+    procedure TestGen_ClassInterface_Corba;
+    procedure TestGen_ClassInterface_InterfacedObject;
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
@@ -59,7 +66,7 @@ type
     procedure TestGenProc_TypeInfo;
     procedure TestGenProc_Infer_Widen;
     procedure TestGenProc_Infer_PassAsArg;
-    // ToDo: FuncName:=
+    // ToDo: FuncName:= instead of Result:=
 
     // generic methods
     procedure TestGenMethod_ObjFPC;
@@ -678,6 +685,93 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestGenerics.TestGen_Class_TypeCastSpecializesJSValueNoWarn;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class F: T; end;',
+  '  TBirdWord = TBird<Word>;',
+  '  TBirdAny = TBird<JSValue>;',
+  'var',
+  '  w: TBirdWord;',
+  '  a: TBirdAny;',
+  'begin',
+  '  w:=TBirdWord(a);',
+  '  a:=TBirdAny(w);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_TypeCastSpecializesJSValueNoWarn',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.F = 0;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G2", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.F = undefined;',
+    '  };',
+    '});',
+    'this.w = null;',
+    'this.a = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = $mod.a;',
+    '$mod.a = $mod.w;',
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestGenerics.TestGen_Class_VarArgsOfType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '  end;',
+  '  generic TGJSSet<T> = class external name ''Set''',
+  '    constructor new(aElement1: T); varargs of T; overload;',
+  '    function bind(thisArg: TJSObject): T; varargs of T;',
+  '  end;',
+  '  TJSWordSet = specialize TGJSSet<word>;',
+  'var',
+  '  s: TJSWordSet;',
+  '  w: word;',
+  'begin',
+  '  s:=TJSWordSet.new(3);',
+  '  s:=TJSWordSet.new(3,5);',
+  '  w:=s.bind(nil);',
+  '  w:=s.bind(nil,6);',
+  '  w:=s.bind(nil,7,8);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_VarArgsOfType',
+    LinesToStr([ // statements
+    'this.s = null;',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.s = new Set(3);',
+    '$mod.s = new Set(3, 5);',
+    '$mod.w = $mod.s.bind(null);',
+    '$mod.w = $mod.s.bind(null, 6);',
+    '$mod.w = $mod.s.bind(null, 7, 8);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);
@@ -737,6 +831,186 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ExtClass_GenJSValueAssign;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExt<T> = class external name ''Ext''',
+  '    F: T;',
+  '  end;',
+  '  TExtWord = TExt<Word>;',
+  '  TExtAny = TExt<JSValue>;',
+  'procedure Run(e: TExtAny);',
+  'begin end;',
+  'var',
+  '  w: TExtWord;',
+  '  a: TExtAny;',
+  'begin',
+  '  a:=w;',
+  '  Run(w);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ExtClass_GenJSValueAssign',
+    LinesToStr([ // statements
+    'this.Run = function (e) {',
+    '};',
+    'this.w = null;',
+    'this.a = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.a = $mod.w;',
+    '$mod.Run($mod.w);',
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestGenerics.TestGen_ExtClass_AliasMemberType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  generic TExt<T> = class external name ''Ext''',
+  '  public type TRun = reference to function(a: T): T;',
+  '  end;',
+  '  TExtWord = specialize TExt<word>;',
+  '  TExtWordRun = TExtWord.TRun;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ExtClass_AliasMemberType',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ExtClass_RTTI;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  generic TGJSSET<T> = class external name ''SET''',
+  '    A: T;',
+  '  end;',
+  '  TJSSet = specialize TGJSSET<JSValue>;',
+  '  TJSSetEventProc = reference to procedure(value : JSValue; key: NativeInt; set_: TJSSet);',
+  'var p: Pointer;',
+  'begin',
+  '  p:=typeinfo(TJSSetEventProc);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ExtClass_RTTI',
+    LinesToStr([ // statements
+    '$mod.$rtti.$ExtClass("TGJSSET$G1", {',
+    '  jsclass: "SET"',
+    '});',
+    '$mod.$rtti.$RefToProcVar("TJSSetEventProc", {',
+    '  procsig: rtl.newTIProcSig([["value", rtl.jsvalue], ["key", rtl.nativeint], ["set_", $mod.$rtti["TGJSSET$G1"]]])',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TJSSetEventProc"];',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ClassInterface_Corba;
+begin
+  StartProgram(false);
+  Add([
+  '{$interfaces corba}',
+  'type',
+  '  IUnknown = interface;',
+  '  IUnknown = interface',
+  '    [''{00000000-0000-0000-C000-000000000046}'']',
+  '  end;',
+  '  IInterface = IUnknown;',
+  '  generic IBird<T> = interface(IInterface)',
+  '    function GetSize: T;',
+  '    procedure SetSize(i: T);',
+  '    property Size: T read GetSize write SetSize;',
+  '    procedure DoIt(i: T);',
+  '  end;',
+  '  TObject = class',
+  '  end;',
+  '  generic TBird<T> = class(TObject,specialize IBird<T>)',
+  '    function GetSize: T; virtual; abstract;',
+  '    procedure SetSize(i: T); virtual; abstract;',
+  '    procedure DoIt(i: T); virtual; abstract;',
+  '  end;',
+  '  IWordBird = specialize IBird<Word>;',
+  '  TWordBird = specialize TBird<Word>;',
+  'var',
+  '  BirdIntf: IWordBird;',
+  'begin',
+  '  BirdIntf.Size:=BirdIntf.Size;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassInterface_Corba',
+    LinesToStr([ // statements
+    'rtl.createInterface($mod, "IUnknown", "{00000000-0000-0000-C000-000000000046}", [], null);',
+    'rtl.createInterface($mod, "IBird$G2", "{7D9907A1-5178-37B5-9D32-7BC020005905}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  rtl.addIntf(this, $mod.IBird$G2);',
+    '});',
+    'this.BirdIntf = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.BirdIntf.SetSize($mod.BirdIntf.GetSize());',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ClassInterface_InterfacedObject;
+begin
+  StartProgram(true,[supTInterfacedObject]);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  IComparer<T> = interface [''{505778ED-F783-4456-9691-32F419CC5E18}'']',
+  '    function Compare(const Left, Right: T): Integer; overload;',
+  '  end;',
+  '  TComparer<T> = class(TInterfacedObject, IComparer<T>)',
+  '    function Compare(const Left, Right: T): Integer;',
+  '  end;',
+  'function TComparer<T>.Compare(const Left, Right: T): Integer; begin end;',
+  'var',
+  '  aComparer : IComparer<Integer>;',
+  'begin',
+  '  aComparer:=TComparer<Integer>.Create;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassInterface_InterfacedObject',
+    LinesToStr([ // statements
+    'rtl.createInterface($mod, "IComparer$G2", "{505778ED-F783-4456-9691-32F419CC5E18}", ["Compare"], pas.system.IUnknown);',
+    'rtl.createClass($mod, "TComparer$G1", pas.system.TInterfacedObject, function () {',
+    '  this.Compare = function (Left, Right) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  rtl.addIntf(this, $mod.IComparer$G2);',
+    '  rtl.addIntf(this, pas.system.IUnknown);',
+    '});',
+    'this.aComparer = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'rtl.setIntfP($mod, "aComparer", rtl.queryIntfT($mod.TComparer$G1.$create("Create"), $mod.IComparer$G2), true);',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_InlineSpec_Constructor;
 begin
   StartProgram(false);

packages/pastojs/tests/testpas2js.lpi

@@ -72,6 +72,7 @@
       <Unit7>
         <Filename Value="tcfiler.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCFiler"/>
       </Unit7>
       <Unit8>
         <Filename Value="../src/pas2jsfiler.pp"/>

packages/rtl-generics/tests/testrunner.rtlgenerics.lpi

@@ -27,7 +27,7 @@
         <CommandLineParams Value="-a --format=plain"/>
       </local>
     </RunParams>
-    <Units Count="7">
+    <Units Count="8">
       <Unit0>
         <Filename Value="testrunner.rtlgenerics.pp"/>
         <IsPartOfProject Value="True"/>
@@ -56,6 +56,10 @@
         <Filename Value="tests.generics.utils.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit6>
+      <Unit7>
+        <Filename Value="tests.generics.dictionary.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/rtl-generics/tests/testrunner.rtlgenerics.pp

@@ -12,7 +12,8 @@ uses
   tests.generics.arrayhelper,
   tests.generics.trees,
   tests.generics.stdcollections,
-  tests.generics.sets
+  tests.generics.sets,
+  tests.generics.dictionary
   ;
 
 var

packages/rtl-generics/tests/tests.generics.dictionary.pas

@@ -0,0 +1,463 @@
+unit tests.generics.dictionary;
+
+{$mode objfpc}
+
+interface
+
+uses
+  fpcunit, testregistry, Classes, SysUtils, Generics.Defaults, Generics.Collections;
+
+Type
+  TMySimpleDict = Class(Specialize TDictionary<Integer,String>);
+{$IFDEF FPC}
+  EDictionary = EListError;
+  TMyPair = specialize TPair<Integer,String>;
+{$ENDIF}
+  { TTestSimpleDictionary }
+
+  TTestSimpleDictionary = Class(TTestCase)
+  Private
+    FDict : TMySimpleDict;
+    FnotifyMessage : String;
+    FCurrentKeyNotify : Integer;
+    FCurrentValueNotify : Integer;
+    FExpectKeys : Array of Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction,
+    FExpectKeyAction: Array of TCollectionNotification;
+    procedure DoAdd(aCount: Integer; aOffset: Integer=0);
+    procedure DoAdd2;
+    Procedure DoneExpectKeys;
+    Procedure DoneExpectValues;
+    procedure DoGetValue(aKey: Integer; Match: String; ExceptionClass: TClass=nil);
+    procedure DoKeyNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: Integer; AAction: TCollectionNotification);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+  Public
+    Procedure SetExpectKeys(aMessage : string; AKeys : Array of Integer; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Dict : TMySimpleDict Read FDict;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAdd;
+    Procedure TestClear;
+    Procedure TestTryGetValue;
+    Procedure TestGetValue;
+    Procedure TestSetValue;
+    Procedure TestAddDuplicate;
+    Procedure TestAddOrSet;
+    Procedure TestContainsKey;
+    Procedure TestContainsValue;
+    Procedure TestDelete;
+    Procedure TestToArray;
+    procedure TestKeys;
+    Procedure TestValues;
+    Procedure TestEnumerator;
+    Procedure TestNotification;
+    procedure TestNotificationDelete;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+    procedure TestKeyValueNotificationSet;
+  end;
+
+implementation
+
+{ TTestSimpleDictionary }
+
+procedure TTestSimpleDictionary.SetUp;
+begin
+  inherited SetUp;
+  FDict:=TMySimpleDict.Create;
+  FCurrentKeyNotify:=0;
+  FCurrentValueNotify:=0;
+  FExpectKeys:=[];
+  FExpectKeyAction:=[];
+  FExpectValues:=[];
+  FExpectValueAction:=[];
+end;
+
+procedure TTestSimpleDictionary.TearDown;
+begin
+  // So we don't get clear messages
+  FDict.OnKeyNotify:=Nil;
+  FDict.OnValueNotify:=Nil;
+  FreeAndNil(FDict);
+  inherited TearDown;
+end;
+
+procedure TTestSimpleDictionary.TestEmpty;
+begin
+  AssertNotNull('Have dictionary',Dict);
+  AssertEquals('empty dictionary',0,Dict.Count);
+end;
+
+procedure TTestSimpleDictionary.DoAdd(aCount : Integer; aOffset : Integer=0);
+
+Var
+  I : Integer;
+
+begin
+  if aOffset=-1 then
+    aOffset:=Dict.Count;
+  For I:=aOffset+1 to aOffset+aCount do
+    Dict.Add(I,IntToStr(i));
+end;
+
+procedure TTestSimpleDictionary.TestAdd;
+
+begin
+  DoAdd(1);
+  AssertEquals('Count OK',1,Dict.Count);
+  AssertTrue('Has added value',Dict.ContainsKey(1));
+  DoAdd(1,1);
+  AssertEquals('Count OK',2,Dict.Count);
+  AssertTrue('Has added value',Dict.ContainsKey(2));
+end;
+
+procedure TTestSimpleDictionary.TestClear;
+begin
+  DoAdd(3);
+  AssertEquals('Count OK',3,Dict.Count);
+  Dict.Clear;
+  AssertEquals('Count after clear OK',0,Dict.Count);
+end;
+
+procedure TTestSimpleDictionary.TestTryGetValue;
+
+Var
+  I : integer;
+  SI,A : string;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertTrue('Have value '+SI,Dict.TryGetValue(I,A));
+    AssertEquals('Value is correct '+SI,SI,A);
+    end;
+  AssertFalse('Have no value 4',Dict.TryGetValue(4,A));
+end;
+
+procedure TTestSimpleDictionary.DoGetValue(aKey: Integer; Match: String; ExceptionClass: TClass);
+
+Var
+  EC : TClass;
+  A,EM : String;
+
+begin
+  EC:=Nil;
+  try
+    A:=Dict.Items[aKey];
+  except
+    On E : Exception do
+      begin
+      EC:=E.ClassType;
+      EM:=E.Message;
+      end
+  end;
+  if ExceptionClass=Nil then
+    begin
+    if EC<>Nil then
+      Fail('Got exception '+EC.ClassName+' with message: '+EM);
+    AssertEquals('Value is correct for '+IntToStr(aKey),Match,A)
+    end
+  else
+    begin
+    if EC=Nil then
+      Fail('Expected exception '+ExceptionClass.ClassName+' but got none');
+    if EC<>ExceptionClass then
+      Fail('Expected exception class '+ExceptionClass.ClassName+' but got '+EC.ClassName+' with message '+EM);
+    end;
+end;
+
+procedure TTestSimpleDictionary.DoKeyNotify(ASender: TObject;  {$ifdef fpc}constref{$else}const{$endif}  AItem: Integer; AAction: TCollectionNotification);
+begin
+  Writeln(FnotifyMessage+' Notification',FCurrentKeyNotify);
+  AssertSame(FnotifyMessage+' Correct sender', FDict,aSender);
+  if (FCurrentKeyNotify>=Length(FExpectKeys)) then
+    Fail(FnotifyMessage+' Too many notificiations');
+  AssertEquals(FnotifyMessage+' Notification Key no '+IntToStr(FCurrentKeyNotify),FExpectKeys[FCurrentKeyNotify],aItem);
+  Inc(FCurrentKeyNotify);
+end;
+
+procedure TTestSimpleDictionary.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FDict,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+procedure TTestSimpleDictionary.SetExpectKeys(aMessage: string; AKeys: array of Integer;
+  AActions: array of TCollectionNotification; DoReverse: Boolean = False);
+
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentKeyNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectkeys: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectKeys,L);
+  SetLength(FExpectKeyAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectKeys[L-i]:=AKeys[i];
+      FExpectKeyAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectKeys[i]:=AKeys[i];
+      FExpectKeyAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleDictionary.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleDictionary.TestGetValue;
+
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    DoGetValue(I,IntToStr(I));
+  DoGetValue(4,'4',EDictionary);
+end;
+
+procedure TTestSimpleDictionary.TestSetValue;
+begin
+  TestGetValue;
+  Dict.Items[3]:='Six';
+  DoGetValue(3,'Six');
+end;
+
+procedure TTestSimpleDictionary.DoAdd2;
+
+begin
+  Dict.Add(2,'A new 2');
+end;
+
+procedure TTestSimpleDictionary.DoneExpectKeys;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of keys seen',Length(FExpectKeys),FCurrentKeyNotify);
+end;
+
+procedure TTestSimpleDictionary.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
+procedure TTestSimpleDictionary.TestAddDuplicate;
+begin
+  DoAdd(3);
+  AssertException('Cannot add duplicate',EDictionary,@DoAdd2);
+end;
+
+procedure TTestSimpleDictionary.TestAddOrSet;
+
+begin
+  DoAdd(3);
+  Dict.AddOrSetValue(2,'a new 2');
+  DoGetValue(2,'a new 2');
+end;
+
+procedure TTestSimpleDictionary.TestContainsKey;
+
+Var
+  I : Integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    AssertTrue('Has '+IntToStr(i),Dict.ContainsKey(I));
+  AssertFalse('Has not 4',Dict.ContainsKey(4));
+end;
+
+procedure TTestSimpleDictionary.TestContainsValue;
+
+Var
+  I : Integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    AssertTrue('Has '+IntToStr(i),Dict.ContainsValue(IntToStr(i)));
+  AssertFalse('Has not 4',Dict.ContainsValue('4'));
+end;
+
+procedure TTestSimpleDictionary.TestDelete;
+
+begin
+  DoAdd(3);
+  Dict.Remove(2);
+  AssertEquals('Count',2,Dict.Count);
+  AssertFalse('Has not 2',Dict.ContainsKey(2));
+end;
+
+procedure TTestSimpleDictionary.TestToArray;
+
+Var
+{$ifdef fpc}
+  A : specialize TArray<TMyPair>;
+{$else}
+  A : specialize TArray<TMySimpleDict.TMyPair>;
+{$endif}
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A[i-1].Key);
+    AssertEquals('Value '+SI,SI,A[i-1].Value);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestKeys;
+
+Var
+  A : Array of Integer;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.Keys.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A[i-1]);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestValues;
+Var
+  A : Array of String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Dict.Values.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[i-1]);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestEnumerator;
+
+Var
+{$ifdef fpc}
+  A : TMyPair;
+{$else}
+  A : TMySimpleDict.TMyPair;
+{$endif}
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Dict do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('key '+SI,I,A.Key);
+    AssertEquals('Value '+SI,SI,A.Value);
+    Inc(I);
+    end;
+end;
+
+procedure TTestSimpleDictionary.TestNotification;
+begin
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectKeys('Add',[1,2,3],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectKeys;
+end;
+
+procedure TTestSimpleDictionary.TestNotificationDelete;
+
+begin
+  DoAdd(3);
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectKeys('Clear',[1,2,3],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Dict.Clear;
+  DoneExpectKeys;
+end;
+
+procedure TTestSimpleDictionary.TestValueNotification;
+begin
+  Dict.OnValueNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleDictionary.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Dict.OnValueNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Dict.Clear;
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleDictionary.TestKeyValueNotificationSet;
+begin
+  DoAdd(3);
+  Dict.OnValueNotify:=@DoValueNotify;
+  Dict.OnKeyNotify:=@DoKeyNotify;
+  SetExpectValues('Set',['2','Six'],[cnRemoved,cnAdded]);
+  SetExpectKeys('Set',[],[]);
+  Dict[2]:='Six';
+  DoneExpectKeys;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTest(TTestSimpleDictionary);
+end.
+

utils/pas2js/dist/rtl.js

@@ -129,8 +129,7 @@ var rtl = {
   exitcode: 0,
 
   run: function(module_name){
-  
-    function doRun(){
+    try {
       if (!rtl.hasString(module_name)) module_name='program';
       if (rtl.debug_load_units) rtl.debug('rtl.run module="'+module_name+'"');
       rtl.initRTTI();
@@ -143,21 +142,36 @@ var rtl = {
         var r = pas.program.$main();
         if (rtl.isNumber(r)) rtl.exitcode = r;
       }
-    }
-    
-    if (rtl.showUncaughtExceptions) {
-      try{
-        doRun();
-      } catch(re) {
-        var errMsg = rtl.hasString(re.$classname) ? re.$classname : '';
-	    errMsg +=  ((errMsg) ? ': ' : '') + (re.hasOwnProperty('fMessage') ? re.fMessage : re);
-        alert('Uncaught Exception : '+errMsg);
-        rtl.exitCode = 216;
+    } catch(re) {
+      if (!rtl.showUncaughtExceptions) {
+        throw re
+      } else {  
+        if (!rtl.handleUncaughtException(re)) {
+          rtl.showException(re);
+          rtl.exitcode = 216;
+        }  
+      }
+    } 
+    return rtl.exitcode;
+  },
+  
+  showException : function (re) {
+    var errMsg = rtl.hasString(re.$classname) ? re.$classname : '';
+    errMsg +=  ((errMsg) ? ': ' : '') + (re.hasOwnProperty('fMessage') ? re.fMessage : re);
+    alert('Uncaught Exception : '+errMsg);
+  },
+
+  handleUncaughtException: function (e) {
+    if (rtl.onUncaughtException) {
+      try {
+        rtl.onUncaughtException(e);
+        return true;
+      } catch (ee) {
+        return false; 
       }
     } else {
-      doRun();
+      return false;
     }
-    return rtl.exitcode;
   },
 
   loadintf: function(module){
@@ -229,6 +243,23 @@ var rtl = {
     return cb;
   },
 
+  createSafeCallback: function(scope, fn){
+    var cb = function(){
+      try{
+        if (typeof(fn)==='string'){
+          return scope[fn].apply(scope,arguments);
+        } else {
+          return fn.apply(scope,arguments);
+        };
+      } catch (err) {
+        if (!rtl.handleUncaughtException(err)) throw err;
+      }
+    };
+    cb.scope = scope;
+    cb.fn = fn;
+    return cb;
+  },
+
   cloneCallback: function(cb){
     return rtl.createCallback(cb.scope,cb.fn);
   },
@@ -388,6 +419,15 @@ var rtl = {
     return null;
   },
 
+  hideProp: function(o,p,v){
+    Object.defineProperty(o,p, {
+      enumerable: false,
+      configurable: true,
+      writable: true
+    });
+    if(arguments.length>2){ o[p]=v; }
+  },
+
   recNewT: function(parent,name,initfn,full){
     // create new record type
     var t = {};
@@ -811,10 +851,20 @@ var rtl = {
     return (arr == null) ? 0 : arr.length;
   },
 
+  arrayRef: function(a){
+    if (a!=null) rtl.hideProp(a,'$pas2jsrefcnt',1);
+    return a;
+  },
+
   arraySetLength: function(arr,defaultvalue,newlength){
     var stack = [];
+    var s = 9999;
     for (var i=2; i<arguments.length; i++){
-      stack.push({ dim:arguments[i]+0, a:null, i:0, src:null });
+      var j = arguments[i];
+      if (j==='s'){ s = i-2; }
+      else {
+        stack.push({ dim:j+0, a:null, i:0, src:null });
+      }
     }
     var dimmax = stack.length-1;
     var depth = 0;
@@ -822,13 +872,28 @@ var rtl = {
     var item = null;
     var a = null;
     var src = arr;
-    var oldlen = 0
+    var srclen = 0, oldlen = 0;
     do{
-      a = [];
       if (depth>0){
         item=stack[depth-1];
-        item.a[item.i]=a;
         src = (item.src && item.src.length>item.i)?item.src[item.i]:null;
+      }
+      if (!src){
+        a = [];
+        srclen = 0;
+        oldlen = 0;
+      } else if (src.$pas2jsrefcnt>0 || depth>=s){
+        a = [];
+        srclen = src.length;
+        oldlen = srclen;
+      } else {
+        a = src;
+        srclen = 0;
+        oldlen = a.length;
+      }
+      a.length = stack[depth].dim;
+      if (depth>0){
+        item.a[item.i]=a;
         item.i++;
       }
       if (depth<dimmax){
@@ -838,20 +903,23 @@ var rtl = {
         item.src = src;
         depth++;
       } else {
-        oldlen = src?src.length:0;
         if (rtl.isArray(defaultvalue)){
-          for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?src[i]:[]; // array of dyn array
+          // array of dyn array
+          for (var i=0; i<srclen; i++) a[i]=src[i];
+          for (var i=oldlen; i<lastlen; i++) a[i]=[];
         } else if (rtl.isObject(defaultvalue)) {
           if (rtl.isTRecord(defaultvalue)){
-            for (var i=0; i<lastlen; i++){
-              a[i]=(i<oldlen)?defaultvalue.$clone(src[i]):defaultvalue.$new(); // e.g. record
-            }
+            // array of record
+            for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
+            for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
           } else {
-            for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?rtl.refSet(src[i]):{}; // e.g. set
+            // array of set
+            for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
+            for (var i=oldlen; i<lastlen; i++) a[i]={};
           }
         } else {
-          for (var i=0; i<lastlen; i++)
-            a[i]=(i<oldlen)?src[i]:defaultvalue;
+          for (var i=0; i<srclen; i++) a[i]=src[i];
+          for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
         }
         while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
           depth--;
@@ -864,40 +932,6 @@ var rtl = {
     }while (true);
   },
 
-  /*arrayChgLength: function(arr,defaultvalue,newlength){
-    // multi dim: (arr,defaultvalue,dim1,dim2,...)
-    if (arr == null) arr = [];
-    var p = arguments;
-    function setLength(a,argNo){
-      var oldlen = a.length;
-      var newlen = p[argNo];
-      if (oldlen!==newlength){
-        a.length = newlength;
-        if (argNo === p.length-1){
-          if (rtl.isArray(defaultvalue)){
-            for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
-          } else if (rtl.isObject(defaultvalue)) {
-            if (rtl.isTRecord(defaultvalue)){
-              for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue.$new(); // e.g. record
-            } else {
-              for (var i=oldlen; i<newlen; i++) a[i]={}; // e.g. set
-            }
-          } else {
-            for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue;
-          }
-        } else {
-          for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
-        }
-      }
-      if (argNo < p.length-1){
-        // multi argNo
-        for (var i=0; i<newlen; i++) a[i]=setLength(a[i],argNo+1);
-      }
-      return a;
-    }
-    return setLength(arr,2);
-  },*/
-
   arrayEq: function(a,b){
     if (a===null) return b===null;
     if (b===null) return false;
@@ -1001,12 +1035,7 @@ var rtl = {
   },
 
   refSet: function(s){
-    Object.defineProperty(s, '$shared', {
-      enumerable: false,
-      configurable: true,
-      writable: true,
-      value: true
-    });
+    rtl.hideProp(s,'$shared',true);
     return s;
   },
 

utils/pas2js/docs/translation.html

@@ -77,6 +77,7 @@
     <a href="#externalclassancestor">External class as ancestor</a><br>
     <a href="#jsvalue">The JSValue type</a><br>
     <a href="#bracketaccessor">Accessing JS object properties with the bracket accessor</a><br>
+    <a href="#async">Async/AWait</a><br>
     <a href="#rtti">RTTI - Run Time Type Information</a><br>
     <a href="#compilerdirectives">Compiler directives</a><br>
     <a href="#othersupportedelements">Other supported Pascal elements</a><br>
@@ -2178,8 +2179,15 @@ function(){
 rtl = {
   ...
   createCallback: function(scope, fn){
-    var cb = function(){
-      return scope[fn].apply(scope,arguments);
+    var cb;
+    if (typeof(fn)==='string'){
+      cb = function(){
+        return scope[fn].apply(scope,arguments);
+      };
+    } else {
+      cb = function(){
+        return fn.apply(scope,arguments);
+      };
     };
     cb.scope = scope;
     cb.fn = fn;
@@ -2195,9 +2203,18 @@ rtl = {
     <ul>
     <li>You can assign a nested procedure to procedure variable.
     You don't need and you must not add the FPC "<i>is nested</i>" modifier.</li>
-    <li>A procedural typed declared as 'reference to' accepts in pas2js procedures,
+    <li>In pas2js a procedural typed declared as <i>'reference to'</i> accepts procedures,
     local procedures and methods. Delphi only supports capturing procedures and methods.
     FPC 3.0.4 does not support reference-to.</li>
+    <li>In pas2js the calling convention <i>safecall</i> has a special meaning:<br>
+    Assigning a procedure/method, uses <i>rtl.createSafeCallback</i> instead of
+    <i>createCallback</i>, enclosing a call in a <i>try..catch</i> block. When
+    an exception is thrown by JS, it is caught and delegated to
+    <i>rtl.handleUncaughtException(err)</i>.<br>
+    For example:<br>
+    <i>aButtonElement.OnClick:=@DoClick;</i> uses <i>rtl.createSafeCallback</i><br>
+    <i>aButtonElement.OnClick:=SomeElement.OnClick;</i> does not.<br>
+    </li>
     </ul>
     </div>
 
@@ -2705,7 +2722,7 @@ function(){
     <ul>
       <li><i>constructor New</i> is translated to <i>new ExtClass(params)</i>.</li>
       <li><i>constructor New; external name ''GlobalFunc''</i> is translated to <i>new GlobalFunc(params)</i>.</li>
-      <li><i>constructor SomeName; external name <i>'{}'</i> is translated to <i>{}</i>.</li>
+      <li><i>constructor SomeName; external name </i>'{}'</i> is translated to <i>{}</i>.</li>
       <li>Otherwise it is translated to <i>new ExtClass.FuncName(params)</i>.</li>
     </ul>
 
@@ -2972,7 +2989,92 @@ End.
     If <i>o</i> is <i>nil</i> it will give a JS error.<br>
     Local types (i.e. inside a procedure) do not have typeinfo.<br>
     Open array parameters are not yet supported.<br>
-    Note that FPC <i>typeinfo(aClassVar)<i> returns the compiletime type, so it works on <i>nil</i>.<br>
+    Note that FPC <i>typeinfo(aClassVar)</i> returns the compiletime type, so it works on <i>nil</i>.<br>
+    </div>
+
+    <div class="section">
+    <h2 id="async">Async/AWait</h2>
+    Pas2js supports the JS operators async and await to simplify the use of Promise.
+    The await operator corresponds to three intrinsic Pas2js functions:
+    <ul>
+    <li><i>function await(AsyncFunctionWithResultT): T;</i>  // implicit promise</li>
+    <li><i>function await(aType; p: TJSPromise): aType;</i>  // explicit promise requires the resolved type</li>
+    <li><i>function await(const Expr: T): T;</i>  // implicit promise</li>
+    </ul>
+    The await function can only be used inside a procedure with the async modifier.<br>
+    Example for the explicit promise:
+    <table class="sample">
+      <tbody>
+        <tr>
+          <th>Pascal</th>
+          <th>JavaScript</th>
+        </tr>
+        <tr>
+          <td>
+<pre>Program MyModule;
+
+uses JS, Web;
+
+function ResolveAfter2Seconds: TJSPromise;
+begin
+  Result:=TJSPromise.new(procedure(resolve, reject : TJSPromiseResolver)
+    begin
+    window.setTimeout(procedure
+      begin
+      resolve('resolved');
+      end,
+      2000); // wait 2 seconds
+    end);
+end;
+
+procedure AsyncCall; async;
+var s: string;
+begin
+  writeln('calling');
+  s := await(string,resolveAfter2Seconds()); // does not check if result is really a string
+  writeln(s); // expected output: 'resolved'
+end;
+
+begin
+  AsyncCall;
+end.
+</pre>
+          </td>
+          <td>
+<pre>rtl.module("program",["System","JS","Web"],function () {
+  "use strict";
+  var $mod = this;
+  this.ResolveAfter2Seconds = function () {
+    var Result = null;
+    Result = new Promise(function (resolve, reject) {
+      window.setTimeout(function () {
+        resolve("resolved");
+      },2000);
+    });
+    return Result;
+  };
+  this.AsyncCall = async function () {
+    var s = "";
+    pas.System.Writeln("calling");
+    s = await $mod.ResolveAfter2Seconds();
+    pas.System.Writeln(s);
+  };
+  $mod.$main = function () {
+    $mod.AsyncCall();
+  };
+});
+</pre>
+          </td>
+        </tr>
+      </tbody>
+    </table>
+    Notes:
+    <ul>
+      <li>The await function does only compile time checks, no runtime checks.</li>
+      <li>Inside an async function/procedure you can pass a <i>TJSPromise</i> to the <i>exit()</i> function. For example:<br>
+        <i>exit(aPromise);</i><br>
+        <i>exit(inherited);</i></li>
+    </ul>
     </div>