# revisions: 41903,42177,42217,42218,42227,42251,42252,42258,42287,42288,42289,42290,42291,42292,42293,42310,42347,42348,42355,42445,42450,42451,42453,42454,42462,42465,42466,42468,42472,42473,42474,42475

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

.gitattributes

@@ -2575,6 +2575,7 @@ packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcresolvegenerics.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcresolver.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
@@ -7003,6 +7004,7 @@ packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain

packages/fcl-passrc/src/pasresolveeval.pas

@@ -189,6 +189,10 @@ const
   nCreatingAnInstanceOfAbstractClassY = 3123;
   nIllegalExpressionAfterX = 3124;
   nMethodHidesNonVirtualMethodExactly = 3125;
+  nDuplicatePublishedMethodXAtY = 3126;
+  nConstraintXSpecifiedMoreThanOnce = 3127;
+  nConstraintXAndConstraintYCannotBeTogether = 3128;
+  nXIsNotAValidConstraint = 3129;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -325,6 +329,10 @@ resourcestring
   sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
   sIllegalExpressionAfterX = 'illegal expression after %s';
   sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
+  sDuplicatePublishedMethodXAtY = 'Duplicate published method "%s" at %s';
+  sConstraintXSpecifiedMoreThanOnce = 'Constraint ''%s'' specified more than once';
+  sConstraintXAndConstraintYCannotBeTogether = '''%s'' constraint and ''%s'' constraint cannot be specified together';
+  sXIsNotAValidConstraint = '''%s'' is not a valid constraint';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -1474,7 +1474,6 @@ type
     procedure ResolveImplElement(El: TPasImplElement); virtual;
     procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
     procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
-    procedure ResolveImplForLoop(Loop: TPasImplForLoop); virtual;
     procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
     procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
     procedure ResolveImplAssign(El: TPasImplAssign); virtual;
@@ -1526,6 +1525,7 @@ type
     procedure FinishClassOfType(El: TPasClassOfType); virtual;
     procedure FinishPointerType(El: TPasPointerType); virtual;
     procedure FinishArrayType(El: TPasArrayType); virtual;
+    procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
     procedure FinishResourcestring(El: TPasResString); virtual;
     procedure FinishProcedure(aProc: TPasProcedure); virtual;
     procedure FinishProcedureType(El: TPasProcedureType); virtual;
@@ -1534,6 +1534,7 @@ type
     procedure FinishExceptOnExpr; virtual;
     procedure FinishExceptOnStatement; virtual;
     procedure FinishWithDo(El: TPasImplWithDo); virtual;
+    procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual;
     procedure FinishDeclaration(El: TPasElement); virtual;
     procedure FinishVariable(El: TPasVariable); virtual;
     procedure FinishProperty(PropEl: TPasProperty); virtual;
@@ -3336,13 +3337,19 @@ end;
 function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
 var
   Proc: TPasProcedure;
+  El: TPasElement;
 begin
   Result:=Self;
   repeat
     if Result.ClassRecScope<>nil then exit;
     Proc:=TPasProcedure(Result.Element);
-    if not (Proc.Parent is TProcedureBody) then exit(nil);
-    Proc:=Proc.Parent.Parent as TPasProcedure;
+    El:=Proc.Parent;
+    repeat
+      if El=nil then exit(nil);
+      if El is TProcedureBody then break;
+      El:=El.Parent;
+    until false;
+    Proc:=El.Parent as TPasProcedure;
     Result:=TPasProcedureScope(Proc.CustomData);
   until false;
 end;
@@ -5004,7 +5011,13 @@ begin
           and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
         // this enum was propagated from a sub type -> remove enum
         Scope.RemoveLocalIdentifier(OlderIdentifier.Element);
-      RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
+      if (El.Visibility=visPublished) and (El is TPasProcedure)
+          and (OlderIdentifier.Element is TPasProcedure) then
+        RaiseMsg(20190626175432,nDuplicatePublishedMethodXAtY,
+                 sDuplicatePublishedMethodXAtY,
+                 [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El)
+      else
+        RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
                [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El);
       end;
 
@@ -5397,7 +5410,9 @@ begin
     EmitTypeHints(El,TPasAliasType(El).DestType);
     end
   else if (C=TPasPointerType) then
-    EmitTypeHints(El,TPasPointerType(El).DestType);
+    EmitTypeHints(El,TPasPointerType(El).DestType)
+  else if C=TPasGenericTemplateType then
+    FinishGenericTemplateType(TPasGenericTemplateType(El));
 end;
 
 procedure TPasResolver.FinishEnumType(El: TPasEnumType);
@@ -5801,6 +5816,130 @@ begin
     end;
 end;
 
+procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
+var
+  i: Integer;
+  Expr: TPasExpr;
+  Value: String;
+  IsClass, IsRecord, IsConstructor: Boolean;
+  LastType: TPasType;
+  ResolvedEl: TPasResolverResult;
+  MemberType: TPasMembersType;
+  aClass: TPasClassType;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
+  {$ENDIF}
+  IsClass:=false;
+  IsRecord:=false;
+  IsConstructor:=false;
+  LastType:=nil;
+  for i:=0 to length(El.Constraints)-1 do
+    begin
+    Expr:=El.Constraints[i];
+    if (Expr.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
+      begin
+      Value:=TPrimitiveExpr(Expr).Value;
+      if SameText(Value,'class') then
+        begin
+        if IsClass then
+          RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
+            sConstraintXSpecifiedMoreThanOnce,['class'],Expr);
+        if IsRecord then
+          RaiseMsg(20190720202516,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['record','class'],Expr);
+        if LastType<>nil then
+          RaiseMsg(20190720205708,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'class'],Expr);
+        IsClass:=true;
+        end
+      else if SameText(Value,'record') then
+        begin
+        if IsRecord then
+          RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
+            sConstraintXSpecifiedMoreThanOnce,['record'],Expr);
+        if IsClass then
+          RaiseMsg(20190720203039,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['class','record'],Expr);
+        if IsConstructor then
+          RaiseMsg(20190720203056,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['constructor','record'],Expr);
+        if LastType<>nil then
+          RaiseMsg(20190720205938,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'record'],Expr);
+        IsRecord:=true;
+        end
+      else if SameText(Value,'constructor') then
+        begin
+        if IsConstructor then
+          RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
+            sConstraintXSpecifiedMoreThanOnce,['constructor'],Expr);
+        if IsRecord then
+          RaiseMsg(20190720203148,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['record','constructor'],Expr);
+        if LastType<>nil then
+          RaiseMsg(20190720210005,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'constructor'],Expr);
+        IsConstructor:=true;
+        end
+      else
+        begin
+        // type identifier: class, record or interface
+        ResolveNameExpr(Expr,Value,rraNone);
+        ComputeElement(Expr,ResolvedEl,[rcType]);
+        if (ResolvedEl.BaseType<>btContext)
+            or not (ResolvedEl.IdentEl is TPasMembersType) then
+          begin
+          RaiseMsg(20190720204604,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
+            [Value],Expr);
+          end;
+        MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
+        if IsRecord then
+          RaiseMsg(20190720210130,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['record',MemberType.Name],Expr);
+        if IsClass then
+          RaiseMsg(20190720210202,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['class',MemberType.Name],Expr);
+        if IsConstructor then
+          RaiseMsg(20190720210244,nConstraintXAndConstraintYCannotBeTogether,
+            sConstraintXAndConstraintYCannotBeTogether,['constructor',MemberType.Name],Expr);
+        if MemberType is TPasClassType then
+          begin
+          aClass:=TPasClassType(MemberType);
+          case aClass.ObjKind of
+          okClass:
+            begin
+            // there can be at most one classtype constraint
+            if LastType<>nil then
+              RaiseMsg(20190720210351,nConstraintXAndConstraintYCannotBeTogether,
+                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
+            end;
+          okInterface:
+            begin
+            // there can be multiple interfacetype constraint
+            if not (LastType is TPasClassType) then
+              RaiseMsg(20190720211236,nConstraintXAndConstraintYCannotBeTogether,
+                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
+            if TPasClassType(LastType).ObjKind<>okInterface then
+              RaiseMsg(20190720211304,nConstraintXAndConstraintYCannotBeTogether,
+                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
+            end
+          else
+            RaiseMsg(20190720210919,nXIsNotAValidConstraint,
+              sXIsNotAValidConstraint,[MemberType.Name],Expr);
+          end;
+          end
+        else
+          RaiseMsg(20190720210809,nXIsNotAValidConstraint,
+            sXIsNotAValidConstraint,[MemberType.Name],Expr);
+        LastType:=MemberType;
+        end;
+      end
+    else
+      RaiseMsg(20190720203419,nParserSyntaxError,SParserSyntaxError,[],Expr);
+    end;
+end;
+
 procedure TPasResolver.FinishResourcestring(El: TPasResString);
 var
   ResolvedEl: TPasResolverResult;
@@ -6440,6 +6579,224 @@ begin
   PopWithScope(El);
 end;
 
+procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop);
+var
+  VarResolved, StartResolved, EndResolved,
+    OrigStartResolved: TPasResolverResult;
+  EnumeratorFound, HasInValues: Boolean;
+  InRange, VarRange: TResEvalValue;
+  InRangeInt, VarRangeInt: TResEvalRangeInt;
+  bt: TResolverBaseType;
+  TypeEl, ElType: TPasType;
+  C: TClass;
+begin
+  CreateScope(Loop,TPasForLoopScope);
+
+  // loop var
+  ResolveExpr(Loop.VariableName,rraReadAndAssign);
+  ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
+  if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
+    RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
+
+  // resolve start expression
+  ResolveExpr(Loop.StartExpr,rraRead);
+  ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
+
+  case Loop.LoopType of
+  ltNormal,ltDown:
+    begin
+    // start value
+    if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
+      RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
+        [],StartResolved,VarResolved,Loop.StartExpr);
+    CheckAssignExprRange(VarResolved,Loop.StartExpr);
+
+    // end value
+    ResolveExpr(Loop.EndExpr,rraRead);
+    ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
+    if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
+      RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
+        [],EndResolved,VarResolved,Loop.EndExpr);
+    CheckAssignExprRange(VarResolved,Loop.EndExpr);
+    end;
+  ltIn:
+    begin
+    // check range
+    EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
+    if (not EnumeratorFound)
+        and not (StartResolved.IdentEl is TPasType)
+        and (rrfReadable in StartResolved.Flags) then
+      begin
+      EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
+      end;
+
+    if not EnumeratorFound then
+      begin
+      VarRange:=nil;
+      InRange:=nil;
+      try
+        OrigStartResolved:=StartResolved;
+        if StartResolved.IdentEl is TPasType then
+          begin
+          // e.g. for e in TEnum do
+          TypeEl:=StartResolved.LoTypeEl;
+          if TypeEl is TPasArrayType then
+            begin
+            if length(TPasArrayType(TypeEl).Ranges)=1 then
+              InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
+            end;
+          if InRange=nil then
+            InRange:=EvalTypeRange(TypeEl,[]);
+          {$IFDEF VerbosePasResolver}
+          {AllowWriteln}
+          if InRange<>nil then
+            writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
+          else
+            writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
+          {AllowWriteln-}
+          {$ENDIF}
+          end
+        else if rrfReadable in StartResolved.Flags then
+          begin
+          // value  (variable or expression)
+          bt:=StartResolved.BaseType;
+          if bt in [btSet,btArrayOrSet] then
+            begin
+            if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
+              InRange:=Eval(StartResolved.ExprEl,[]);
+            if InRange=nil then
+              InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
+            end
+          else if bt=btContext then
+            begin
+            TypeEl:=StartResolved.LoTypeEl;
+            C:=TypeEl.ClassType;
+            if C=TPasArrayType then
+              begin
+              ElType:=GetArrayElType(TPasArrayType(TypeEl));
+              ComputeElement(ElType,StartResolved,[rcType]);
+              StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
+              if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
+                RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
+                  [],StartResolved,VarResolved,Loop.StartExpr);
+              EnumeratorFound:=true;
+              end;
+            end
+          else
+            begin
+            bt:=GetActualBaseType(bt);
+            case bt of
+            {$ifdef FPC_HAS_CPSTRING}
+            btAnsiString:
+              InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
+            {$endif}
+            btUnicodeString:
+              InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
+            end;
+            end;
+          end;
+        if (not EnumeratorFound) and (InRange<>nil) then
+          begin
+          // for v in <constant> do
+          // -> check if same type
+          VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
+          if VarRange=nil then
+            RaiseXExpectedButYFound(20171109191528,'range',
+                         GetResolverResultDescription(VarResolved),Loop.VariableName);
+          //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
+          //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
+          case InRange.Kind of
+          revkRangeInt,revkSetOfInt:
+            begin
+            InRangeInt:=TResEvalRangeInt(InRange);
+            case VarRange.Kind of
+            revkRangeInt:
+              begin
+              VarRangeInt:=TResEvalRangeInt(VarRange);
+              HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
+              case InRangeInt.ElKind of
+                revskEnum:
+                  if (VarRangeInt.ElKind<>revskEnum)
+                      or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
+                    RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
+                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
+                revskInt:
+                  if VarRangeInt.ElKind<>revskInt then
+                    RaiseXExpectedButYFound(20171109200752,'integer',
+                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
+                revskChar:
+                  if VarRangeInt.ElKind<>revskChar then
+                    RaiseXExpectedButYFound(20171109200753,'char',
+                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
+                revskBool:
+                  if VarRangeInt.ElKind<>revskBool then
+                    RaiseXExpectedButYFound(20171109200754,'boolean',
+                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
+              else
+                if HasInValues then
+                  RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
+              end;
+              if HasInValues then
+                begin
+                if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
+                  begin
+                  {$IFDEF VerbosePasResolver}
+                  writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
+                  {$ENDIF}
+                  fExprEvaluator.EmitRangeCheckConst(20171109201428,
+                    InRangeInt.ElementAsString(InRangeInt.RangeStart),
+                    VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
+                    VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
+                  end;
+                if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
+                  begin
+                  {$IFDEF VerbosePasResolver}
+                  writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
+                  {$ENDIF}
+                  fExprEvaluator.EmitRangeCheckConst(20171109201429,
+                    InRangeInt.ElementAsString(InRangeInt.RangeEnd),
+                    VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
+                    VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
+                  end;
+                end;
+              EnumeratorFound:=true;
+              end;
+            else
+              {$IFDEF VerbosePasResolver}
+              writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
+              {$ENDIF}
+            end;
+            end;
+          else
+            {$IFDEF VerbosePasResolver}
+            writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
+            {$ENDIF}
+          end;
+          end;
+        if not EnumeratorFound then
+          begin
+          {$IFDEF VerbosePasResolver}
+          {AllowWriteln}
+          writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
+          if VarRange<>nil then
+            writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
+          {AllowWriteln-}
+          {$ENDIF}
+          RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
+            [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
+          end;
+      finally
+        ReleaseEvalValue(VarRange);
+        ReleaseEvalValue(InRange);
+      end;
+      end;
+
+    end;
+  else
+    RaiseNotYetImplemented(20171108221334,Loop);
+  end;
+end;
+
 procedure TPasResolver.FinishDeclaration(El: TPasElement);
 var
   C: TClass;
@@ -8003,7 +8360,8 @@ begin
   else if C=TPasImplLabelMark then
     ResolveImplLabelMark(TPasImplLabelMark(El))
   else if C=TPasImplForLoop then
-    ResolveImplForLoop(TPasImplForLoop(El))
+    // the header was already resolved
+    ResolveImplElement(TPasImplForLoop(El).Body)
   else if C=TPasImplTry then
     begin
     ResolveImplBlock(TPasImplTry(El));
@@ -8346,225 +8704,6 @@ begin
   RaiseNotYetImplemented(20161014141636,Mark);
 end;
 
-procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
-var
-  VarResolved, StartResolved, EndResolved,
-    OrigStartResolved: TPasResolverResult;
-  EnumeratorFound, HasInValues: Boolean;
-  InRange, VarRange: TResEvalValue;
-  InRangeInt, VarRangeInt: TResEvalRangeInt;
-  bt: TResolverBaseType;
-  TypeEl, ElType: TPasType;
-  C: TClass;
-begin
-  CreateScope(Loop,TPasForLoopScope);
-
-  // loop var
-  ResolveExpr(Loop.VariableName,rraReadAndAssign);
-  ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
-  if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
-    RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
-
-  // resolve start expression
-  ResolveExpr(Loop.StartExpr,rraRead);
-  ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
-
-  case Loop.LoopType of
-  ltNormal,ltDown:
-    begin
-    // start value
-    if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
-      RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
-        [],StartResolved,VarResolved,Loop.StartExpr);
-    CheckAssignExprRange(VarResolved,Loop.StartExpr);
-
-    // end value
-    ResolveExpr(Loop.EndExpr,rraRead);
-    ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
-    if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
-      RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
-        [],EndResolved,VarResolved,Loop.EndExpr);
-    CheckAssignExprRange(VarResolved,Loop.EndExpr);
-    end;
-  ltIn:
-    begin
-    // check range
-    EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
-    if (not EnumeratorFound)
-        and not (StartResolved.IdentEl is TPasType)
-        and (rrfReadable in StartResolved.Flags) then
-      begin
-      EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
-      end;
-
-    if not EnumeratorFound then
-      begin
-      VarRange:=nil;
-      InRange:=nil;
-      try
-        OrigStartResolved:=StartResolved;
-        if StartResolved.IdentEl is TPasType then
-          begin
-          // e.g. for e in TEnum do
-          TypeEl:=StartResolved.LoTypeEl;
-          if TypeEl is TPasArrayType then
-            begin
-            if length(TPasArrayType(TypeEl).Ranges)=1 then
-              InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
-            end;
-          if InRange=nil then
-            InRange:=EvalTypeRange(TypeEl,[]);
-          {$IFDEF VerbosePasResolver}
-          {AllowWriteln}
-          if InRange<>nil then
-            writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
-          else
-            writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
-          {AllowWriteln-}
-          {$ENDIF}
-          end
-        else if rrfReadable in StartResolved.Flags then
-          begin
-          // value  (variable or expression)
-          bt:=StartResolved.BaseType;
-          if bt in [btSet,btArrayOrSet] then
-            begin
-            if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
-              InRange:=Eval(StartResolved.ExprEl,[]);
-            if InRange=nil then
-              InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
-            end
-          else if bt=btContext then
-            begin
-            TypeEl:=StartResolved.LoTypeEl;
-            C:=TypeEl.ClassType;
-            if C=TPasArrayType then
-              begin
-              ElType:=GetArrayElType(TPasArrayType(TypeEl));
-              ComputeElement(ElType,StartResolved,[rcType]);
-              StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
-              if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
-                RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
-                  [],StartResolved,VarResolved,Loop.StartExpr);
-              EnumeratorFound:=true;
-              end;
-            end
-          else
-            begin
-            bt:=GetActualBaseType(bt);
-            case bt of
-            {$ifdef FPC_HAS_CPSTRING}
-            btAnsiString:
-              InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
-            {$endif}
-            btUnicodeString:
-              InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
-            end;
-            end;
-          end;
-        if (not EnumeratorFound) and (InRange<>nil) then
-          begin
-          // for v in <constant> do
-          // -> check if same type
-          VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
-          if VarRange=nil then
-            RaiseXExpectedButYFound(20171109191528,'range',
-                         GetResolverResultDescription(VarResolved),Loop.VariableName);
-          //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
-          //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
-          case InRange.Kind of
-          revkRangeInt,revkSetOfInt:
-            begin
-            InRangeInt:=TResEvalRangeInt(InRange);
-            case VarRange.Kind of
-            revkRangeInt:
-              begin
-              VarRangeInt:=TResEvalRangeInt(VarRange);
-              HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
-              case InRangeInt.ElKind of
-                revskEnum:
-                  if (VarRangeInt.ElKind<>revskEnum)
-                      or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
-                    RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
-                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
-                revskInt:
-                  if VarRangeInt.ElKind<>revskInt then
-                    RaiseXExpectedButYFound(20171109200752,'integer',
-                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
-                revskChar:
-                  if VarRangeInt.ElKind<>revskChar then
-                    RaiseXExpectedButYFound(20171109200753,'char',
-                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
-                revskBool:
-                  if VarRangeInt.ElKind<>revskBool then
-                    RaiseXExpectedButYFound(20171109200754,'boolean',
-                      GetResolverResultDescription(VarResolved,true),loop.VariableName);
-              else
-                if HasInValues then
-                  RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
-              end;
-              if HasInValues then
-                begin
-                if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
-                  begin
-                  {$IFDEF VerbosePasResolver}
-                  writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
-                  {$ENDIF}
-                  fExprEvaluator.EmitRangeCheckConst(20171109201428,
-                    InRangeInt.ElementAsString(InRangeInt.RangeStart),
-                    VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
-                    VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
-                  end;
-                if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
-                  begin
-                  {$IFDEF VerbosePasResolver}
-                  writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
-                  {$ENDIF}
-                  fExprEvaluator.EmitRangeCheckConst(20171109201429,
-                    InRangeInt.ElementAsString(InRangeInt.RangeEnd),
-                    VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
-                    VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
-                  end;
-                end;
-              EnumeratorFound:=true;
-              end;
-            else
-              {$IFDEF VerbosePasResolver}
-              writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
-              {$ENDIF}
-            end;
-            end;
-          else
-            {$IFDEF VerbosePasResolver}
-            writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
-            {$ENDIF}
-          end;
-          end;
-        if not EnumeratorFound then
-          begin
-          {$IFDEF VerbosePasResolver}
-          {AllowWriteln}
-          writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
-          if VarRange<>nil then
-            writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
-          {AllowWriteln-}
-          {$ENDIF}
-          RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
-            [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
-          end;
-      finally
-        ReleaseEvalValue(VarRange);
-        ReleaseEvalValue(InRange);
-      end;
-      end;
-
-    end;
-  else
-    RaiseNotYetImplemented(20171108221334,Loop);
-  end;
-  ResolveImplElement(Loop.Body);
-end;
-
 procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
 // Note: the expressions were already resolved during parsing
 //  and the scopes were already stored in a TPasWithScope.
@@ -14342,6 +14481,19 @@ end;
 
 procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
   Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
+
+  function IsDynArrayConstExpr(IdentEl: TPasElement): boolean;
+  begin
+    Result:=false;
+    if not (IdentEl is TPasVariable) then exit;
+    if not (TPasVariable(IdentEl).Expr is TPasExpr) then exit;
+
+    if (IdentEl.ClassType=TPasConst) and TPasConst(IdentEl).IsConst then
+      exit(true);
+    if fExprEvaluator.IsConst(Params) then
+      exit(true); // a const refers an initial value
+  end;
+
 var
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
@@ -14371,8 +14523,7 @@ begin
         // dyn or open array
         if Proc.BuiltIn=bfLow then
           Evaluated:=TResEvalInt.CreateValue(0)
-        else if (ParamResolved.IdentEl is TPasVariable)
-            and (TPasVariable(ParamResolved.IdentEl).Expr is TPasExpr) then
+        else if IsDynArrayConstExpr(ParamResolved.IdentEl) then
           begin
           Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
           if Expr is TArrayValues then
@@ -15852,6 +16003,8 @@ begin
       // resolved when finished
     else if AClass=TPasImplCommand then
     else if AClass=TPasAttributes then
+    else if AClass=TPasGenericTemplateType then
+      AddType(TPasType(El))
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
@@ -16539,6 +16692,7 @@ begin
   stExceptOnExpr: FinishExceptOnExpr;
   stExceptOnStatement: FinishExceptOnStatement;
   stWithExpr: FinishWithDo(El as TPasImplWithDo);
+  stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop);
   stDeclaration: FinishDeclaration(El);
   stAncestors: FinishAncestors(El as TPasClassType);
   stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
@@ -17170,7 +17324,7 @@ begin
         begin
         Entry:=FActiveHelpers[i];
         HelperForType:=Entry.HelperForType;
-        if HelperForType=TypeEl then
+        if IsSameType(HelperForType,TypeEl,prraNone) then
           begin
           // add Helper and its ancestors
           HelperScope:=TPasClassScope(Entry.Helper.CustomData);
@@ -22106,6 +22260,9 @@ begin
   else if ElClass=TPasResString then
     SetResolverIdentifier(ResolvedEl,btString,El,
                         FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
+  else if ElClass=TPasGenericTemplateType then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasGenericTemplateType(El),
+      TPasGenericTemplateType(El),[])
   else
     RaiseNotYetImplemented(20160922163705,El);
   {$IF defined(nodejs) and defined(VerbosePasResolver)}

packages/fcl-passrc/src/pastree.pp

@@ -58,6 +58,7 @@ resourcestring
   SPasTreeClassType = 'class';
   SPasTreeInterfaceType = 'interface';
   SPasTreeSpecializedType = 'specialized class type';
+  SPasTreeSpecializedExpr = 'specialize expr';
   SPasClassHelperType = 'class helper type';
   SPasRecordHelperType = 'record helper type';
   SPasTypeHelperType = 'type helper type';
@@ -564,28 +565,27 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full: boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
     procedure AddParam(El: TPasElement);
   public
     Params: TFPList; // list of TPasType or TPasExpr
   end;
 
-  { TInlineTypeExpr - base class TInlineSpecializeExpr }
+  { TInlineSpecializeExpr - A<B,C> }
 
-  TInlineTypeExpr = class(TPasExpr)
+  TInlineSpecializeExpr = class(TPasExpr)
   public
+    constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure ClearTypeReferences(aType: TPasElement); override;
+    procedure AddParam(El: TPasElement);
   public
-    DestType: TPasType; // TPasSpecializeType
-  end;
-
-  { TInlineSpecializeExpr - A<B,C> }
-
-  TInlineSpecializeExpr = class(TInlineTypeExpr)
+    NameExpr: TPasExpr; // TPrimitiveExpr
+    Params: TFPList; // list of TPasType or TPasExpr
   end;
 
   { TPasRangeType }
@@ -606,6 +606,10 @@ type
   { TPasArrayType }
 
   TPasArrayType = class(TPasType)
+  private
+    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
@@ -617,9 +621,11 @@ type
     Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
     ElType: TPasType;
-    Function IsGenericArray : Boolean;
-    Function IsPacked : Boolean;
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType, can be nil
+    function IsGenericArray : Boolean;
+    function IsPacked : Boolean;
     procedure AddRange(Range: TPasExpr);
+    procedure SetGenericTemplates(AList: TFPList); virtual;
   end;
 
   { TPasFileType }
@@ -731,9 +737,18 @@ type
     Function IsAdvancedRecord : Boolean;
   end;
 
+  { TPasGenericTemplateType }
+
   TPasGenericTemplateType = Class(TPasType)
+  public
+    destructor Destroy; override;
+    function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure AddConstraint(Expr: TPasExpr);
   Public
-    TypeConstraint : String;
+    TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
+    Constraints: TPasExprArray;
   end;
 
   TPasObjKind = (
@@ -1029,6 +1044,14 @@ type
                         pmNoReturn, pmFar, pmFinal);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
+
+  { TProcedureNamePart }
+
+  TProcedureNamePart = record
+    Name: string;
+    Templates: TFPList; // optional list of TPasGenericTemplateType, can nil!
+  end;
+  TProcedureNameParts = array of TProcedureNamePart;
                         
   TProcedureBody = class;
 
@@ -1058,6 +1081,7 @@ type
     AliasName : String;
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
+    NameParts: TProcedureNameParts; // only used for generic functions
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1071,6 +1095,7 @@ type
     Function IsStatic : Boolean;
     Function IsForward: Boolean;
     Function GetProcTypeEnum: TProcType; virtual;
+    procedure SetNameParts(var Parts: TProcedureNameParts);
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property MessageName : String Read FMessageName Write FMessageName;
@@ -1715,12 +1740,16 @@ const
      = ('cvar', 'external', 'public', 'export', 'class', 'static');
 
 procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
+procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
+function GenericTemplateTypesAsString(List: TFPList): string;
 
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 function GetPTDumpStack: string;
 {$ENDIF}
 
+procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
+
 implementation
 
 uses SysUtils;
@@ -1733,6 +1762,69 @@ begin
   El:=nil;
 end;
 
+procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  if GenericTemplateTypes=nil then exit;
+  for i := 0 to GenericTemplateTypes.Count - 1 do
+    begin
+    El:=TPasElement(GenericTemplateTypes[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}(Id){$ENDIF};
+    end;
+  FreeAndNil(GenericTemplateTypes);
+end;
+
+function GenericTemplateTypesAsString(List: TFPList): string;
+var
+  i, j: Integer;
+  T: TPasGenericTemplateType;
+begin
+  Result:='';
+  for i:=0 to List.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    T:=TPasGenericTemplateType(List[i]);
+    Result:=Result+T.Name;
+    if length(T.Constraints)>0 then
+      begin
+      Result:=Result+':';
+      for j:=0 to length(T.Constraints)-1 do
+        begin
+        if j>0 then
+          Result:=Result+',';
+        Result:=Result+T.GetDeclaration(false);
+        end;
+      end;
+    end;
+  Result:='<'+Result+'>';
+end;
+
+procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
+var
+  El: TPasElement;
+  i, j: Integer;
+begin
+  for i := 0 to length(NameParts)-1 do
+    begin
+    with NameParts[i] do
+      if Templates<>nil then
+        begin
+        for j:=0 to Templates.Count-1 do
+          begin
+          El:=TPasGenericTemplateType(Templates[j]);
+          El.Parent:=nil;
+          El.Release{$IFDEF CheckPasTreeRefCount}('TPasProcedure.NameParts'){$ENDIF};
+          end;
+        Templates.Free;
+        end;
+    end;
+  NameParts:=nil;
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 Var
   I,CurrLen,CurrPos : Integer;
@@ -1753,6 +1845,54 @@ begin
     end;
 end;
 
+{ TPasGenericTemplateType }
+
+destructor TPasGenericTemplateType.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to length(Constraints)-1 do
+    Constraints[i].Release;
+  Constraints:=nil;
+  inherited Destroy;
+end;
+
+function TPasGenericTemplateType.GetDeclaration(full: boolean): string;
+var
+  i: Integer;
+begin
+  Result:=inherited GetDeclaration(full);
+  if length(Constraints)>0 then
+    begin
+    Result:=Result+': ';
+    for i:=0 to length(Constraints)-1 do
+      begin
+      if i>0 then
+        Result:=Result+',';
+      Result:=Result+Constraints[i].GetDeclaration(false);
+      end;
+    end;
+end;
+
+procedure TPasGenericTemplateType.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Constraints)-1 do
+    ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
+end;
+
+procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
+var
+  l: Integer;
+begin
+  l:=Length(Constraints);
+  SetLength(Constraints,l+1);
+  Constraints[l]:=Expr;
+end;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 begin
@@ -1831,34 +1971,61 @@ begin
   SemicolonAtEOL := true;
 end;
 
-{ TInlineTypeExpr }
+{ TInlineSpecializeExpr }
 
-destructor TInlineTypeExpr.Destroy;
+constructor TInlineSpecializeExpr.Create(const AName: string;
+  AParent: TPasElement);
 begin
-  ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
+  if AName='' then ;
+  inherited Create(AParent, pekSpecialize, eopNone);
+  Params:=TFPList.Create;
+end;
+
+destructor TInlineSpecializeExpr.Destroy;
+var
+  i: Integer;
+begin
+  ReleaseAndNil(TPasElement(NameExpr));
+  for i:=0 to Params.Count-1 do
+    TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
+  FreeAndNil(Params);
   inherited Destroy;
 end;
 
-function TInlineTypeExpr.ElementTypeName: string;
+function TInlineSpecializeExpr.ElementTypeName: string;
 begin
-  Result := DestType.ElementTypeName;
+  Result:=SPasTreeSpecializedExpr;
 end;
 
-function TInlineTypeExpr.GetDeclaration(full: Boolean): string;
+function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
+var
+  i: Integer;
 begin
-  Result:=DestType.GetDeclaration(full);
+  Result:='specialize ';
+  Result:=Result+NameExpr.GetDeclaration(full);
+  Result:=Result+'<';
+  for i:=0 to Params.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
+    end;
 end;
 
-procedure TInlineTypeExpr.ForEachCall(
+procedure TInlineSpecializeExpr.ForEachCall(
   const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
 begin
-  DestType.ForEachChildCall(aMethodCall,Arg,DestType,true);
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
-procedure TInlineTypeExpr.ClearTypeReferences(aType: TPasElement);
+procedure TInlineSpecializeExpr.AddParam(El: TPasElement);
 begin
-  if DestType=aType then
-    ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
+  Params.Add(El);
 end;
 
 { TPasSpecializeType }
@@ -1903,6 +2070,16 @@ begin
     end;
 end;
 
+procedure TPasSpecializeType.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
+end;
+
 procedure TPasSpecializeType.AddParam(El: TPasElement);
 begin
   Params.Add(El);
@@ -2901,11 +3078,28 @@ begin
   inherited Destroy;
 end;
 
+procedure TPasArrayType.ClearChildReferences(El: TPasElement; arg: pointer);
+begin
+  El.ClearTypeReferences(Self);
+  if arg=nil then ;
+end;
+
+procedure TPasArrayType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this array (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
 
 destructor TPasArrayType.Destroy;
 var
   i: Integer;
 begin
+  ReleaseGenericTemplateTypes(GenericTemplateTypes{$IFDEF CheckPasTreeRefCount},'TPasArrayType'{$ENDIF});
   for i:=0 to length(Ranges)-1 do
     Ranges[i].Release{$IFDEF CheckPasTreeRefCount}('TPasArrayType.Ranges'){$ENDIF};
   ReleaseAndNil(TPasElement(ElType){$IFDEF CheckPasTreeRefCount},'TPasArrayType.ElType'{$ENDIF});
@@ -2918,7 +3112,6 @@ begin
   inherited Destroy;
 end;
 
-
 constructor TPasEnumType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -3402,6 +3595,7 @@ begin
   ReleaseAndNil(TPasElement(MessageExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.MessageExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
   ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
+  ReleaseProcNameParts(NameParts);
   inherited Destroy;
 end;
 
@@ -3876,29 +4070,39 @@ end;
 function TPasArrayType.GetDeclaration (full : boolean) : string;
 begin
   Result:='Array';
+  if Full then
+    begin
+    if GenericTemplateTypes<>nil then
+      Result:=Result+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Result
+    else
+      Result:=Result+' = '+Result;
+    end;
   If (IndexRange<>'') then
     Result:=Result+'['+IndexRange+']';
   Result:=Result+' of ';
   If IsPacked then
-     Result := 'packed '+Result;      // 12/04/04 Dave - Added
+    Result := 'packed '+Result;      // 12/04/04 Dave - Added
   If Assigned(Eltype) then
     Result:=Result+ElType.Name
   else
     Result:=Result+'const';
-  If Full Then
-    Result:=FixTypeDecl(Result);
 end;
 
 procedure TPasArrayType.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
+var
+  i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
+  if GenericTemplateTypes<>nil then
+    for i:=0 to GenericTemplateTypes.Count-1 do
+      ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
   ForEachChildCall(aMethodCall,Arg,ElType,true);
 end;
 
 function TPasArrayType.IsGenericArray: Boolean;
 begin
-  Result:=ElType is TPasGenericTemplateType;
+  Result:=GenericTemplateTypes<>nil;
 end;
 
 function TPasArrayType.IsPacked: Boolean;
@@ -3915,6 +4119,22 @@ begin
   Ranges[i]:=Range;
 end;
 
+procedure TPasArrayType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+  El: TPasElement;
+begin
+  if GenericTemplateTypes=nil then
+    GenericTemplateTypes:=TFPList.Create;
+  For I:=0 to AList.Count-1 do
+    begin
+    El:=TPasElement(AList[i]);
+    El.Parent:=Self;
+    GenericTemplateTypes.Add(El);
+    end;
+  AList.Clear;
+end;
+
 function TPasFileType.GetDeclaration (full : boolean) : string;
 begin
   Result:='File';
@@ -4042,13 +4262,8 @@ begin
     end;
   FreeAndNil(Members);
 
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    begin
-    El:=TPasElement(GenericTemplateTypes[i]);
-    El.Parent:=nil;
-    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.GenericTemplateTypes'){$ENDIF};
-    end;
-  FreeAndNil(GenericTemplateTypes);
+  ReleaseGenericTemplateTypes(GenericTemplateTypes
+    {$IFDEF CheckPasTreeRefCount},'TPasMembersType.GenericTemplateTypes'{$ENDIF});
 
   inherited Destroy;
 end;
@@ -4070,7 +4285,7 @@ var
 begin
   inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
   for i:=0 to Members.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
 end;
@@ -4162,7 +4377,12 @@ begin
       else
         Temp:='packed '+Temp;
     If Full and (Name<>'') then
-      Temp:=Name+' = '+Temp;
+      begin
+      if GenericTemplateTypes.Count>0 then
+        Temp:=Name+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Temp
+      else
+        Temp:=Name+' = '+Temp;
+      end;
     S.Add(Temp);
     GetMembers(S);
     S.Add('end');
@@ -4468,8 +4688,15 @@ end;
 
 procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
+var
+  i, j: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(NameParts)-1 do
+    with NameParts[i] do
+      if Templates<>nil then
+        for j:=0 to Templates.Count-1 do
+          ForEachChildCall(aMethodCall,Arg,TPasElement(Templates[i]),false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
   ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
@@ -4479,7 +4706,6 @@ begin
 end;
 
 procedure TPasProcedure.AddModifier(AModifier: TProcedureModifier);
-
 begin
   Include(FModifiers,AModifier);
 end;
@@ -4545,17 +4771,52 @@ begin
   Result:=ptProcedure;
 end;
 
+procedure TPasProcedure.SetNameParts(var Parts: TProcedureNameParts);
+var
+  i, j: Integer;
+  El: TPasElement;
+begin
+  if length(NameParts)>0 then
+    ReleaseProcNameParts(NameParts);
+  NameParts:=Parts;
+  Parts:=nil;
+  for i:=0 to length(NameParts)-1 do
+    with NameParts[i] do
+      if Templates<>nil then
+        for j:=0 to Templates.Count-1 do
+          begin
+          El:=TPasElement(Templates[j]);
+          El.Parent:=Self;
+          end;
+end;
+
 function TPasProcedure.GetDeclaration(full: Boolean): string;
 Var
   S : TStringList;
   T: String;
+  i: Integer;
 begin
   S:=TStringList.Create;
   try
     If Full then
       begin
       T:=TypeName;
-      if Name<>'' then
+      if length(NameParts)>0 then
+        begin
+        T:=T+' ';
+        for i:=0 to length(NameParts)-1 do
+          begin
+          if i>0 then
+            T:=T+'.';
+          with NameParts[i] do
+            begin
+            T:=T+Name;
+            if Templates<>nil then
+              T:=T+GenericTemplateTypesAsString(Templates);
+            end;
+          end;
+        end
+      else if Name<>'' then
         T:=T+' '+Name;
       S.Add(T);
       end;

packages/fcl-passrc/src/pparser.pp

@@ -40,7 +40,7 @@ uses
   {$ifdef NODEJS}
   NodeJSFS,
   {$endif}
-  SysUtils, Classes, PasTree, PScanner;
+  SysUtils, Classes, Types, PasTree, PScanner;
 
 // message numbers
 const
@@ -72,7 +72,7 @@ const
   nParserNotAProcToken = 2026;
   nRangeExpressionExpected = 2027;
   nParserExpectCase = 2028;
-  // free 2029;
+  nParserGenericFunctionNeedsGenericKeyword = 2029;
   nLogStartImplementation = 2030;
   nLogStartInterface = 2031;
   nParserNoConstructorAllowed = 2032;
@@ -132,7 +132,7 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
-  // free for 2029
+  SParserGenericFunctionNeedsGenericKeyword = 'Generic function needs keyword generic';
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records';
@@ -174,6 +174,7 @@ type
     stWithExpr, // calls BeginScope after parsing every WITH-expression
     stExceptOnExpr,
     stExceptOnStatement,
+    stForLoopHeader,
     stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument, ...
     stAncestors, // the list of ancestors and interfaces of a class
     stInitialFinalization
@@ -311,14 +312,14 @@ type
     Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
     procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement); virtual;
-    procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
+    procedure ParseRecordMembers(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
     procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
-    procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
+    procedure ReadSpecializeArguments(Spec: TPasElement);
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
@@ -365,6 +366,7 @@ 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 DoParseArrayType(ArrType: TPasArrayType);
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
     function CheckPackMode: TPackMode;
@@ -510,7 +512,9 @@ Function TokenToAssignKind( tk : TToken) : TAssignKind;
 
 implementation
 
+{$IF FPC_FULLVERSION>=30301}
 uses strutils;
+{$ENDIF}
 
 const
   WhitespaceTokensToIgnore = [tkWhitespace, tkComment, tkLineEnding, tkTab];
@@ -616,6 +620,79 @@ begin
 end;
 {$endif}
 
+{$IF FPC_FULLVERSION<30301}
+Function SplitCommandLine(S: String) : TStringDynArray;
+
+  Function GetNextWord : String;
+
+  Const
+    WhiteSpace = [' ',#9,#10,#13];
+    Literals = ['"',''''];
+
+  Var
+    Wstart,wend : Integer;
+    InLiteral : Boolean;
+    LastLiteral : Char;
+
+    Procedure AppendToResult;
+
+    begin
+      Result:=Result+Copy(S,WStart,WEnd-WStart);
+      WStart:=Wend+1;
+    end;
+
+  begin
+    Result:='';
+    WStart:=1;
+    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
+      Inc(WStart);
+    WEnd:=WStart;
+    InLiteral:=False;
+    LastLiteral:=#0;
+    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
+      begin
+      if charinset(S[Wend],Literals) then
+        If InLiteral then
+          begin
+          InLiteral:=Not (S[Wend]=LastLiteral);
+          if not InLiteral then
+            AppendToResult;
+          end
+        else
+          begin
+          InLiteral:=True;
+          LastLiteral:=S[Wend];
+          AppendToResult;
+          end;
+       inc(wend);
+       end;
+     AppendToResult;
+     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
+       inc(Wend);
+     Delete(S,1,WEnd-1);
+  end;
+
+Var
+  W : String;
+  len : Integer;
+
+begin
+  Len:=0;
+  Result:=Default(TStringDynArray);
+  SetLength(Result,(Length(S) div 2)+1);
+  While Length(S)>0 do
+    begin
+    W:=GetNextWord;
+    If (W<>'') then
+      begin
+      Result[Len]:=W;
+      Inc(Len);
+      end;
+    end;
+  SetLength(Result,Len);
+end;
+{$ENDIF}
+
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
   Options : TParseSourceOptions): TPasModule;
@@ -637,7 +714,6 @@ function ParseSource(AEngine: TPasTreeContainer;
 var
   FileResolver: TBaseFileResolver;
   Parser: TPasParser;
-  Start, CurPos: integer; // in FPCCommandLine
   Filename: String;
   Scanner: TPascalScanner;
 
@@ -1588,7 +1664,7 @@ begin
   Expr:=nil;
   ST:=nil;
   try
-    if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+    if CurToken=tkspecialize then
       begin
       IsSpecialize:=true;
       NextToken;
@@ -1740,7 +1816,8 @@ begin
         Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface);
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
-      tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
+      tkSpecialize:
+        Result:=ParseSpecializeType(Parent,TypeName);
       tkClass:
         begin
         isHelper:=false;
@@ -1881,67 +1958,13 @@ function TPasParser.ParseArrayType(Parent: TPasElement;
   ): TPasArrayType;
 
 Var
-  S : String;
   ok: Boolean;
-  RangeExpr: TPasExpr;
-
 begin
   Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent, NamePos));
   ok:=false;
   try
     Result.PackMode:=PackMode;
-    NextToken;
-    S:='';
-    case CurToken of
-      tkSquaredBraceOpen:
-        begin
-        // static array
-        if Parent is TPasArgument then
-          ParseExcTokenError('of');
-        repeat
-          NextToken;
-          if po_arrayrangeexpr in Options then
-            begin
-            RangeExpr:=DoParseExpression(Result);
-            Result.AddRange(RangeExpr);
-            end
-          else if CurToken<>tkSquaredBraceClose then
-             S:=S+CurTokenText;
-          if CurToken=tkSquaredBraceClose then
-            break
-          else if CurToken=tkComma then
-            continue
-          else if po_arrayrangeexpr in Options then
-            ParseExcTokenError(']');
-        until false;
-        Result.IndexRange:=S;
-        ExpectToken(tkOf);
-        Result.ElType := ParseType(Result,CurSourcePos);
-        end;
-      tkOf:
-        begin
-        NextToken;
-        if CurToken = tkConst then
-          // array of const
-          begin
-          if not (Parent is TPasArgument) then
-            ParseExcExpectedIdentifier;
-          end
-        else
-          begin
-          if (CurToken=tkarray) and (Parent is TPasArgument) then
-            ParseExcExpectedIdentifier;
-          UngetToken;
-          Result.ElType := ParseType(Result,CurSourcePos);
-          end;
-        end
-      else
-        ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
-    end;
-    // TPasProcedureType parsing has eaten the semicolon;
-    // We know it was a local definition if the array def (result) is the parent
-    if (Result.ElType is TPasProcedureType) and (Result.ElType.Parent=Result) then
-      UnGetToken;
+    DoParseArrayType(Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
@@ -2166,6 +2189,8 @@ begin
 end;
 
 function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
+type
+  TAllow = (aCannot, aCan, aMust);
 
   Function IsWriteOrStr(P : TPasExpr) : boolean;
 
@@ -2236,17 +2261,17 @@ var
   Last, Func, Expr: TPasExpr;
   Params: TParamsExpr;
   Bin: TBinaryExpr;
-  ok, CanSpecialize: Boolean;
+  ok: Boolean;
+  CanSpecialize: TAllow;
   aName: String;
   ISE: TInlineSpecializeExpr;
-  ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
   ProcExpr: TProcedureExpr;
 
 begin
   Result:=nil;
-  CanSpecialize:=false;
+  CanSpecialize:=aCannot;
   aName:='';
   case CurToken of
     tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
@@ -2254,13 +2279,20 @@ begin
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
-      CanSpecialize:=true;
+      CanSpecialize:=aCan;
       aName:=CurTokenText;
       if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then
         Last:=CreateSelfExpr(AParent)
       else
         Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
       end;
+    tkspecialize:
+      begin
+      CanSpecialize:=aMust;
+      ExpectToken(tkIdentifier);
+      aName:=CurTokenText;
+      Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
+      end;
     tkfalse, tktrue:    Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
     tknil:              Last:=CreateNilExpr(AParent);
     tkSquaredBraceOpen:
@@ -2289,7 +2321,7 @@ begin
       end;
     tkself:
       begin
-      CanSpecialize:=true;
+      CanSpecialize:=aCan;
       aName:=CurTokenText;
       Last:=CreateSelfExpr(AParent);
       end;
@@ -2351,6 +2383,13 @@ begin
         begin
         ScrPos:=CurTokenPos;
         NextToken;
+        if CurToken=tkspecialize then
+          begin
+          if CanSpecialize=aMust then
+            CheckToken(tkLessThan);
+          CanSpecialize:=aMust;
+          NextToken;
+          end;
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
           aName:=aName+'.'+CurTokenString;
@@ -2375,34 +2414,32 @@ begin
         Params.Value:=Result;
         Result.Parent:=Params;
         Result:=Params;
-        CanSpecialize:=false;
+        CanSpecialize:=aCannot;
         Func:=nil;
         end;
       tkCaret:
         begin
         Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         NextToken;
-        CanSpecialize:=false;
+        CanSpecialize:=aCannot;
         Func:=nil;
         end;
       tkLessThan:
         begin
         SrcPos:=CurTokenPos;
-        if (not CanSpecialize) or not IsSpecialize then
+        if CanSpecialize=aCannot then
+          break
+        else if (CanSpecialize=aCan) and not IsSpecialize then
           break
         else
           begin
           // an inline specialization (e.g. A<B,C>)
           ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
-          ISE.Kind:=pekSpecialize;
-          ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
-          ISE.DestType:=ST;
-          ReadSpecializeArguments(ST);
-          ST.DestType:=ResolveTypeReference(aName,ST);
-          ST.Expr:=Result;
+          ReadSpecializeArguments(ISE);
+          ISE.NameExpr:=Result;
           Result:=ISE;
           ISE:=nil;
-          CanSpecialize:=false;
+          CanSpecialize:=aCannot;
           NextToken;
           end;
         Func:=nil;
@@ -3540,9 +3577,17 @@ begin
         end;
       end;
     tkGeneric:
+      begin
+      NextToken;
+      if (CurToken in [tkprocedure,tkfunction]) then
+        begin
+        SetBlock(declNone);
+        UngetToken;
+        end;
       if CurBlock = declType then
         begin
-        TypeName := ExpectIdentifier;
+        CheckToken(tkIdentifier);
+        TypeName := CurTokenString;
         NamePos:=CurSourcePos;
         List:=TFPList.Create;
         try
@@ -3571,7 +3616,7 @@ begin
              Declarations.Classes.Add(RecordEl);
              RecordEl.SetGenericTemplates(List);
              NextToken;
-             ParseRecordFieldList(RecordEl,tkend,
+             ParseRecordMembers(RecordEl,tkend,
                               (msAdvancedRecords in Scanner.CurrentModeSwitches)
                               and not (Declarations is TProcedureBody)
                               and (RecordEl.Name<>''));
@@ -3580,15 +3625,12 @@ begin
              end;
            tkArray:
              begin
-             if List.Count<>1 then
-               ParseExc(nParserGenericArray1Element,sParserGenericArray1Element);
-             ArrEl:=TPasArrayType(ParseArrayType(Declarations,NamePos,TypeName,pmNone));
+             ArrEl := TPasArrayType(CreateElement(TPasArrayType, TypeName, Declarations, NamePos));
              Declarations.Declarations.Add(ArrEl);
              Declarations.Types.Add(ArrEl);
+             ArrEl.SetGenericTemplates(List);
+             DoParseArrayType(ArrEl);
              CheckHint(ArrEl,True);
-             ArrEl.ElType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-             ArrEl.ElType:=TPasGenericTemplateType(List[0]);
-             List.Clear;
              Engine.FinishScope(stTypeDef,ArrEl);
              end;
           else
@@ -3634,6 +3676,7 @@ begin
         begin
         ParseExcSyntaxError;
         end;
+      end;
     tkbegin:
       begin
       if Declarations is TProcedureBody then
@@ -4009,12 +4052,12 @@ begin
   end;
 end;
 
+{$warn 5043 off}
 procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
-
 Var
   N : String;
   T : TPasGenericTemplateType;
-
+  Expr: TPasExpr;
 begin
   ExpectToken(tkLessThan);
   repeat
@@ -4023,17 +4066,46 @@ begin
     List.Add(T);
     NextToken;
     if Curtoken = tkColon then
-      begin
-      T.TypeConstraint:=ExpectIdentifier;
-      NextToken;
-      end;
-    if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
-      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
-  until CurToken = tkGreaterThan;
+      repeat
+        NextToken;
+        // comma separated list: identifier, class, record, constructor
+        if CurToken in [tkclass,tkrecord,tkconstructor] then
+          begin
+          if T.TypeConstraint='' then
+            T.TypeConstraint:=CurTokenString;
+          Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
+          NextToken;
+          end
+        else if CurToken=tkIdentifier then
+          begin
+          if T.TypeConstraint='' then
+            T.TypeConstraint:=ReadDottedIdentifier(T,Expr,true)
+          else
+            ReadDottedIdentifier(T,Expr,false);
+          end
+        else
+          CheckToken(tkIdentifier);
+        T.AddConstraint(Expr);
+      until CurToken<>tkComma;
+    Engine.FinishScope(stTypeDef,T);
+  until not (CurToken in [tkSemicolon,tkComma]);
+  if CurToken<>tkGreaterThan then
+    ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+      [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
 end;
+{$warn 5043 on}
 
-procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+procedure TPasParser.ReadSpecializeArguments(Spec: TPasElement);
+
+  procedure AddParam(El: TPasElement);
+  begin
+    if Spec is TPasSpecializeType then
+      TPasSpecializeType(Spec).AddParam(El)
+    else if Spec is TInlineSpecializeExpr then
+      TInlineSpecializeExpr(Spec).AddParam(El)
+    else
+      ParseExcTokenError('[20190619112611] '+Spec.ClassName);
+  end;
 
 Var
   Name : String;
@@ -4043,6 +4115,7 @@ Var
   Expr: TPasExpr;
 
 begin
+  //writeln('START TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
   CheckToken(tkLessThan);
   NextToken;
   Expr:=nil;
@@ -4050,7 +4123,8 @@ begin
   NestedSpec:=nil;
   try
     repeat
-      if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+      //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
+      if CurToken=tkspecialize then
         begin
         IsNested:=true;
         NextToken;
@@ -4061,6 +4135,7 @@ begin
       CheckToken(tkIdentifier);
       Expr:=nil;
       Name:=ReadDottedIdentifier(Spec,Expr,true);
+      //writeln('AFTER NAME TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
 
       if CurToken=tkLessThan then
         begin
@@ -4076,18 +4151,19 @@ begin
         // read nested specialize arguments
         ReadSpecializeArguments(NestedSpec);
         // add nested specialize
-        Spec.AddParam(NestedSpec);
+        AddParam(NestedSpec);
         NestedSpec:=nil;
         NextToken;
         end
       else if IsNested then
-        CheckToken(tkLessThan)
+        CheckToken(tkLessThan)   // specialize keyword without <
       else
         begin
         // simple type reference
-        Spec.AddParam(Expr);
+        AddParam(Expr);
         Expr:=nil;
         end;
+      //writeln('AFTER PARAMS TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
 
       if CurToken=tkComma then
         begin
@@ -5811,6 +5887,7 @@ begin
           TPasImplForLoop(El).LoopType:=lt;
           if (CurToken<>tkDo) then
             ParseExcTokenError(TokenInfos[tkDo]);
+          Engine.FinishScope(stForLoopHeader,El);
           CreateBlock(TPasImplForLoop(El));
           El:=nil;
           //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
@@ -6043,7 +6120,8 @@ begin
       tkEOF:
         CheckToken(tkend);
       tkAt,tkAtAt,
-      tkIdentifier,tkNumber,tkString,tkfalse,tktrue,tkChar,
+      tkIdentifier,tkspecialize,
+      tkNumber,tkString,tkfalse,tktrue,tkChar,
       tkBraceOpen,tkSquaredBraceOpen,
       tkMinus,tkPlus,tkinherited:
         begin
@@ -6190,42 +6268,86 @@ end;
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
   ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility
   ): TPasProcedure;
+var
+  NameParts: TProcedureNameParts;
 
   function ExpectProcName: string;
-
+  { Simple procedure:
+      Name
+    Method implementation of non generic class:
+      aClass.SubClass.Name
+    ObjFPC generic procedure or method declaration:
+      MustBeGeneric=true, Name<Templates>
+    Delphi generic Method Declaration:
+      MustBeGeneric=false, Name<Templates>
+    ObjFPC Method implementation of generic class:
+      aClass.SubClass.Name
+    Delphi Method implementation of generic class:
+      aClass<Templates>.SubClass<Templates>.Name
+      aClass.SubClass<Templates>.Name<Templates>
+  }
   Var
     L : TFPList;
-    I : Integer;
-
+    I , Cnt, p: Integer;
+    CurName: String;
   begin
     Result:=ExpectIdentifier;
-    //writeln('ExpectProcName ',Parent.Classname);
-    if Parent is TImplementationSection then
-      begin
+    Cnt:=1;
+    repeat
       NextToken;
-      repeat
-        if CurToken=tkDot then
-          Result:=Result+'.'+ExpectIdentifier
-        else if CurToken=tkLessThan then
-          begin // <> can be ignored, we read the list but discard its content
-          if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
-            ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc
-          UnGetToken;
-          L:=TFPList.Create;
-          Try
-            ReadGenericArguments(L,Parent);
-          finally
-            For I:=0 to L.Count-1 do
-              TPasElement(L[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-            L.Free;
-          end;
+      if CurToken=tkDot then
+        begin
+          if Parent is TImplementationSection then
+            begin
+            inc(Cnt);
+            CurName:=ExpectIdentifier;
+            Result:=Result+'.'+CurName;
+            if length(NameParts)>0 then
+              begin
+              SetLength(NameParts,Cnt);
+              NameParts[Cnt-1].Name:=CurName;
+              end;
+            end
+          else
+            ParseExcSyntaxError;
+        end
+      else if CurToken=tkLessThan then
+        begin
+        if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
+          ParseExc(nParserGenericFunctionNeedsGenericKeyword,SParserGenericFunctionNeedsGenericKeyword);
+        // generic templates
+        if length(NameParts)=0 then
+          begin
+          // initialize NameParts
+          SetLength(NameParts,Cnt);
+          i:=0;
+          CurName:=Result;
+          repeat
+            p:=Pos('.',CurName);
+            if p>0 then
+              begin
+              NameParts[i].Name:=LeftStr(CurName,p-1);
+              System.Delete(CurName,1,p);
+              end
+            else
+              begin
+              NameParts[i].Name:=CurName;
+              break;
+              end;
+            inc(i);
+          until false;
           end
-        else
-          break;
-        NextToken;
-      until false;
-      UngetToken;
-      end;
+        else if NameParts[Cnt-1].Templates<>nil then
+          ParseExcSyntaxError;
+        UnGetToken;
+        L:=TFPList.Create;
+        NameParts[Cnt-1].Templates:=L;
+        ReadGenericArguments(L,Parent);
+        end
+      else
+        break;
+    until false;
+    UngetToken;
   end;
 
 var
@@ -6234,36 +6356,41 @@ var
   Ot : TOperatorType;
   IsTokenBased , ok: Boolean;
 begin
-  case ProcType of
-  ptOperator,ptClassOperator:
-    begin
-    if MustBeGeneric then
-      ParseExcTokenError('procedure');
-    NextToken;
-    IsTokenBased:=CurToken<>tkIdentifier;
-    if IsTokenBased then
-      OT:=TPasOperator.TokenToOperatorType(CurTokenText)
-    else
-      OT:=TPasOperator.NameToOperatorType(CurTokenString);
-    if (ot=otUnknown) then
-      ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
-    Name:=OperatorNames[Ot];
-    end;
-  ptAnonymousProcedure,ptAnonymousFunction:
-    begin
-    Name:='';
-    if MustBeGeneric then
-      ParseExcTokenError('generic'); // inconsistency
-    end
-  else
-    Name:=ExpectProcName;
-  end;
-  PC:=GetProcedureClass(ProcType);
-  if Name<>'' then
-    Parent:=CheckIfOverLoaded(Parent,Name);
-  Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
+  NameParts:=nil;
+  Result:=nil;
   ok:=false;
   try
+    case ProcType of
+    ptOperator,ptClassOperator:
+      begin
+      if MustBeGeneric then
+        ParseExcTokenError('procedure');
+      NextToken;
+      IsTokenBased:=CurToken<>tkIdentifier;
+      if IsTokenBased then
+        OT:=TPasOperator.TokenToOperatorType(CurTokenText)
+      else
+        OT:=TPasOperator.NameToOperatorType(CurTokenString);
+      if (ot=otUnknown) then
+        ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
+      Name:=OperatorNames[Ot];
+      end;
+    ptAnonymousProcedure,ptAnonymousFunction:
+      begin
+      Name:='';
+      if MustBeGeneric then
+        ParseExcTokenError('generic'); // inconsistency
+      end
+    else
+      Name:=ExpectProcName;
+    end;
+    PC:=GetProcedureClass(ProcType);
+    if Name<>'' then
+      Parent:=CheckIfOverLoaded(Parent,Name);
+    Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
+    if NameParts<>nil then
+      Result.SetNameParts(NameParts);
+
     case ProcType of
     ptFunction, ptClassFunction, ptOperator, ptClassOperator, ptAnonymousFunction:
       begin
@@ -6300,7 +6427,9 @@ begin
         end;
     ok:=true;
   finally
-    if not ok then
+    if NameParts<>nil then;
+      ReleaseProcNameParts(NameParts);
+    if (not ok) and (Result<>nil) then
       Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
   end;
 end;
@@ -6328,7 +6457,7 @@ begin
     NextToken;
     M:=TPasRecordType(CreateElement(TPasRecordType,'',V));
     V.Members:=M;
-    ParseRecordFieldList(M,tkBraceClose,False);
+    ParseRecordMembers(M,tkBraceClose,False);
     // Current token is closing ), so we eat that
     NextToken;
     // If there is a semicolon, we eat that too.
@@ -6376,8 +6505,23 @@ begin
 end;
 
 // Starts on first token after Record or (. Ends on AEndToken
-procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
+procedure TPasParser.ParseRecordMembers(ARec: TPasRecordType;
   AEndToken: TToken; AllowMethods: Boolean);
+var
+  isClass : Boolean;
+
+  procedure EnableIsClass;
+  begin
+    isClass:=True;
+    Scanner.SetTokenOption(toOperatorToken);
+  end;
+
+  procedure DisableIsClass;
+  begin
+    if not isClass then exit;
+    isClass:=false;
+    Scanner.UnSetTokenOption(toOperatorToken);
+  end;
 
 Var
   VariantName : String;
@@ -6385,23 +6529,25 @@ Var
   Proc: TPasProcedure;
   ProcType: TProcType;
   Prop : TPasProperty;
-  isClass : Boolean;
   NamePos: TPasSourcePos;
   OldCount, i: Integer;
   CurEl: TPasElement;
   Attr: TPasAttributes;
+  LastToken: TToken;
 begin
   if AllowMethods then
     v:=visPublic
   else
     v:=visDefault;
   isClass:=False;
+  LastToken:=tkrecord;
   while CurToken<>AEndToken do
     begin
     SaveComments;
     Case CurToken of
       tkType:
         begin
+        DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordTypesNotAllowed,SErrRecordTypesNotAllowed);
         ExpectToken(tkIdentifier);
@@ -6409,6 +6555,7 @@ begin
         end;
       tkConst:
         begin
+        DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
         ExpectToken(tkIdentifier);
@@ -6433,6 +6580,8 @@ begin
         end;
       tkClass:
         begin
+        if LastToken=tkclass then
+          ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
         if Not AllowMethods then
           begin
           NextToken;
@@ -6443,18 +6592,16 @@ begin
             ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
           end;
           end;
-        if isClass then
-          ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
-        isClass:=True;
-        Scanner.SetTokenOption(toOperatorToken);
+        EnableIsClass;
         end;
       tkProperty:
         begin
+        DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordPropertiesNotAllowed,SErrRecordPropertiesNotAllowed);
         ExpectToken(tkIdentifier);
-        Prop:=ParseProperty(ARec,CurtokenString,v,isClass);
-        Arec.Members.Add(Prop);
+        Prop:=ParseProperty(ARec,CurtokenString,v,LastToken=tkclass);
+        ARec.Members.Add(Prop);
         Engine.FinishScope(stDeclaration,Prop);
         end;
       tkOperator,
@@ -6462,9 +6609,10 @@ begin
       tkConstructor,
       tkFunction :
         begin
+        DisableIsClass;
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
-        ProcType:=GetProcTypeFromToken(CurToken,isClass);
+        ProcType:=GetProcTypeFromToken(CurToken,LastToken=tkclass);
         Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,false,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
@@ -6489,6 +6637,9 @@ begin
           begin
           CurEl:=TPasElement(ARec.Members[i]);
           if CurEl.ClassType=TPasAttributes then continue;
+          if isClass then
+            With TPasVariable(CurEl) do
+              VarModifiers:=VarModifiers + [vmClass];
           Engine.FinishScope(stDeclaration,TPasVariable(CurEl));
           end;
         end;
@@ -6503,6 +6654,7 @@ begin
           CheckToken(tkIdentifier);
       tkCase :
         begin
+        DisableIsClass;
         ARec.Variants:=TFPList.Create;
         NextToken;
         VariantName:=CurTokenString;
@@ -6525,13 +6677,10 @@ begin
     else
       ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
     end;
-    If CurToken<>tkClass then
-      begin
-      isClass:=False;
-      Scanner.UnSetTokenOption(toOperatorToken);
-      end;
-    if CurToken<>AEndToken then
-      NextToken;
+    if CurToken=AEndToken then
+      break;
+    LastToken:=CurToken;
+    NextToken;
     end;
 end;
 
@@ -6548,7 +6697,7 @@ begin
   try
     Result.PackMode:=PackMode;
     NextToken;
-    ParseRecordFieldList(Result,tkEnd,
+    ParseRecordMembers(Result,tkEnd,
       (msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
@@ -6964,6 +7113,65 @@ begin
     end;
 end;
 
+procedure TPasParser.DoParseArrayType(ArrType: TPasArrayType);
+var
+  S: String;
+  RangeExpr: TPasExpr;
+begin
+  NextToken;
+  S:='';
+  case CurToken of
+    tkSquaredBraceOpen:
+      begin
+      // static array
+      if ArrType.Parent is TPasArgument then
+        ParseExcTokenError('of');
+      repeat
+        NextToken;
+        if po_arrayrangeexpr in Options then
+          begin
+          RangeExpr:=DoParseExpression(ArrType);
+          ArrType.AddRange(RangeExpr);
+          end
+        else if CurToken<>tkSquaredBraceClose then
+          S:=S+CurTokenText;
+        if CurToken=tkSquaredBraceClose then
+          break
+        else if CurToken=tkComma then
+          continue
+        else if po_arrayrangeexpr in Options then
+          ParseExcTokenError(']');
+      until false;
+      ArrType.IndexRange:=S;
+      ExpectToken(tkOf);
+      ArrType.ElType := ParseType(ArrType,CurSourcePos);
+      end;
+    tkOf:
+      begin
+      NextToken;
+      if CurToken = tkConst then
+        // array of const
+        begin
+        if not (ArrType.Parent is TPasArgument) then
+          ParseExcExpectedIdentifier;
+        end
+      else
+        begin
+        if (CurToken=tkarray) and (ArrType.Parent is TPasArgument) then
+          ParseExcExpectedIdentifier;
+        UngetToken;
+        ArrType.ElType := ParseType(ArrType,CurSourcePos);
+        end;
+      end
+    else
+      ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
+  end;
+  // TPasProcedureType parsing has eaten the semicolon;
+  // We know it was a local definition if the array def (ArrType) is the parent
+  if (ArrType.ElType is TPasProcedureType) and (ArrType.ElType.Parent=ArrType) then
+    UnGetToken;
+end;
+
 function TPasParser.ParseClassDecl(Parent: TPasElement;
   const NamePos: TPasSourcePos; const AClassName: String;
   AObjKind: TPasObjKind; PackMode: TPackMode; GenericArgs: TFPList): TPasType;

packages/fcl-passrc/src/pscanner.pp

@@ -3461,16 +3461,22 @@ begin
   'FPC','DEFAULT':
     SetMode(msFpc,FPCModeSwitches,false,bsFPCMode);
   'OBJFPC':
+    begin
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
+    UnsetNonToken(tkgeneric);
+    UnsetNonToken(tkspecialize);
+    end;
   'DELPHI':
     begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
+    SetNonToken(tkspecialize);
     end;
   'DELPHIUNICODE':
     begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
+    SetNonToken(tkspecialize);
     end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -17,6 +17,7 @@ Type
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
     Procedure TestGenericConstraint;
+    Procedure TestGenericInterfaceConstraint; // ToDo
     Procedure TestDeclarationConstraint;
     Procedure TestSpecializationDelphi;
     Procedure TestDeclarationDelphi;
@@ -26,7 +27,9 @@ Type
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestInlineSpecializeInStatement;
-    Procedure TestGenericFunction; // ToDo
+    Procedure TestInlineSpecializeInStatementDelphi;
+    Procedure TestGenericFunction_Program;
+    Procedure TestGenericFunction_Unit;
   end;
 
 implementation
@@ -69,6 +72,32 @@ begin
     'Generic TSomeClass<T: TObject> = class',
     '  b : T;',
     'end;',
+    'Generic TBird<T: class> = class',
+    '  c : TBird<T>;',
+    'end;',
+    'Generic TEagle<T: record> = class',
+    'end;',
+    'Generic TEagle<T: constructor> = class',
+    'end;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestGenericInterfaceConstraint;
+begin
+  Add([
+    'Type',
+    'TIntfA = interface end;',
+    'TIntfB = interface end;',
+    'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;',
+    'Generic TAnt<T: TIntfA, TIntfB> = class',
+    '  b: T;',
+    '  c: TAnt<T>;',
+    'end;',
+    'Generic TFly<T: TIntfA, TIntfB; S> = class',
+    '  b: S;',
+    '  c: TFly<T>;',
+    'end;',
     '']);
   ParseDeclarations;
 end;
@@ -80,8 +109,8 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T: T2> = Class(TObject)');
-  Source.Add('  b : T;');
-  Source.Add('end;');
+  Source.Add('    b : T;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -105,9 +134,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T,T2> = Class(TObject)');
-  Source.Add('  b : T;');
-  Source.Add('  b2 : T2;');
-  Source.Add('end;');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -126,9 +155,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
-  Source.Add('  b : T;');
-  Source.Add('  b2 : T2;');
-  Source.Add('end;');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -148,9 +177,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
   Source.Add('Type');
   Source.Add('  TSomeClass<T;T2> = Class(TObject)');
-  Source.Add('  b : T;');
-  Source.Add('  b2 : T2;');
-  Source.Add('end;');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -172,11 +201,22 @@ begin
     Add('type');
     Add('  TTest<T> =  object');
     Add('    procedure foo(v:T);');
+    Add('    procedure bar<Y>(v:T);');
+    Add('  type');
+    Add('    TSub = class');
+    Add('      procedure DoIt<Y>(v:T);');
+    Add('    end;');
     Add('  end;');
     Add('implementation');
     Add('procedure TTest<T>.foo;');
     Add('begin');
     Add('end;');
+    Add('procedure TTest<T>.bar<Y>;');
+    Add('begin');
+    Add('end;');
+    Add('procedure TTest<T>.TSub.DoIt<Y>;');
+    Add('begin');
+    Add('end;');
     end;
   ParseModule;
 end;
@@ -207,24 +247,53 @@ begin
 end;
 
 procedure TTestGenerics.TestInlineSpecializeInStatement;
+begin
+  Add([
+  'begin',
+  '  t:=specialize a<b>;',
+  '  t:=a.specialize b<c>;',
+  '']);
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestInlineSpecializeInStatementDelphi;
 begin
   Add([
   'begin',
   '  vec:=TVector<double>.create;',
   '  b:=a<b;',
   '  t:=a<b.c<d,e.f>>;',
+  '  t:=a.b<c>;',
+  '  t:=a<b>.c;',
+  // forbidden:'  t:=a<b<c>.d>;',
   '']);
   ParseModule;
 end;
 
-procedure TTestGenerics.TestGenericFunction;
+procedure TTestGenerics.TestGenericFunction_Program;
 begin
   Add([
   'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
   'begin',
   'end;',
   'begin',
-  //'  specialize IfThen<word>(true,2,3);',
+  '  specialize IfThen<word>(true,2,3);',
+  '']);
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestGenericFunction_Unit;
+begin
+  Add([
+  'unit afile;',
+  'interface',
+  'generic function Get<T>(val: T) :T;',
+  'implementation',
+  'generic function Get<T>(val: T) :T;',
+  'begin',
+  'end;',
+  'initialization',
+  '  specialize GetIt<word>(2);',
   '']);
   ParseModule;
 end;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -0,0 +1,84 @@
+unit tcresolvegenerics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, testregistry, tcresolver, PasResolveEval;
+
+type
+
+  { TTestResolveGenerics }
+
+  TTestResolveGenerics = Class(TCustomTestResolver)
+  Published
+    procedure TestGen_GenericFunction; // ToDo
+    procedure TestGen_ConstraintStringFail;
+    procedure TestGen_ConstraintMultiClassFail;
+    // ToDo: constraint keyword record
+    // ToDo: constraint keyword class, constructor, class+constructor
+    // ToDo: constraint Unit2.TBird
+    // ToDo: constraint Unit2.TGen<word>
+    // ToDo: generic array
+  end;
+
+implementation
+
+{ TTestResolveGenerics }
+
+procedure TTestResolveGenerics.TestGen_GenericFunction;
+begin
+  StartProgram(false);
+  Add([
+  'generic function DoIt<T>(a: T): T;',
+  'var i: T;',
+  'begin',
+  '  a:=i;',
+  '  Result:=a;',
+  'end;',
+  'var w: word;',
+  'begin',
+  //'  w:=DoIt<word>(3);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
+begin
+  StartProgram(false);
+  Add([
+  'generic function DoIt<T:string>(a: T): T;',
+  'begin',
+  '  Result:=a;',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('''string'' is not a valid constraint',
+    nXIsNotAValidConstraint);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintMultiClassFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  '  TBear = class end;',
+  'generic function DoIt<T: TBird, TBear>(a: T): T;',
+  'begin',
+  '  Result:=a;',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('''TBird'' constraint and ''TBear'' constraint cannot be specified together',
+    nConstraintXAndConstraintYCannotBeTogether);
+end;
+
+initialization
+  RegisterTests([TTestResolveGenerics]);
+
+end.
+

packages/fcl-passrc/tests/tcresolver.pas

@@ -451,6 +451,7 @@ type
     Procedure TestProc_TypeCastFunctionResult;
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_Absolute;
+    Procedure TestProc_LocalInit;
 
     // anonymous procs
     Procedure TestAnonymousProc_Assign;
@@ -470,6 +471,7 @@ type
     Procedure TestAnonymousProc_With;
     Procedure TestAnonymousProc_ExceptOn;
     Procedure TestAnonymousProc_Nested;
+    Procedure TestAnonymousProc_ForLoop;
 
     // record
     Procedure TestRecord;
@@ -934,6 +936,7 @@ type
     Procedure TestTypeHelper_Set;
     Procedure TestTypeHelper_Enumerator;
     Procedure TestTypeHelper_String;
+    Procedure TestTypeHelper_StringOtherUnit;
     Procedure TestTypeHelper_Boolean;
     Procedure TestTypeHelper_Double;
     Procedure TestTypeHelper_DoubleAlias;
@@ -7455,6 +7458,25 @@ begin
   'begin',
   'end;',
   'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_LocalInit;
+begin
+  StartProgram(false);
+  Add([
+  'type TBytes = array of byte;',
+  'procedure DoIt;',
+  'const c = 4;',
+  'var',
+  '  w: word = c;',
+  '  b: byte = 1+c;',
+  '  p: pointer = nil;',
+  '  buf: TBytes = nil;',
+  'begin',
+  'end;',
+  'begin']);
+  ParseProgram;
 end;
 
 procedure TTestResolver.TestAnonymousProc_Assign;
@@ -7793,6 +7815,27 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestAnonymousProc_ForLoop;
+begin
+  StartProgram(false);
+  Add([
+  'type TProc = reference to procedure;',
+  'procedure Foo(p: TProc);',
+  'begin',
+  'end;',
+  'procedure DoIt;',
+  'var i: word;',
+  '  a: word;',
+  'begin',
+  '  for i:=1 to 10 do begin',
+  '    Foo(procedure begin a:=3; end);',
+  '  end;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);
@@ -8238,6 +8281,7 @@ begin
   '  r.V1:=trec.VC;',
   '  r.VC:=r.V1;',
   '  trec.VC:=trec.c1;',
+  '  trec.ca[1]:=trec.c2;',
   '']);
   ParseProgram;
 end;
@@ -11284,7 +11328,7 @@ begin
   Add('procedure TObject.DoIt; begin end;');
   Add('procedure TObject.DoIt(i: longint); begin end;');
   Add('begin');
-  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+  CheckResolverException(sDuplicatePublishedMethodXAtY,nDuplicatePublishedMethodXAtY);
 end;
 
 procedure TTestResolver.TestNestedClass;
@@ -17611,6 +17655,43 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestTypeHelper_StringOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    '{$modeswitch typehelpers}',
+    'type',
+    '  TStringHelper = type helper for String',
+    '    procedure DoIt;',
+    '  end;',
+    '  TCharHelper = type helper for char',
+    '    procedure Fly;',
+    '  end;',
+    '']),
+    LinesToStr([
+    'procedure TStringHelper.DoIt;',
+    'begin',
+    '  Self[1]:=Self[2];',
+    'end;',
+    'procedure TCharHelper.Fly;',
+    'begin',
+    '  Self:=''c'';',
+    '  Self:=Self;',
+    'end;',
+    '']));
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'var s: string;',
+  'begin',
+  '  ''abc''.DoIt;',
+  '  ''xyz''.DoIt();',
+  '  ''c''.Fly;',
+  '  s.DoIt;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestTypeHelper_Boolean;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/testpassrc.lpr

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

packages/pastojs/src/fppas2js.pp

@@ -2638,7 +2638,6 @@ begin
         while MyTokenPos>l do
           if DoEndOfLine then
             begin
-              writeln('AAA1 TPas2jsPasScanner.ReadNonPascalTillEndToken ',StopAtLineEnd);
             if not StopAtLineEnd then
               Error(nErrOpenString,SErrOpenString);
             exit;
@@ -2807,7 +2806,10 @@ begin
   else if C.InheritsFrom(TPasProcedure) then
     begin
     if TPasProcedure(El).IsOverride then
-      exit(true);
+      exit(true); // using name of overridden
+    if El.Visibility=visPublished then
+      exit(false);
+
     // Note: external proc pollutes the name space
     ProcScope:=TPasProcedureScope(El.CustomData);
     if ProcScope.DeclarationProc<>nil then
@@ -10784,8 +10786,8 @@ function TPasToJSConverter.ConvertBuiltIn_SetLength(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
 // convert "SetLength(a,Len)" to "a = rtl.arraySetLength(a,Len)"
 var
-  Param0: TPasExpr;
-  ResolvedParam0: TPasResolverResult;
+  Param0, Range: TPasExpr;
+  ResolvedParam0, RangeResolved: TPasResolverResult;
   ArrayType: TPasArrayType;
   Call: TJSCallExpression;
   ValInit: TJSElement;
@@ -10793,6 +10795,9 @@ var
   ElType, TypeEl: TPasType;
   i: Integer;
   aResolver: TPas2JSResolver;
+  DimSize: TMaxPrecInt;
+  StaticDims: TObjectList;
+  Lit: TJSLiteral;
 begin
   Result:=nil;
   Param0:=El.Params[0];
@@ -10814,6 +10819,7 @@ begin
 
     // ->  AnArray = rtl.setArrayLength(AnArray,defaultvalue,dim1,dim2,...)
     AssignContext:=TAssignContext.Create(El,nil,AContext);
+    StaticDims:=nil;
     try
       aResolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
       AssignContext.RightResolved:=ResolvedParam0;
@@ -10832,6 +10838,27 @@ begin
         ArrayType:=ElType as TPasArrayType;
         end;
       ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
+      while (ElType.ClassType=TPasArrayType) and (length(TPasArrayType(ElType).Ranges)>0) do
+        begin
+        // array of static array, Note: setlength reallocs static arrays
+        ArrayType:=ElType as TPasArrayType;
+        for i:=0 to length(ArrayType.Ranges)-1 do
+          begin
+          Range:=ArrayType.Ranges[i];
+          // compute size of this dimension
+          DimSize:=aResolver.GetRangeLength(Range);
+          if DimSize=0 then
+            begin
+            aResolver.ComputeElement(Range,RangeResolved,[rcConstant]);
+            RaiseNotSupported(Range,AContext,20190614171520,GetResolverResultDbg(RangeResolved));
+            end;
+          Lit:=CreateLiteralNumber(El,DimSize);
+          if StaticDims=nil then
+            StaticDims:=TObjectList.Create(true);
+          StaticDims.Add(Lit);
+          end;
+        ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
+        end;
       if ElType.ClassType=TPasRecordType then
         ValInit:=CreateReferencePathExpr(ElType,AContext)
       else
@@ -10840,12 +10867,19 @@ begin
       // add params: dim1, dim2, ...
       for i:=1 to length(El.Params)-1 do
         Call.AddArg(ConvertExpression(El.Params[i],AContext));
+      if StaticDims<>nil then
+        begin
+        for i:=0 to StaticDims.Count-1 do
+          Call.AddArg(TJSElement(StaticDims[i]));
+        StaticDims.OwnsObjects:=false;
+        end;
 
       // create left side:  array =
       Result:=CreateAssignStatement(Param0,AssignContext);
     finally
       AssignContext.RightSide.Free;
       AssignContext.Free;
+      StaticDims.Free;
     end;
     end
   else if ResolvedParam0.BaseType=btString then
@@ -11194,6 +11228,31 @@ end;
 
 function TPasToJSConverter.ConvertBuiltIn_Ord(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
+
+  function CheckOrdConstant(aResolver: TPas2JSResolver; Param: TPasExpr): TJSElement;
+  var
+    ParamValue, OrdValue: TResEvalValue;
+  begin
+    Result:=nil;
+    OrdValue:=nil;
+    ParamValue:=aResolver.Eval(Param,[]);
+    try
+      if ParamValue<>nil then
+        begin
+        OrdValue:=aResolver.ExprEvaluator.OrdValue(ParamValue,El);
+        if OrdValue<>nil then
+          begin
+          // ord(constant) -> constant
+          Result:=ConvertConstValue(OrdValue,AContext,El);
+          exit;
+          end;
+        end;
+    finally
+      ReleaseEvalValue(ParamValue);
+      ReleaseEvalValue(OrdValue);
+    end;
+  end;
+
 var
   ParamResolved, SubParamResolved: TPasResolverResult;
   Param, SubParam: TPasExpr;
@@ -11202,12 +11261,14 @@ var
   SubParamJS: TJSElement;
   Minus: TJSAdditiveExpressionMinus;
   Add: TJSAdditiveExpressionPlus;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
-  if AContext.Resolver=nil then
+  aResolver:=AContext.Resolver;
+  if aResolver=nil then
     RaiseInconsistency(20170210105235,El);
   Param:=El.Params[0];
-  AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+  aResolver.ComputeElement(Param,ParamResolved,[]);
   if ParamResolved.BaseType=btChar then
     begin
     if Param is TParamsExpr then
@@ -11241,6 +11302,11 @@ begin
           exit;
           end;
         end;
+      end
+    else
+      begin
+      Result:=CheckOrdConstant(aResolver,Param);
+      if Result<>nil then exit;
       end;
     // ord(aChar) -> aChar.charCodeAt()
     Result:=ConvertExpression(Param,AContext);
@@ -11250,6 +11316,9 @@ begin
     end
   else if ParamResolved.BaseType in btAllJSBooleans then
     begin
+    // ord(bool)
+    Result:=CheckOrdConstant(aResolver,Param);
+    if Result<>nil then exit;
     // ord(bool) ->  bool+0
     Result:=ConvertExpression(Param,AContext);
     // Note: convert Param first, as it might raise an exception
@@ -15236,7 +15305,7 @@ begin
 
   Call:=CreateCallExpression(PosEl);
   Call.Expr:=CreateDotNameExpr(PosEl,Expr,
-                                       TJSString(GetBIName(pbifnRecordClone)));
+                                        TJSString(GetBIName(pbifnRecordClone)));
   Result:=Call;
   if RecordExpr<>nil then
     Call.AddArg(RecordExpr);
@@ -15849,11 +15918,15 @@ begin
     else if ExprResolved.BaseType in btAllStringAndChars then
       begin
       US:=StrToJSString(aResolver.ComputeConstString(Expr,false,true));
-      ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Expr));
       Result:=ArrLit;
       for i:=1 to length(US) do
         ArrLit.Elements.AddElement.Expr:=CreateLiteralJSString(Expr,US[i]);
       end
+    else if ExprResolved.BaseType=btNil then
+      begin
+      Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Expr));
+      end
     else
       RaiseNotSupported(Expr,AContext,20170223133034);
     end
@@ -17264,7 +17337,7 @@ end;
 
 function TPasToJSConverter.CreateRTTIMemberProperty(Members: TFPList;
   Index: integer; AContext: TConvertContext): TJSElement;
-// create  $r.addProperty("propname",flags,result,"getter","setter",{options})
+// create  $r.addProperty("propname",flags,proptype,"getter","setter",{options})
 var
   Prop: TPasProperty;
   Call: TJSCallExpression;

packages/pastojs/src/fppjssrcmap.pp

@@ -44,6 +44,7 @@ type
 
   TPas2JSMapper = class(TBufferWriter)
   private
+    FDestFileName: String;
     FSrcMap: TPas2JSSrcMap;
     procedure SetSrcMap(const AValue: TPas2JSSrcMap);
   protected
@@ -59,6 +60,8 @@ type
     property SrcMap: TPas2JSSrcMap read FSrcMap write SetSrcMap;
     destructor Destroy; override;
     procedure WriteFile(Src, Filename: string);
+    // Final destination filename. Usually unit, unless combining javascript in single file.
+    Property DestFileName : String Read FDestFileName Write FDestFileName;
   end;
 
 implementation

packages/pastojs/src/pas2jscompiler.pp

@@ -37,8 +37,9 @@ uses
   {$ENDIF}
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
-  jsbase, jstree, jswriter, JSSrcMap,
+  jsbase, jstree, jswriter, JSSrcMap, fpjson,
   PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
+  pas2jsresstrfile,
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 const
@@ -95,6 +96,7 @@ const
   nPostProcessorWarnX = 142; sPostProcessorWarnX = 'Post processor: %s';
   nPostProcessorFinished = 143; sPostProcessorFinished = 'Post processor finished';
   nRTLIdentifierChanged = 144; sRTLIdentifierChanged = 'RTL identifier %s changed from %s to %s';
+  nSkipNoConstResourcestring = 145; sSkipNoConstResourcestring = 'Resource string %s is not a constant, not adding to resourcestrings file.';
   // Note: error numbers 201+ are used by Pas2jsFileCache
 
 //------------------------------------------------------------------------------
@@ -148,13 +150,17 @@ type
     rvcSystem,
     rvcUnit
     );
+  TP2JSResourceStringFile = (rsfNone,rsfUnit,rsfProgram);
+
 const
   DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
+  DefaultP2JSResourceStringFile = rsfProgram;
   DefaultP2jsRTLVersionCheck = rvcNone;
   coShowAll = [coShowErrors..coShowDebug];
   coO1Enable = [coEnumValuesAsNumbers];
   coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO];
 
+
   p2jscoCaption: array[TP2jsCompilerOption] of string = (
     // only used by experts or programs parsing the pas2js output, no need for resourcestrings
     'Skip default configs',
@@ -492,8 +498,13 @@ type
     FSrcMapSourceRoot: string;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FWPOAnalyzer: TPas2JSAnalyzer;
+    FResourceStrings : TResourceStringsFile;
+    FResourceStringFile :  TP2JSResourceStringFile;
     procedure AddInsertJSFilename(const aFilename: string);
     Procedure AddNamespaces(const Paths: string; FromCmdLine: boolean);
+    procedure AddUnitResourceStrings(aFile: TPas2jsCompilerFile);
+    function CreateFileWriter(aFile: TPas2jsCompilerFile; const aFilename: string): TPas2JSMapper;
+    procedure EmitJavaScript(aFile: TPas2jsCompilerFile; aFileWriter: TPas2JSMapper);
     function GetDefaultNamespace: String;
     function GetFileCount: integer;
     function GetResolvedMainJSFile: string;
@@ -539,6 +550,9 @@ type
     procedure SetTargetProcessor(const AValue: TPasToJsProcessor);
     procedure SetWriteDebugLog(const AValue: boolean);
     procedure SetWriteMsgToStdErr(const AValue: boolean);
+    procedure WriteJSToFile(const MapFileName: string; aFileWriter: TPas2JSMapper);
+    procedure WriteResourceStrings(aFileName: String);
+    procedure WriteSrcMap(const MapFileName: string; aFileWriter: TPas2JSMapper);
   private
     procedure AddDefinesForTargetPlatform;
     procedure AddDefinesForTargetProcessor;
@@ -590,8 +604,11 @@ type
     procedure CreateJavaScript(aFile: TPas2jsCompilerFile;
       Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename });
     procedure FinishSrcMap(SrcMap: TPas2JSSrcMap); virtual;
+    // WriteSingleJSFile does not
+    procedure WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
+    // WriteJSFiles recurses uses clause
     procedure WriteJSFiles(aFile: TPas2jsCompilerFile;
-      var CombinedFileWriter: TPas2JSMapper;
+      CombinedFileWriter: TPas2JSMapper;
       Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename });
     procedure InitParamMacros;virtual;
     procedure ClearDefines;
@@ -1986,7 +2003,7 @@ begin
 
     // write .js files
     Checked:=CreateSetOfCompilerFiles(kcFilename);
-    WriteJSFiles(MainFile,CombinedFileWriter,Checked);
+    WriteJSFiles(MainFile,Nil,Checked);
     FreeAndNil(Checked);
 
     // write success message
@@ -2292,115 +2309,390 @@ begin
   Result:=TPas2JSSrcMap.Create(aFileName);
 end;
 
-procedure TPas2jsCompiler.WriteJSFiles(aFile: TPas2jsCompilerFile;
-  var CombinedFileWriter: TPas2JSMapper; Checked: TPasAnalyzerKeySet);
+function TPas2jsCompiler.CreateFileWriter(aFile: TPas2jsCompilerFile;
+  const aFilename: string): TPas2JSMapper;
 
-  procedure CheckUsesClause(UsesClause: TPasUsesClause);
-  var
-    i: Integer;
-    UsedFile: TPas2jsCompilerFile;
-    aModule: TPasModule;
+var
+  SrcMap: TPas2JSSrcMap;
+  DestFileName : String;
+
+begin
+  DestFileName:=AFileName;
+  if DestFileName='' then
+    DestFileName:=aFile.JSFilename;
+  Result:=CreateJSMapper;
+  Result.DestFileName:=DestFileName;
+  if SrcMapEnable then
   begin
-    if length(UsesClause)=0 then exit;
-    for i:=0 to length(UsesClause)-1 do begin
-      aModule:=UsesClause[i].Module as TPasModule;
-      UsedFile:=TPas2jsCompilerFile.GetFile(aModule);
-      if UsedFile=nil then
-        RaiseInternalError(20171214121720,aModule.Name);
-      WriteJSFiles(UsedFile,CombinedFileWriter,Checked);
-    end;
+    SrcMap:=CreateSrcMap(ExtractFilename(DestFilename));
+    Result.SrcMap:=SrcMap;
+    SrcMap.Release;// release the refcount from the Create
+    SrcMap.SourceRoot:=SrcMapSourceRoot;
+    SrcMap.LocalFilename:=aFile.JSFilename;
+    if SrcMapXSSIHeader then
+      SrcMap.Options:=SrcMap.Options+[smoSafetyHeader]
+    else
+      SrcMap.Options:=SrcMap.Options-[smoSafetyHeader];
+    SrcMap.Options:=SrcMap.Options+[smoAllowSrcLine0];
   end;
+end;
+
+
+procedure TPas2jsCompiler.EmitJavaScript(aFile: TPas2jsCompilerFile;
+  aFileWriter: TPas2JSMapper);
 
 var
-  aFileWriter: TPas2JSMapper;
-  FreeWriter: Boolean;
+  aJSWriter: TJSWriter;
+begin
+  // write JavaScript
+  aJSWriter:=CreateJSWriter(aFileWriter);
+  try
+    aJSWriter.Options:=DefaultJSWriterOptions;
+    aJSWriter.IndentSize:=2;
+    try
+      aJSWriter.WriteJS(aFile.JSModule);
+    except
+      on E: Exception do begin
+        if ShowDebug then
+          Log.LogExceptionBackTrace(E);
+        Log.LogPlain('[20180204193420] Error while creating JavaScript '+FullFormatPath(aFileWriter.DestFilename)+': '+E.Message);
+        Terminate(ExitCodeErrorInternal);
+      end
+      {$IFDEF Pas2js}
+      else HandleJSException('[20181031190520] TPas2jsCompiler.WriteJSFiles Error while creating JavaScript',JSExceptValue);
+      {$ENDIF}
+    end;
+  Finally
+    aJSWriter.Free;
+  end;
+end;
 
-  procedure CreateFileWriter(aFilename: string);
-  var
-    SrcMap: TPas2JSSrcMap;
-  begin
-    aFileWriter:=CreateJSMapper;
-    FreeWriter:=true;
-    if SrcMapEnable then
-    begin
-      SrcMap:=CreateSrcMap(ExtractFilename(aFilename));
-      aFileWriter.SrcMap:=SrcMap;
-      SrcMap.Release;// release the refcount from the Create
-      SrcMap.SourceRoot:=SrcMapSourceRoot;
-      SrcMap.LocalFilename:=aFile.JSFilename;
-      if SrcMapXSSIHeader then
-        SrcMap.Options:=SrcMap.Options+[smoSafetyHeader]
-      else
-        SrcMap.Options:=SrcMap.Options-[smoSafetyHeader];
-      SrcMap.Options:=SrcMap.Options+[smoAllowSrcLine0];
+
+procedure TPas2jsCompiler.WriteJSToFile(const MapFileName: string;
+  aFileWriter: TPas2JSMapper);
+
+Var
+  {$IFDEF Pas2js}
+  buf: TJSArray;
+  {$ELSE}
+  buf: TMemoryStream;
+  {$ENDIF}
+  Src : String;
+
+begin
+  // write js
+  try
+    {$IFDEF Pas2js}
+    buf:=TJSArray.new;
+    {$ELSE}
+    buf:=TMemoryStream.Create;
+    {$ENDIF}
+    try
+      {$IFDEF FPC_HAS_CPSTRING}
+      // UTF8-BOM
+      if (Log.Encoding='') or (Log.Encoding='utf8') then
+      begin
+        Src:=String(UTF8BOM);
+        buf.Write(Src[1],length(Src));
+      end;
+      {$ENDIF}
+      // JS source
+      {$IFDEF Pas2js}
+      buf:=TJSArray(aFileWriter.Buffer).slice();
+      {$ELSE}
+      buf.Write(aFileWriter.Buffer^,aFileWriter.BufferLength);
+      {$ENDIF}
+      // source map comment
+      if aFileWriter.SrcMap<>nil then
+      begin
+        Src:='//# sourceMappingURL='+ExtractFilename(MapFilename)+LineEnding;
+        {$IFDEF Pas2js}
+        buf.push(Src);
+        {$ELSE}
+        buf.Write(Src[1],length(Src));
+        {$ENDIF}
+      end;
+      //SetLength(Src,buf.Position);
+      //Move(buf.Memory^,Src[1],length(Src));
+      //writeln('TPas2jsCompiler.WriteJSFiles ====',Src);
+      //writeln('TPas2jsCompiler.WriteJSFiles =======================');
+      {$IFDEF Pas2js}
+      {$ELSE}
+      buf.Position:=0;
+      {$ENDIF}
+      FS.SaveToFile(buf,aFileWriter.DestFilename);
+    finally
+      {$IFDEF Pas2js}
+      buf:=nil;
+      {$ELSE}
+      buf.Free;
+      {$ENDIF}
     end;
+  except
+    on E: Exception do begin
+      if ShowDebug then
+        Log.LogExceptionBackTrace(E);
+      {$IFDEF FPC}
+      if E.Message<>SafeFormat(SFCreateError,[aFileWriter.DestFileName]) then
+      {$ENDIF}
+        Log.LogPlain('Error: '+E.Message);
+      Log.LogMsg(nUnableToWriteFile,[FullFormatPath(aFileWriter.DestFilename)]);
+      Terminate(ExitCodeWriteError);
+    end
+    {$IFDEF Pas2js}
+    else HandleJSException('[20181031190637] TPas2jsCompiler.WriteJSFiles',JSExceptValue,true);
+    {$ENDIF}
   end;
+end;
 
-var
-  DestFilename, DestDir, Src, MapFilename: String;
-  aJSWriter: TJSWriter;
+procedure TPas2jsCompiler.WriteSrcMap(const MapFileName: string;
+  aFileWriter: TPas2JSMapper);
+
+Var
   {$IFDEF Pas2js}
   buf: TJSArray;
   {$ELSE}
   buf: TMemoryStream;
   {$ENDIF}
 begin
-  //writeln('TPas2jsCompiler.WriteJSFiles START ',aFile.UnitFilename,' Need=',aFile.NeedBuild,' Checked=',Checked.ContainsItem(aFile),' JSModule=',GetObjName(aFile.JSModule));
-  if (aFile.JSModule=nil) or (not aFile.NeedBuild) then exit;
-  // check each file only once
-  if Checked.ContainsItem(aFile) then exit;
-  Checked.Add(aFile);
+  Log.LogMsg(nWritingFile,[FullFormatPath(MapFilename)],'',0,0,
+             not (coShowLineNumbers in Options));
+  FinishSrcMap(aFileWriter.SrcMap);
+  try
+    {$IFDEF Pas2js}
+    buf:=TJSArray.new;
+    {$ELSE}
+    buf:=TMemoryStream.Create;
+    {$ENDIF}
+    try
+      // Note: No UTF-8 BOM in source map, Chrome 59 gives an error
+      aFileWriter.SrcMap.SaveToStream(buf);
+      {$IFDEF Pas2js}
+      {$ELSE}
+      buf.Position:=0;
+      {$ENDIF}
+      FS.SaveToFile(buf,MapFilename);
+    finally
+      {$IFDEF Pas2js}
+      buf:=nil;
+      {$ELSE}
+      buf.Free;
+      {$ENDIF}
+    end;
+  except
+    on E: Exception do begin
+      if ShowDebug then
+        Log.LogExceptionBackTrace(E);
+      {$IFDEF FPC}
+      if E.Message<>SafeFormat(SFCreateError,[aFileWriter.DestFileName]) then
+      {$ENDIF}
+        Log.LogPlain('Error: '+E.Message);
+      Log.LogMsg(nUnableToWriteFile,[FullFormatPath(MapFilename)]);
+      Terminate(ExitCodeWriteError);
+    end
+    {$IFDEF Pas2js}
+    else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
+    {$ENDIF}
+  end;
+end;
+
+procedure TPas2jsCompiler.AddUnitResourceStrings(aFile : TPas2jsCompilerFile);
 
-  FreeWriter:=false;
-  if AllJSIntoMainJS and (CombinedFileWriter=nil) then
+Var
+  ResList : TFPList;
+
+  Procedure AddToList(aList : TFPList);
+  var
+    I : integer;
   begin
-    // create CombinedFileWriter
-    DestFilename:=GetResolvedMainJSFile;
-    CreateFileWriter(DestFilename);
-    CombinedFileWriter:=aFileWriter;
-    InsertCustomJSFiles(CombinedFileWriter);
-  end else begin
-    DestFilename:=aFile.JSFilename;
+    For I:=0 to aList.Count-1 do
+      ResList.Add(aList[i]);
   end;
 
-  // convert dependencies
-  CheckUsesClause(aFile.GetPasMainUsesClause);
-  CheckUsesClause(aFile.GetPasImplUsesClause);
+  Procedure AddUsedToList(aList : TFPList);
+  var
+    I : integer;
 
-  aJSWriter:=nil;
-  aFileWriter:=CombinedFileWriter;
+  begin
+    For I:=0 to aList.Count-1 do
+      if aFile.UseAnalyzer.IsUsed(TPasElement(aList[i])) then
+        ResList.Add(aList[i]);
+  end;
+
+  Procedure CheckSection(aSection : TPasSection);
+
+  begin
+    if not (Assigned(aSection) and Assigned(aSection.ResStrings)) then
+      exit;
+    if FResourceStringFile=rsfProgram then
+      AddUsedToList(aSection.ResStrings)
+    else
+      AddToList(aSection.ResStrings);
+  end;
+
+Var
+  I : Integer;
+  Res : TPasResString;
+  aValue : TResEvalValue;
+
+begin
+  if FResourceStringFile=rsfUnit then
+     FResourceStrings.Clear;
+  ResList:=TFPList.Create;
   try
-    if aFileWriter=nil then
-    begin
-      // create writer for this file
-      CreateFileWriter(DestFilename);
-      if aFile.IsMainFile and Not AllJSIntoMainJS then
-        InsertCustomJSFiles(aFileWriter);
-    end;
+    // Program ?
+    if aFile.pasModule is TPasProgram then
+      CheckSection(TPasProgram(aFile.pasModule).ProgramSection)
+    else if aFile.pasModule is TPasLibrary then // Library ?
+      CheckSection(TPasLibrary(aFile.pasModule).LibrarySection)
+    else
+      begin
+      // Interface
+      CheckSection(aFile.PasModule.InterfaceSection);
+      // Implementation
+      CheckSection(aFile.PasModule.ImplementationSection);
+      end;
+    // Now add to file
+    if ResList.Count>0 then
+      begin
+      FResourceStrings.StartUnit(aFile.GetModuleName);
+      For I:=0 to ResList.Count-1 do
+        begin
+        Res:=TPasResString(ResList[i]);
+        aValue:=aFile.PascalResolver.Eval(Res.Expr,[refConst],False);
+        if aValue.Kind=revkString then
+           FResourceStrings.AddString(Res.Name,TResEvalString(aValue).S)
+        else if aValue.Kind=revkUnicodeString then
+           FResourceStrings.AddString(Res.Name,TJSONStringType(TResEvalUTF16(aValue).S))
+        else
+          Log.Log(mtNote,sSkipNoConstResourcestring,nSkipNoConstResourcestring,aFile.PasFileName);
+        ReleaseEvalValue(aValue);
+        end;
+      end;
+  finally
+    ResList.Free;
+  end;
+end;
 
-    // write JavaScript
-    aJSWriter:=CreateJSWriter(aFileWriter);
-    aJSWriter.Options:=DefaultJSWriterOptions;
-    aJSWriter.IndentSize:=2;
+
+procedure TPas2jsCompiler.WriteResourceStrings(aFileName : String);
+
+Var
+  {$IFDEF Pas2js}
+  buf: TJSArray;
+  {$ELSE}
+  buf: TMemoryStream;
+  {$ENDIF}
+  S : TJSONStringType;
+
+begin
+  Log.LogMsg(nWritingFile,[FullFormatPath(aFilename)],'',0,0,False);
+  try
+    {$IFDEF Pas2js}
+    buf:=TJSArray.new;
+    {$ELSE}
+    buf:=TMemoryStream.Create;
+    {$ENDIF}
     try
-      aJSWriter.WriteJS(aFile.JSModule);
-    except
-      on E: Exception do begin
-        if ShowDebug then
-          Log.LogExceptionBackTrace(E);
-        Log.LogPlain('[20180204193420] Error while creating JavaScript '+FullFormatPath(DestFilename)+': '+E.Message);
-        Terminate(ExitCodeErrorInternal);
-      end
+      // Note: No UTF-8 BOM in source map, Chrome 59 gives an error
+      S:=FResourceStrings.AsString;
+      {$ifdef pas2js}
+      aStream.push(S);
+      {$else}
+      buf.Write(S[1],length(S));
+      {$endif}
+      FS.SaveToFile(buf,aFilename);
+    finally
       {$IFDEF Pas2js}
-      else HandleJSException('[20181031190520] TPas2jsCompiler.WriteJSFiles Error while creating JavaScript',JSExceptValue);
+      buf:=nil;
+      {$ELSE}
+      buf.Free;
       {$ENDIF}
     end;
+  except
+    on E: Exception do begin
+      if ShowDebug then
+        Log.LogExceptionBackTrace(E);
+      {$IFDEF FPC}
+      if E.Message<>SafeFormat(SFCreateError,[aFileName]) then
+      {$ENDIF}
+        Log.LogPlain('Error: '+E.Message);
+      Log.LogMsg(nUnableToWriteFile,[FullFormatPath(aFilename)]);
+      Terminate(ExitCodeWriteError);
+    end
+    {$IFDEF Pas2js}
+    else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
+    {$ENDIF}
+  end;
+
+end;
+
+procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
+
+  Procedure WriteToStandardOutput(aFileWriter : TPas2JSMapper);
+
+  begin
+  // write to stdout
+    {$IFDEF HasStdErr}
+    Log.WriteMsgToStdErr:=false;
+    {$ENDIF}
+    try
+      Log.LogRaw(aFileWriter.AsString);
+    finally
+      {$IFDEF HasStdErr}
+      Log.WriteMsgToStdErr:=coWriteMsgToStdErr in Options;
+      {$ENDIF}
+    end;
+  end;
+
+  Procedure CheckOutputDir(Const DestFileName : String);
+
+  Var
+    DestDir : String;
+
+  begin
+    // check output directory
+    DestDir:=ChompPathDelim(ExtractFilePath(DestFilename));
+    if (DestDir<>'') and not FS.DirectoryExists(DestDir) then
+    begin
+      Log.LogMsg(nOutputDirectoryNotFound,[FullFormatPath(DestDir)]);
+      Terminate(ExitCodeFileNotFound);
+    end;
+    if FS.DirectoryExists(DestFilename) then
+    begin
+      Log.LogMsg(nFileIsFolder,[FullFormatPath(DestFilename)]);
+      Terminate(ExitCodeWriteError);
+    end;
+  end;
+
+Var
+  aFileWriter : TPas2JSMapper;
+  isSingleFile : Boolean;
+  MapFilename : String;
+
+begin
+  aFileWriter:=CombinedFileWriter;
+  try
+    isSingleFile:=aFileWriter=nil;
+    if isSingleFile then
+      // create local writer for this file
+      begin
+      aFileWriter:=CreateFileWriter(aFile,'');
+      if aFile.IsMainFile and Not AllJSIntoMainJS then
+        InsertCustomJSFiles(aFileWriter);
+      end;
+
+    if FResourceStringFile<>rsfNone then
+      AddUnitResourceStrings(aFile);
+    EmitJavaScript(aFile,aFileWriter);
+
+
 
     if aFile.IsMainFile and (TargetPlatform=PlatformNodeJS) then
       aFileWriter.WriteFile('rtl.run();'+LineEnding,aFile.UnitFilename);
 
-    if FreeWriter then
-    begin
+    if isSingleFile or aFile.isMainFile then
+      begin
       if Assigned(PostProcessorSupport) then
         PostProcessorSupport.CallPostProcessors(aFile.JSFilename,aFileWriter);
 
@@ -2409,162 +2701,74 @@ begin
         exit;// descendant has written -> finished
 
       if (aFile.JSFilename='') and (MainJSFile='.') then
-      begin
-        // write to stdout
-        if FreeWriter then
-        begin
-          {$IFDEF HasStdErr}
-          Log.WriteMsgToStdErr:=false;
-          {$ENDIF}
-          try
-            Log.LogRaw(aFileWriter.AsString);
-          finally
-            {$IFDEF HasStdErr}
-            Log.WriteMsgToStdErr:=coWriteMsgToStdErr in Options;
-            {$ENDIF}
-          end;
-        end;
-      end else if FreeWriter then
-      begin
-        // write to file
+        WriteToStandardOutput(aFileWriter);
 
-        //writeln('TPas2jsCompiler.WriteJSFiles ',aFile.UnitFilename,' ',aFile.JSFilename);
-        Log.LogMsg(nWritingFile,[FullFormatPath(DestFilename)],'',0,0,
-                   not (coShowLineNumbers in Options));
+      //writeln('TPas2jsCompiler.WriteJSFiles ',aFile.UnitFilename,' ',aFile.JSFilename);
+      Log.LogMsg(nWritingFile,[FullFormatPath(aFileWriter.DestFilename)],'',0,0, not (coShowLineNumbers in Options));
 
-        // check output directory
-        DestDir:=ChompPathDelim(ExtractFilePath(DestFilename));
-        if (DestDir<>'') and not FS.DirectoryExists(DestDir) then
-        begin
-          Log.LogMsg(nOutputDirectoryNotFound,[FullFormatPath(DestDir)]);
-          Terminate(ExitCodeFileNotFound);
-        end;
-        if FS.DirectoryExists(DestFilename) then
-        begin
-          Log.LogMsg(nFileIsFolder,[FullFormatPath(DestFilename)]);
-          Terminate(ExitCodeWriteError);
-        end;
+      CheckOutputDir(aFileWriter.DestFileName);
 
-        MapFilename:=DestFilename+'.map';
-
-        // write js
-        try
-          {$IFDEF Pas2js}
-          buf:=TJSArray.new;
-          {$ELSE}
-          buf:=TMemoryStream.Create;
-          {$ENDIF}
-          try
-            {$IFDEF FPC_HAS_CPSTRING}
-            // UTF8-BOM
-            if (Log.Encoding='') or (Log.Encoding='utf8') then
-            begin
-              Src:=String(UTF8BOM);
-              buf.Write(Src[1],length(Src));
-            end;
-            {$ENDIF}
-            // JS source
-            {$IFDEF Pas2js}
-            buf:=TJSArray(aFileWriter.Buffer).slice();
-            {$ELSE}
-            buf.Write(aFileWriter.Buffer^,aFileWriter.BufferLength);
-            {$ENDIF}
-            // source map comment
-            if aFileWriter.SrcMap<>nil then
-            begin
-              Src:='//# sourceMappingURL='+ExtractFilename(MapFilename)+LineEnding;
-              {$IFDEF Pas2js}
-              buf.push(Src);
-              {$ELSE}
-              buf.Write(Src[1],length(Src));
-              {$ENDIF}
-            end;
-            //SetLength(Src,buf.Position);
-            //Move(buf.Memory^,Src[1],length(Src));
-            //writeln('TPas2jsCompiler.WriteJSFiles ====',Src);
-            //writeln('TPas2jsCompiler.WriteJSFiles =======================');
-            {$IFDEF Pas2js}
-            {$ELSE}
-            buf.Position:=0;
-            {$ENDIF}
-            FS.SaveToFile(buf,DestFilename);
-          finally
-            {$IFDEF Pas2js}
-            buf:=nil;
-            {$ELSE}
-            buf.Free;
-            {$ENDIF}
-          end;
-        except
-          on E: Exception do begin
-            if ShowDebug then
-              Log.LogExceptionBackTrace(E);
-            {$IFDEF FPC}
-            if E.Message<>SafeFormat(SFCreateError,[DestFileName]) then
-            {$ENDIF}
-              Log.LogPlain('Error: '+E.Message);
-            Log.LogMsg(nUnableToWriteFile,[FullFormatPath(DestFilename)]);
-            Terminate(ExitCodeWriteError);
-          end
-          {$IFDEF Pas2js}
-          else HandleJSException('[20181031190637] TPas2jsCompiler.WriteJSFiles',JSExceptValue,true);
-          {$ENDIF}
-        end;
-
-        // write source map
-        if aFileWriter.SrcMap<>nil then
-        begin
-          Log.LogMsg(nWritingFile,[FullFormatPath(MapFilename)],'',0,0,
-                     not (coShowLineNumbers in Options));
-          FinishSrcMap(aFileWriter.SrcMap);
-          try
-            {$IFDEF Pas2js}
-            buf:=TJSArray.new;
-            {$ELSE}
-            buf:=TMemoryStream.Create;
-            {$ENDIF}
-            try
-              // Note: No UTF-8 BOM in source map, Chrome 59 gives an error
-              aFileWriter.SrcMap.SaveToStream(buf);
-              {$IFDEF Pas2js}
-              {$ELSE}
-              buf.Position:=0;
-              {$ENDIF}
-              FS.SaveToFile(buf,MapFilename);
-            finally
-              {$IFDEF Pas2js}
-              buf:=nil;
-              {$ELSE}
-              buf.Free;
-              {$ENDIF}
-            end;
-          except
-            on E: Exception do begin
-              if ShowDebug then
-                Log.LogExceptionBackTrace(E);
-              {$IFDEF FPC}
-              if E.Message<>SafeFormat(SFCreateError,[DestFileName]) then
-              {$ENDIF}
-                Log.LogPlain('Error: '+E.Message);
-              Log.LogMsg(nUnableToWriteFile,[FullFormatPath(MapFilename)]);
-              Terminate(ExitCodeWriteError);
-            end
-            {$IFDEF Pas2js}
-            else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
-            {$ENDIF}
-          end;
-        end;
+      MapFilename:=aFileWriter.DestFilename+'.map';
+      WriteJSToFile(MapFileName,aFileWriter);
+      if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then
+        if FResourceStrings.StringsCount>0 then
+          WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs'));
+      // write source map
+      if aFileWriter.SrcMap<>nil then
+        WriteSrcMap(MapFileName,aFileWriter);
       end;
-    end;
 
   finally
-    if FreeWriter then
+    if isSingleFile then
+      aFileWriter.Free;
+  end;
+end;
+
+
+procedure TPas2jsCompiler.WriteJSFiles(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper; Checked: TPasAnalyzerKeySet);
+
+  procedure CheckUsesClause(aFileWriter: TPas2JSMapper; UsesClause: TPasUsesClause);
+  var
+    i: Integer;
+    UsedFile: TPas2jsCompilerFile;
+    aModule: TPasModule;
+  begin
+    if length(UsesClause)=0 then exit;
+    for i:=0 to length(UsesClause)-1 do begin
+      aModule:=UsesClause[i].Module as TPasModule;
+      UsedFile:=TPas2jsCompilerFile.GetFile(aModule);
+      if UsedFile=nil then
+        RaiseInternalError(20171214121720,aModule.Name);
+      WriteJSFiles(UsedFile,aFileWriter,Checked);
+    end;
+  end;
+
+Var
+  aFileWriter : TPas2JSMapper;
+
+begin
+  // writeln('TPas2jsCompiler.WriteJSFiles START ',aFile.UnitFilename,' Need=',aFile.NeedBuild,' Checked=',Checked.ContainsItem(aFile),' JSModule=',GetObjName(aFile.JSModule));
+  if (aFile.JSModule=nil) or (not aFile.NeedBuild) then exit;
+  // check each file only once
+  if Checked.ContainsItem(aFile) then exit;
+  Checked.Add(aFile);
+
+  aFileWriter:=CombinedFileWriter;
+  if AllJSIntoMainJS and (aFileWriter=nil) then
     begin
-      if CombinedFileWriter=aFileWriter then
-        CombinedFileWriter:=nil;
-      aFileWriter.Free
+    // create CombinedFileWriter
+    aFileWriter:=CreateFileWriter(aFile,GetResolvedMainJSFile);
+    InsertCustomJSFiles(aFileWriter);
     end;
-    aJSWriter.Free;
+  Try
+    // convert dependencies
+    CheckUsesClause(aFileWriter,aFile.GetPasMainUsesClause);
+    CheckUsesClause(aFileWriter,aFile.GetPasImplUsesClause);
+    // Write me...
+    WriteSingleJSFile(aFile,aFileWriter);
+  finally
+    if aFileWriter<>CombinedFileWriter then
+      aFileWriter.Free;
   end;
 end;
 
@@ -3218,6 +3422,20 @@ begin
         PostProcessorSupport.AddPostProcessor(aValue);
       end;
     end;
+  'r': // -Jr<...>
+    begin
+    S:=aValue;
+    if aValue='' then
+      ParamFatal('missing value for -Jr option')
+    else if (S='none') then
+      FResourceStringFile:=rsfNone
+    else if (S='unit') then
+      FResourceStringFile:=rsfunit
+    else if (S='program') then
+      FResourceStringFile:=rsfProgram
+    else
+      ParamFatal('invalid resource string file format (-Jr) "'+aValue+'"');
+    end;
   'u': // -Ju<foreign path>
     if not Quick then
       begin
@@ -3804,6 +4022,7 @@ begin
 
   FFiles:=CreateSetOfCompilerFiles(kcFilename);
   FUnits:=CreateSetOfCompilerFiles(kcUnitName);
+  FResourceStrings:=TResourceStringsFile.Create;
   FReadingModules:=TFPList.Create;
   InitParamMacros;
   Reset;
@@ -3813,6 +4032,7 @@ destructor TPas2jsCompiler.Destroy;
 
   procedure FreeStuff;
   begin
+    FreeAndNil(FResourceStrings);
     FreeAndNil(FNamespaces);
     FreeAndNil(FWPOAnalyzer);
     FreeAndNil(FInsertFilenames);
@@ -4284,6 +4504,10 @@ begin
   w('     -JoCheckVersion=system: insert rtl version check into system unit init.');
   w('     -JoCheckVersion=unit: insert rtl version check into every unit init.');
   w('     -JoRTL-<y>=<z>: set RTL identifier y to value z. See -iJ.');
+  w('   -Jr<x> Control writing of resource string file');
+  w('     -Jrnone: Do not write resource string file');
+  w('     -Jrunit: Write resource string file per unit with all resource strings');
+  w('     -Jrprogram: Write resource string file per program with all used resource strings in program');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   WritePrecompiledFormats;

packages/pastojs/src/pas2jsfiler.pp

@@ -744,10 +744,10 @@ type
     procedure WriteRecordValues(Obj: TJSONObject; Expr: TRecordValues; aContext: TPCUWriterContext); virtual;
     procedure WriteArrayValues(Obj: TJSONObject; Expr: TArrayValues; aContext: TPCUWriterContext); virtual;
     procedure WriteResString(Obj: TJSONObject; El: TPasResString; aContext: TPCUWriterContext); virtual;
+    procedure WriteGenericTemplateTypes(Obj: TJSONObject; Parent: TPasElement; GenericTemplateTypes: TFPList; aContext: TPCUWriterContext); virtual;
     procedure WriteAliasType(Obj: TJSONObject; El: TPasAliasType; aContext: TPCUWriterContext); virtual;
     procedure WritePointerType(Obj: TJSONObject; El: TPasPointerType; aContext: TPCUWriterContext); virtual;
     procedure WriteSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUWriterContext); virtual;
-    procedure WriteInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr; aContext: TPCUWriterContext); virtual;
     procedure WriteInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext); virtual;
     procedure WriteRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUWriterContext); virtual;
     procedure WriteArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUWriterContext); virtual;
@@ -775,6 +775,7 @@ type
     procedure WritePropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUWriterContext); virtual;
     procedure WriteProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUWriterContext); virtual;
     procedure WriteMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUWriterContext); virtual;
+    procedure WriteProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedureModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcedureModifiers); virtual;
     procedure WriteProcScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasProcedureScopeFlags); virtual;
     procedure WriteProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext); virtual;
@@ -842,7 +843,6 @@ type
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
-    procedure Set_InlineTypeExpr_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_FileType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
@@ -948,10 +948,10 @@ type
     procedure ReadRecordValues(Obj: TJSONObject; Expr: TRecordValues; aContext: TPCUReaderContext); virtual;
     procedure ReadArrayValues(Obj: TJSONObject; Expr: TArrayValues; aContext: TPCUReaderContext); virtual;
     procedure ReadResString(Obj: TJSONObject; El: TPasResString; aContext: TPCUReaderContext); virtual;
+    procedure ReadGenericTemplateTypes(Obj: TJSONObject; Parent: TPasElement; var GenericTemplateTypes: TFPList; aContext: TPCUReaderContext); virtual;
     procedure ReadAliasType(Obj: TJSONObject; El: TPasAliasType; aContext: TPCUReaderContext); virtual;
     procedure ReadPointerType(Obj: TJSONObject; El: TPasPointerType; aContext: TPCUReaderContext); virtual;
     procedure ReadSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUReaderContext); virtual;
-    procedure ReadInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr; aContext: TPCUReaderContext); virtual;
     procedure ReadInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext); virtual;
     procedure ReadRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUReaderContext); virtual;
     procedure ReadArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUReaderContext); virtual;
@@ -989,6 +989,7 @@ type
     procedure ReadPropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUReaderContext); virtual;
     procedure ReadProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUReaderContext); virtual;
     procedure ReadMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUReaderContext); virtual;
+    procedure ReadProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     function ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
       const PropName: string; const DefaultValue: TProcedureModifiers): TProcedureModifiers; virtual;
     function ReadProcScopeFlags(Obj: TJSONObject; El: TPasElement;
@@ -3277,6 +3278,28 @@ begin
   WriteExpr(Obj,El,'Expr',El.Expr,aContext);
 end;
 
+procedure TPCUWriter.WriteGenericTemplateTypes(Obj: TJSONObject;
+  Parent: TPasElement; GenericTemplateTypes: TFPList;
+  aContext: TPCUWriterContext);
+var
+  Arr: TJSONArray;
+  i: Integer;
+  Templ: TPasGenericTemplateType;
+  TemplObj: TJSONObject;
+begin
+  if (GenericTemplateTypes=nil) or (GenericTemplateTypes.Count=0) then exit;
+  Arr:=TJSONArray.Create;
+  Obj.Add('GenericTemplateTypes',Arr);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    begin
+    Templ:=TPasGenericTemplateType(GenericTemplateTypes[i]);
+    TemplObj:=TJSONObject.Create;
+    Arr.Add(TemplObj);
+    TemplObj.Add('Name',Templ.Name);
+    WritePasExprArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext);
+    end;
+end;
+
 procedure TPCUWriter.WriteAliasType(Obj: TJSONObject; El: TPasAliasType;
   aContext: TPCUWriterContext);
 begin
@@ -3299,17 +3322,12 @@ begin
   WriteElementList(Obj,El,'Params',El.Params,aContext);
 end;
 
-procedure TPCUWriter.WriteInlineTypeExpr(Obj: TJSONObject; Expr: TInlineTypeExpr;
-  aContext: TPCUWriterContext);
-begin
-  WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
-  WriteElType(Obj,Expr,'Dest',Expr.DestType,aContext);
-end;
-
 procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
 begin
-  WriteInlineTypeExpr(Obj,Expr,aContext);
+  WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
+  WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
+  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -3323,6 +3341,7 @@ procedure TPCUWriter.WriteArrayType(Obj: TJSONObject; El: TPasArrayType;
   aContext: TPCUWriterContext);
 begin
   WritePasElement(Obj,El,aContext);
+  WriteGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   WritePasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
@@ -3386,6 +3405,7 @@ procedure TPCUWriter.WriteRecordType(Obj: TJSONObject; El: TPasRecordType;
   aContext: TPCUWriterContext);
 begin
   WritePasElement(Obj,El,aContext);
+  WriteGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
   WriteElementList(Obj,El,'Members',El.Members,aContext);
@@ -3538,6 +3558,7 @@ var
   Scope: TPas2JSClassScope;
 begin
   WritePasElement(Obj,El,aContext);
+  WriteGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
   // ObjKind is the 'Type'
@@ -3729,6 +3750,43 @@ begin
   WriteExpr(Obj,El,'ImplementationProc',El.ImplementationProc,aContext);
 end;
 
+procedure TPCUWriter.WriteProcedureNameParts(Obj: TJSONObject;
+  El: TPasProcedure; aContext: TPCUWriterContext);
+var
+  Arr, TemplArr: TJSONArray;
+  NamePartObj, TemplObj: TJSONObject;
+  i, j: Integer;
+  GenType: TPasGenericTemplateType;
+  NameParts: TProcedureNameParts;
+begin
+  NameParts:=El.NameParts;
+  if length(NameParts)=0 then exit;
+  Arr:=TJSONArray.Create;
+  Obj.Add('NameParts',Arr);
+  for i:=0 to length(NameParts)-1 do
+    begin
+    NamePartObj:=TJSONObject.Create;
+    Arr.Add(NamePartObj);
+    with NameParts[i] do
+      begin
+      NamePartObj.Add('Name',Name);
+      if Templates<>nil then
+        begin
+        TemplArr:=TJSONArray.Create;
+        NamePartObj.Add('Templates',TemplArr);
+        for j:=0 to Templates.Count-1 do
+          begin
+          GenType:=TPasGenericTemplateType(Templates[j]);
+          TemplObj:=TJSONObject.Create;
+          TemplArr.Add(TemplObj);
+          TemplObj.Add('Name',GenType.Name);
+          WritePasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          end;
+        end;
+      end;
+    end;
+end;
+
 procedure TPCUWriter.WriteProcedureModifiers(Obj: TJSONObject;
   const PropName: string; const Value, DefaultValue: TProcedureModifiers);
 var
@@ -3791,6 +3849,8 @@ begin
   //writeln('TPCUWriter.WriteProcedure ',GetObjName(El),' ',GetObjName(Scope),' ',Resolver.GetElementSourcePosStr(El));
   if Scope.DeclarationProc=nil then
     begin
+    // declaration
+    WriteProcedureNameParts(Obj,El,aContext);
     WriteElementProperty(Obj,El,'ProcType',El.ProcType,aContext);
     WriteExpr(Obj,El,'Public',El.PublicName,aContext);
     // e.g. external LibraryExpr name LibrarySymbolName;
@@ -3812,6 +3872,7 @@ begin
     end
   else
     begin
+    // implementation
     AddReferenceToObj(Obj,'DeclarationProc',Scope.DeclarationProc);
     end;
 
@@ -4186,21 +4247,6 @@ begin
     RaiseMsg(20180211121757,El,GetObjName(RefEl));
 end;
 
-procedure TPCUReader.Set_InlineTypeExpr_DestType(RefEl: TPasElement;
-  Data: TObject);
-var
-  El: TInlineTypeExpr absolute Data;
-begin
-  if RefEl is TPasType then
-    begin
-    El.DestType:=TPasType(RefEl);
-    if RefEl.Parent<>El then
-      RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TInlineTypeExpr.DestType'){$ENDIF};
-    end
-  else
-    RaiseMsg(20180211121750,El,GetObjName(RefEl));
-end;
-
 procedure TPCUReader.Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
 var
   El: TPasArrayType absolute Data;
@@ -6608,6 +6654,30 @@ begin
   El.Expr:=ReadExpr(Obj,El,'Expr',aContext);
 end;
 
+procedure TPCUReader.ReadGenericTemplateTypes(Obj: TJSONObject;
+  Parent: TPasElement; var GenericTemplateTypes: TFPList;
+  aContext: TPCUReaderContext);
+var
+  TemplArr: TJSONArray;
+  i: Integer;
+  TemplObj: TJSONObject;
+  GenTypeName: string;
+  GenType: TPasGenericTemplateType;
+begin
+  if not ReadArray(Obj,'GenericTemplateTypes',TemplArr,Parent) then exit;
+  if GenericTemplateTypes=nil then
+    GenericTemplateTypes:=TFPList.Create;
+  for i:=0 to TemplArr.Count-1 do
+    begin
+    TemplObj:=CheckJSONObject(TemplArr[i],20190720224105);
+    if not ReadString(TemplObj,'Name',GenTypeName,Parent) or (GenTypeName='') then
+      RaiseMsg(20190720224130,Parent,IntToStr(i));
+    GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,Parent));
+    GenericTemplateTypes.Add(GenType);
+    ReadPasExprArray(TemplObj,Parent,'Constraints',GenType.Constraints,aContext);
+    end;
+end;
+
 procedure TPCUReader.ReadAliasType(Obj: TJSONObject; El: TPasAliasType;
   aContext: TPCUReaderContext);
 begin
@@ -6632,18 +6702,14 @@ begin
     aContext);
 end;
 
-procedure TPCUReader.ReadInlineTypeExpr(Obj: TJSONObject;
-  Expr: TInlineTypeExpr; aContext: TPCUReaderContext);
-begin
-  ReadPasExpr(Obj,Expr,Expr.Kind,aContext);
-  ReadElType(Obj,'Dest',Expr,@Set_InlineTypeExpr_DestType,aContext);
-end;
-
 procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
 begin
   Expr.Kind:=pekSpecialize;
-  ReadInlineTypeExpr(Obj,Expr,aContext);
+  Expr.NameExpr:=ReadExpr(Obj,Expr,'Name',aContext);
+  ReadElementList(Obj,Expr,'Params',Expr.Params,
+    {$IFDEF CheckPasTreeRefCount}'TPasSpecializeType.Params'{$ELSE}true{$ENDIF},
+    aContext);
 end;
 
 procedure TPCUReader.ReadRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -6668,6 +6734,7 @@ procedure TPCUReader.ReadArrayType(Obj: TJSONObject; El: TPasArrayType;
   aContext: TPCUReaderContext);
 begin
   ReadPasElement(Obj,El,aContext);
+  ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   ReadPasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
@@ -6763,6 +6830,7 @@ begin
   El.CustomData:=Scope;
 
   ReadPasElement(Obj,El,aContext);
+  ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   El.PackMode:=ReadPackedMode(Obj,'Packed',El);
   ReadElementList(Obj,El,'Members',El.Members,
     {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Members'{$ELSE}true{$ENDIF},
@@ -7079,6 +7147,7 @@ begin
     end;
 
   ReadPasElement(Obj,El,aContext);
+  ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   El.PackMode:=ReadPackedMode(Obj,'Packed',El);
   // ObjKind is the 'Type'
 
@@ -7392,6 +7461,44 @@ begin
   El.ImplementationProc:=ReadExpr(Obj,El,'ImplementationProc',aContext);
 end;
 
+procedure TPCUReader.ReadProcedureNameParts(Obj: TJSONObject;
+  El: TPasProcedure; aContext: TPCUReaderContext);
+var
+  Arr, TemplArr: TJSONArray;
+  i, j: Integer;
+  NamePartObj, TemplObj: TJSONObject;
+  GenTypeName: string;
+  GenType: TPasGenericTemplateType;
+begin
+  ReleaseProcNameParts(El.NameParts);
+  if ReadArray(Obj,'NameParts',Arr,El) then
+    begin
+    SetLength(El.NameParts,Arr.Count);
+    for i:=0 to Arr.Count-1 do
+      begin
+      NamePartObj:=CheckJSONObject(Arr[i],20190718113441);
+      with El.NameParts[i] do
+        begin
+        if not ReadString(NamePartObj,'Name',Name,El) then
+          RaiseMsg(20190718113739,El,IntToStr(i));
+        if not ReadArray(NamePartObj,'Templates',TemplArr,El) then
+          continue; // Templates=nil
+        Templates:=TFPList.Create;
+        for j:=0 to TemplArr.Count-1 do
+          begin
+          TemplObj:=CheckJSONObject(TemplArr[j],20190718114058);
+          if not ReadString(TemplObj,'Name',GenTypeName,El) or (GenTypeName='') then
+            RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
+          GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
+          Templates.Add(GenType);
+          ReadPasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          end;
+        end;
+      end;
+    end;
+  if aContext=nil then ;
+end;
+
 function TPCUReader.ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
   const PropName: string; const DefaultValue: TProcedureModifiers
   ): TProcedureModifiers;
@@ -7588,6 +7695,7 @@ begin
   else
     begin
     // declarationproc
+    ReadProcedureNameParts(Obj,El,aContext);
     El.PublicName:=ReadExpr(Obj,El,'Public',aContext);
     // e.g. external LibraryExpr name LibrarySymbolName;
     El.LibraryExpr:=ReadExpr(Obj,El,'Lib',aContext);

packages/pastojs/src/pas2jsresstrfile.pp

@@ -0,0 +1,146 @@
+unit pas2jsresstrfile;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpJSON;
+
+Type
+
+  { TResourceStringsFile }
+  EResourceStringsFile = Class(Exception);
+
+  TResourceStringsFile = Class(TObject)
+  Private
+    FCurrentUnit: TJSONStringType;
+    FStrings : TJSONObject;
+    FUnit : TJSONObject;
+    function GetStringsCount: Integer;
+    function GetUnitCount: Integer;
+    function GetUnitStringsCount: Integer;
+  Protected
+    property Strings : TJSONObject Read FStrings;
+    property CurrUnit : TJSONObject Read FUnit;
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
+    Procedure Clear;
+    Procedure ClearUnit;
+    Procedure StartUnit(Const aUnitName : TJSONStringType);
+    Procedure AddString(Const aName,aValue : TJSONStringType); overload;
+    Procedure AddString(Const aUnit,aName,aValue : TJSONStringType); overload;
+    Function toString : String; override;
+    Function AsString : TJSONStringType;
+    Property CurrentUnit : TJSONStringType Read FCurrentUnit;
+    Property UnitCount : Integer Read GetUnitCount;
+    Property StringsCount : Integer Read GetStringsCount;
+    Property CurrentUnitStringsCount : Integer Read GetUnitStringsCount;
+  end;
+
+
+implementation
+
+Resourcestring
+   SErrNoCurrentUnit = 'No current unit.';
+   SErrInvalidUnitName = 'Invalid unit name: "%s"';
+   SErrInvalidStringName = 'Invalid TJSONStringType name: "%s"';
+
+{ TResourceStringsFile }
+
+function TResourceStringsFile.GetStringsCount: Integer;
+
+Var
+  I : Integer;
+
+begin
+  Result:=0;
+  For I:=0 to FStrings.Count-1 do
+    Result:=Result+TJSONObject(FStrings.Items[i]).Count;
+end;
+
+function TResourceStringsFile.GetUnitCount: Integer;
+begin
+  Result:=FStrings.Count;
+end;
+
+function TResourceStringsFile.GetUnitStringsCount: Integer;
+begin
+  if Assigned(FUnit) then
+    Result:=FUnit.Count
+  else
+    Result:=0;
+end;
+
+constructor TResourceStringsFile.Create;
+begin
+  FStrings:=TJSONObject.Create;
+  FUnit:=nil;
+end;
+
+destructor TResourceStringsFile.Destroy;
+begin
+  FUnit:=nil;
+  FreeAndNil(FStrings);
+  inherited Destroy;
+end;
+
+procedure TResourceStringsFile.Clear;
+begin
+  FStrings.Clear;
+end;
+
+procedure TResourceStringsFile.ClearUnit;
+begin
+  If Assigned(FUnit) then
+    FUnit.Clear;
+end;
+
+procedure TResourceStringsFile.StartUnit(const aUnitName: TJSONStringType);
+
+Var
+  I : Integer;
+
+begin
+  if aUnitName=FCurrentUnit then exit;
+  if not IsValidIdent(aUnitName,True,True) then
+     Raise EResourceStringsFile.CreateFmt(SErrInvalidUnitName,[aUnitName]);
+  I:=FStrings.IndexOfName(aUnitName);
+  if (I<>-1) then
+    FUnit:=FStrings.Items[i] as TJSONObject
+  else
+    begin
+    FUnit:=TJSONObject.Create;
+    FStrings.Add(aUnitName,FUnit);
+    end;
+  FCurrentUnit:=aUnitName;
+end;
+
+procedure TResourceStringsFile.AddString(const aName, aValue: TJSONStringType);
+begin
+  if not IsValidIdent(aName,False,False) then
+    Raise EResourceStringsFile.CreateFmt(SErrInvalidStringName,[aName]);
+  if (FUnit=Nil) then
+    Raise EResourceStringsFile.Create(SErrNoCurrentUnit);
+  FUnit.Add(aName,aValue);
+end;
+
+procedure TResourceStringsFile.AddString(const aUnit, aName, aValue: TJSONStringType);
+begin
+  StartUnit(aUnit);
+  AddString(aName,aValue);
+end;
+
+function TResourceStringsFile.toString: String;
+begin
+  Result:=AsString;
+end;
+
+function TResourceStringsFile.AsString: TJSONStringType;
+begin
+  Result:=FStrings.FormatJSON();
+end;
+
+end.
+

packages/pastojs/tests/tcfiler.pas

@@ -119,6 +119,7 @@ type
     procedure CheckRestoredConst(const Path: string; Orig, Rest: TPasConst); virtual;
     procedure CheckRestoredProperty(const Path: string; Orig, Rest: TPasProperty); virtual;
     procedure CheckRestoredMethodResolution(const Path: string; Orig, Rest: TPasMethodResolution); virtual;
+    procedure CheckRestoredProcNameParts(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
     procedure CheckRestoredAttributes(const Path: string; Orig, Rest: TPasAttributes); virtual;
@@ -161,6 +162,7 @@ type
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
+    procedure TestPC_ClassDestructor;
     procedure TestPC_ClassDispatchMessage;
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
@@ -1358,7 +1360,8 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredInlineSpecializedExpr(
   const Path: string; Orig, Rest: TInlineSpecializeExpr);
 begin
-  CheckRestoredElOrRef(Path+'.DestType',Orig,Orig.DestType,Rest,Rest.DestType);
+  CheckRestoredElement(Path+'.NameExpr',Orig.NameExpr,Rest.NameExpr);
+  CheckRestoredElementList(Path+'.Params',Orig.Params,Rest.Params);
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredRangeType(const Path: string;
@@ -1371,6 +1374,7 @@ procedure TCustomTestPrecompile.CheckRestoredArrayType(const Path: string;
   Orig, Rest: TPasArrayType);
 begin
   CheckRestoredPasExprArray(Path+'.Ranges',Orig.Ranges,Rest.Ranges);
+  CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
   if Orig.PackMode<>Rest.PackMode then
     Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
   CheckRestoredElOrRef(Path+'.ElType',Orig,Orig.ElType,Rest,Rest.ElType);
@@ -1411,6 +1415,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredRecordType(const Path: string;
   Orig, Rest: TPasRecordType);
 begin
+  CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
   if Orig.PackMode<>Rest.PackMode then
     Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
   CheckRestoredElementList(Path+'.Members',Orig.Members,Rest.Members);
@@ -1422,6 +1427,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredClassType(const Path: string;
   Orig, Rest: TPasClassType);
 begin
+  CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
   if Orig.PackMode<>Rest.PackMode then
     Fail(Path+'.PackMode Orig='+PCUPackModeNames[Orig.PackMode]+' Rest='+PCUPackModeNames[Rest.PackMode]);
   if Orig.ObjKind<>Rest.ObjKind then
@@ -1533,6 +1539,29 @@ begin
   CheckRestoredElement(Path+'.ImplementationProc',Orig.ImplementationProc,Rest.ImplementationProc);
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredProcNameParts(const Path: string;
+  Orig, Rest: TPasProcedure);
+var
+  OrigNameParts, RestNameParts: TProcedureNameParts;
+  i: Integer;
+  SubPath: String;
+  OrigTemplates, RestTemplates: TFPList;
+begin
+  OrigNameParts:=Orig.NameParts;
+  RestNameParts:=Rest.NameParts;
+  AssertEquals(Path+'.NameParts length',length(OrigNameParts),length(RestNameParts));
+  for i:=0 to length(OrigNameParts)-1 do
+    begin
+    SubPath:=Path+'.NameParts['+IntToStr(i)+']';
+    AssertEquals(SubPath+'.Name',OrigNameParts[i].Name,RestNameParts[i].Name);
+    OrigTemplates:=OrigNameParts[i].Templates;
+    RestTemplates:=RestNameParts[i].Templates;
+    CheckRestoredObject(SubPath+'.Templates',OrigTemplates,RestTemplates);
+    if OrigTemplates=nil then continue;
+    CheckRestoredElementList(SubPath+'.Templates',OrigTemplates,RestTemplates);
+    end;
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredProcedure(const Path: string;
   Orig, Rest: TPasProcedure);
 var
@@ -1548,6 +1577,7 @@ begin
   AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName',OrigScope.ResultVarName,RestScope.ResultVarName);
   if RestScope.DeclarationProc=nil then
     begin
+    CheckRestoredProcNameParts(Path,Orig,Rest);
     CheckRestoredElement(Path+'.ProcType',Orig.ProcType,Rest.ProcType);
     CheckRestoredElement(Path+'.PublicName',Orig.PublicName,Rest.PublicName);
     CheckRestoredElement(Path+'.LibrarySymbolName',Orig.LibrarySymbolName,Rest.LibrarySymbolName);
@@ -2146,6 +2176,37 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_ClassDestructor;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '    destructor Destroy; virtual;',
+  '  end;',
+  '  TBird = class',
+  '    destructor Destroy; override;',
+  '  end;',
+  'procedure DoIt;',
+  'implementation',
+  'destructor TObject.Destroy;',
+  'begin',
+  'end;',
+  'destructor TBird.Destroy;',
+  'begin',
+  '  inherited;',
+  'end;',
+  'procedure DoIt;',
+  'var b: TBird;',
+  'begin',
+  '  b.Destroy;',
+  'end;',
+  'end.'
+  ]);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_ClassDispatchMessage;
 begin
   StartUnit(false);

packages/pastojs/tests/tcmodules.pas

@@ -335,6 +335,7 @@ type
     Procedure TestProc_ConstOrder;
     Procedure TestProc_DuplicateConst;
     Procedure TestProc_LocalVarAbsolute;
+    Procedure TestProc_LocalVarInit;
     Procedure TestProc_ReservedWords;
 
     // anonymous functions
@@ -347,6 +348,7 @@ type
     Procedure TestAnonymousProc_Nested;
     Procedure TestAnonymousProc_NestedAssignResult;
     Procedure TestAnonymousProc_Class;
+    Procedure TestAnonymousProc_ForLoop;
 
     // enums, sets
     Procedure TestEnum_Name;
@@ -785,6 +787,7 @@ type
     Procedure TestRTTI_DefaultValueRangeType;
     Procedure TestRTTI_DefaultValueInherit;
     Procedure TestRTTI_OverrideMethod;
+    Procedure TestRTTI_ReintroduceMethod;
     Procedure TestRTTI_OverloadProperty;
     // ToDo: array argument
     Procedure TestRTTI_ClassForward;
@@ -4337,6 +4340,36 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_LocalVarInit;
+begin
+  StartProgram(false);
+  Add([
+  'type TBytes = array of byte;',
+  'procedure DoIt;',
+  'const c = 4;',
+  'var',
+  '  b: byte = 1;',
+  '  w: word = 2+c;',
+  '  p: pointer = nil;',
+  '  Buffer: TBytes = nil;',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestProc_LocalVarInit',
+    LinesToStr([ // statements
+    'var c = 4;',
+    'this.DoIt = function () {',
+    '  var b = 1;',
+    '  var w = 2 + 4;',
+    '  var p = null;',
+    '  var Buffer = [];',
+    '};',
+    '']),
+    LinesToStr([
+    ]));
+end;
+
 procedure TTestModule.TestProc_ReservedWords;
 begin
   StartProgram(false);
@@ -4766,15 +4799,21 @@ begin
   Add([
   'type',
   '  TProc = reference to procedure;',
+  '  TEvent = procedure of object;',
   '  TObject = class',
   '    Size: word;',
   '    function GetIt: TProc;',
+  '    procedure DoIt; virtual; abstract;',
   '  end;',
   'function TObject.GetIt: TProc;',
   'begin',
   '  Result:=procedure',
+  '    var p: TEvent;',
   '    begin',
   '      Size:=Size;',
+  '      Size:=Self.Size;',
+  '      p:=@DoIt;',
+  '      p:[email protected];',
   '    end;',
   'end;',
   'begin']);
@@ -4791,7 +4830,11 @@ begin
     '    var $Self = this;',
     '    var Result = null;',
     '    Result = function () {',
+    '      var p = null;',
+    '      $Self.Size = $Self.Size;',
     '      $Self.Size = $Self.Size;',
+    '      p = rtl.createCallback($Self, "DoIt");',
+    '      p = rtl.createCallback($Self, "DoIt");',
     '    };',
     '    return Result;',
     '  };',
@@ -4801,6 +4844,44 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestAnonymousProc_ForLoop;
+begin
+  StartProgram(false);
+  Add([
+  'type TProc = reference to procedure;',
+  'procedure Foo(p: TProc);',
+  'begin',
+  'end;',
+  'procedure DoIt;',
+  'var i: word;',
+  '  a: word;',
+  'begin',
+  '  for i:=1 to 10 do begin',
+  '    Foo(procedure begin a:=3; end);',
+  '  end;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_ForLoop',
+    LinesToStr([ // statements
+    'this.Foo = function (p) {',
+    '};',
+    'this.DoIt = function () {',
+    '  var i = 0;',
+    '  var a = 0;',
+    '  for (i = 1; i <= 10; i++) {',
+    '    $mod.Foo(function () {',
+    '      a = 3;',
+    '    });',
+    '  };',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();'
+    ]));
+end;
+
 procedure TTestModule.TestEnum_Name;
 begin
   StartProgram(false);
@@ -5832,6 +5913,7 @@ begin
   '  if c in [''a''..''z'',''_''] then ;',
   '  if ''b'' in [''a''..''z'',''_''] then ;',
   '  if ''Я'' in sc then ;',
+  '  if 3=ord('' '') then ;',
   '']);
   ConvertProgram;
   CheckSource('TestSet_ConstChar',
@@ -5850,6 +5932,7 @@ begin
     'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
     'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
     'if (1071 in $mod.sc) ;',
+    'if (3 === 32) ;',
     '']));
 end;
 
@@ -8173,7 +8256,8 @@ end;
 procedure TTestModule.TestArray_Dynamic;
 begin
   StartProgram(false);
-  Add(['type',
+  Add([
+  'type',
   '  TArrayInt = array of longint;',
   'var',
   '  Arr: TArrayInt;',
@@ -9039,19 +9123,25 @@ begin
   Add([
   'type',
   '  TArrArrInt = array of array of longint;',
+  '  TArrStaInt = array of array[1..2] of longint;',
   'var',
   '  a: TArrArrInt;',
+  '  b: TArrStaInt;',
   'begin',
   '  SetLength(a,2);',
   '  SetLength(a,3,4);',
+  '  SetLength(b,5);',
   '']);
   ConvertProgram;
   CheckSource('TestArray_SetLengthMultiDim',
     LinesToStr([ // statements
-    'this.a = [];']),
+    'this.a = [];',
+    'this.b = [];',
+    '']),
     LinesToStr([
     '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
     '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
+    '$mod.b = rtl.arraySetLength($mod.b, 0, 5, 2);',
     '']));
 end;
 
@@ -9628,10 +9718,15 @@ begin
   '  public',
   '    Property LongMonthNames : TMonthNames Read GetLongMonthNames;',
   '  end;',
-  'var f: TObject;',
+  'var',
+  '  f: TObject;',
   '  Month: string;',
+  '  Names: array of string = (''a'',''foo'',''bar'');',
+  '  i: longint;',
   'begin',
   '  for Month in f.LongMonthNames do ;',
+  '  for Month in Names do ;',
+  '  for i:=low(Names) to high(Names) do ;',
   '']);
   ConvertProgram;
   CheckSource('TestArray_ForInArrOfString',
@@ -9644,9 +9739,13 @@ begin
     '});',
     'this.f = null;',
     'this.Month = "";',
+    'this.Names = ["a", "foo", "bar"];',
+    'this.i = 0;',
     '']),
     LinesToStr([ // $mod.$main
     'for (var $in1 = $mod.f.GetLongMonthNames(), $l2 = 0, $end3 = rtl.length($in1) - 1; $l2 <= $end3; $l2++) $mod.Month = $in1[$l2];',
+    'for (var $in4 = $mod.Names, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) $mod.Month = $in4[$l5];',
+    'for (var $l7 = 0, $end8 = rtl.length($mod.Names) - 1; $l7 <= $end8; $l7++) $mod.i = $l7;',
     '']));
 end;
 
@@ -10806,8 +10905,9 @@ begin
   '{$modeswitch AdvancedRecords}',
   'type',
   '  TRec = record',
-  '    class var Fx: longint;',
-  '    class var Fy: longint;',
+  '    class var',
+  '      Fx: longint;',
+  '      Fy: longint;',
   '    class function GetInt: longint; static;',
   '    class procedure SetInt(Value: longint); static;',
   '    class procedure DoIt; static;',
@@ -27079,8 +27179,8 @@ begin
   Add('    procedure Proc(Sender: tobject); virtual; abstract;');
   Add('  end;');
   Add('begin');
-  SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,19)',
-    nDuplicateIdentifier);
+  SetExpectedPasResolverError('Duplicate published method "Proc" at test1.pp(6,19)',
+    nDuplicatePublishedMethodXAtY);
   ConvertProgram;
 end;
 
@@ -27963,6 +28063,51 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_ReintroduceMethod;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  published',
+  '    procedure DoIt;',
+  '  end;',
+  '  TSky = class',
+  '  published',
+  '    procedure DoIt; reintroduce;',
+  '  end;',
+  'procedure TObject.DoIt; begin end;',
+  'procedure TSky.DoIt;',
+  'begin',
+  '  inherited DoIt;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestRTTI_ReintroduceMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("DoIt", 0, null);',
+    '});',
+    'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
+    '  this.DoIt = function () {',
+    '    $mod.TObject.DoIt.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("DoIt", 0, null);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_OverloadProperty;
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];

utils/pas2js/dist/rtl.js

@@ -797,6 +797,37 @@ var rtl = {
   },
 
   arraySetLength: function(arr,defaultvalue,newlength){
+    // multi dim: (arr,defaultvalue,dim1,dim2,...)
+    var p = arguments;
+    function setLength(src,argNo){
+      var newlen = p[argNo];
+      var a = [];
+      a.length = newlength;
+      if (argNo === p.length-1){
+        var oldlen = src?src.length:0;
+        if (rtl.isArray(defaultvalue)){
+          for (var i=0; i<newlen; i++) a[i]=(i<oldlen)?src[i]:[]; // array of dyn array
+        } else if (rtl.isObject(defaultvalue)) {
+          if (rtl.isTRecord(defaultvalue)){
+            for (var i=0; i<newlen; i++)
+              a[i]=(i<oldlen)?defaultvalue.$clone(src[i]):defaultvalue.$new(); // e.g. record
+          } else {
+            for (var i=0; i<newlen; i++) a[i]=(i<oldlen)?rtl.refSet(src[i]):{}; // e.g. set
+          }
+        } else {
+          for (var i=0; i<newlen; i++)
+            a[i]=(i<oldlen)?src[i]:defaultvalue;
+        }
+      } else {
+        // multi dim array
+        for (var i=0; i<newlen; i++) a[i]=setLength(src?src[i]:null,argNo+1);
+      }
+      return a;
+    }
+    return setLength(arr,2);
+  },
+
+  /*arrayChgLength: function(arr,defaultvalue,newlength){
     // multi dim: (arr,defaultvalue,dim1,dim2,...)
     if (arr == null) arr = [];
     var p = arguments;
@@ -828,7 +859,7 @@ var rtl = {
       return a;
     }
     return setLength(arr,2);
-  },
+  },*/
 
   arrayEq: function(a,b){
     if (a===null) return b===null;

utils/pas2js/docs/translation.html

@@ -2955,9 +2955,10 @@ End.
     type, not of its current runtime value. The exception is a class and class-of instance
     variable (e.g. <i>var o: TObject; ... typeinfo(o)</i>), which returns the
     typeinfo of the current runtime value.
-    If <i>o</i> is <i>null</i> it will give a JS error.<br>
+    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>
     </div>