# revisions: 45563,45574,45586,45587,45588,45589,45610,45611,45615,45625,45626,45634,45639,45640,45650,45653,45660,45697,45700,45701

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

.gitattributes

@@ -8657,7 +8657,9 @@ packages/rtl-generics/tests/tests.generics.arrayhelper.pas svneol=native#text/pa
 packages/rtl-generics/tests/tests.generics.bugs.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.dictionary.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.hashmaps.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.queue.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.sets.pas svneol=native#text/pascal
+packages/rtl-generics/tests/tests.generics.stack.pas svneol=native#text/plain
 packages/rtl-generics/tests/tests.generics.stdcollections.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.trees.pas svneol=native#text/pascal
 packages/rtl-generics/tests/tests.generics.utils.pas svneol=native#text/pascal

packages/fcl-js/src/jstree.pp

@@ -975,6 +975,7 @@ Type
     function GetN(AIndex : Integer): TJSElementNode;
   Public
     Function AddNode : TJSElementNode;
+    Function InsertNode(Index: integer) : TJSElementNode;
     Property Nodes[AIndex : Integer] : TJSElementNode Read GetN ; default;
   end;
 
@@ -1937,6 +1938,11 @@ begin
   Result:=TJSElementNode(Add);
 end;
 
+function TJSElementNodes.InsertNode(Index: integer): TJSElementNode;
+begin
+  Result:=TJSElementNode(Insert(Index));
+end;
+
 { TJSFunction }
 
 destructor TJSFunctionDeclarationStatement.Destroy;

packages/fcl-passrc/src/pasresolver.pp

@@ -1758,8 +1758,8 @@ type
       MaxCount: integer; RaiseOnError: boolean; Signature: string = ''): integer;
     function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
       const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
-    function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
-    function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
+    function FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
+    function FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
     procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr); virtual;
     function FindSystemClassType(const aUnitName, aClassName: string;
@@ -2366,7 +2366,9 @@ type
     function GetCombinedBaseType(const A, B: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function IsElementSkipped(El: TPasElement): boolean; virtual;
     function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
+    function GetFirstSection(WithUnitImpl: boolean): TPasSection;
     function GetLastSection: TPasSection;
+    function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
     function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
       isLoFunc: Boolean; out Mask: LongWord): Integer;
   public
@@ -14792,7 +14794,7 @@ begin
   Result:=cIncompatible;
 end;
 
-function TPasResolver.FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
+function TPasResolver.FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
 var
   Clause: TPasUsesClause;
   i: Integer;
@@ -14812,20 +14814,20 @@ begin
     end;
 end;
 
-function TPasResolver.FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
+function TPasResolver.FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
 var
   C: TClass;
 begin
   C:=aMod.ClassType;
   if C.InheritsFrom(TPasProgram) then
-    Result:=FindUsedUnitInSection(aName,TPasProgram(aMod).ProgramSection)
+    Result:=FindUsedUnitnameInSection(aName,TPasProgram(aMod).ProgramSection)
   else if C.InheritsFrom(TPasLibrary) then
-    Result:=FindUsedUnitInSection(aName,TPasLibrary(aMod).LibrarySection)
+    Result:=FindUsedUnitnameInSection(aName,TPasLibrary(aMod).LibrarySection)
   else
     begin
-    Result:=FindUsedUnitInSection(aName,aMod.InterfaceSection);
+    Result:=FindUsedUnitnameInSection(aName,aMod.InterfaceSection);
     if Result<>nil then exit;
-    Result:=FindUsedUnitInSection(aName,aMod.ImplementationSection);
+    Result:=FindUsedUnitnameInSection(aName,aMod.ImplementationSection);
     end
 end;
 
@@ -14862,7 +14864,7 @@ begin
 
   // find unit in uses clauses
   aMod:=RootElement;
-  UtilsMod:=FindUsedUnit(aUnitName,aMod);
+  UtilsMod:=FindUsedUnitname(aUnitName,aMod);
   if UtilsMod=nil then
     if ErrorEl<>nil then
       RaiseIdentifierNotFound(20200523224738,'unit '+aUnitName,ErrorEl)
@@ -15020,7 +15022,7 @@ begin
   if Result<>nil then exit;
 
   // find unit in uses clauses
-  UtilsMod:=FindUsedUnit('system',aMod);
+  UtilsMod:=FindUsedUnitname('system',aMod);
   if UtilsMod=nil then
     RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
 
@@ -16411,10 +16413,7 @@ var
       writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
       //for i:=0 to List.Count-1 do writeln('  ',GetObjName(TObject(List[i])));
       {$ENDIF}
-      if GenericEl is TPasProcedure then
-        i:=List.Count-1
-      else
-        RaiseNotYetImplemented(20190826150507,El);
+      i:=List.Count-1;
       end;
     List.Insert(i+1,NewEl);
   end;
@@ -25130,7 +25129,7 @@ function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): str
           Result:=Result+'<';
           for i:=0 to length(Params)-1 do
             begin
-            Result:=Result+GetTypeDescription(Params[i]);
+            Result:=Result+GetTypeDescription(Params[i],AddPath);
             if i>0 then
               Result:=Result+',';
             end;
@@ -28035,7 +28034,7 @@ var
 begin
   Result:=false;
   if aClass=nil then exit;
-  while (aClass<>nil) and aClass.IsExternal do
+  while aClass<>nil do
     begin
     if aClass.ExternalName=ExtName then exit(true);
     AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
@@ -29156,6 +29155,25 @@ begin
     Result:=nil;
 end;
 
+function TPasResolver.GetFirstSection(WithUnitImpl: boolean): TPasSection;
+var
+  Module: TPasModule;
+begin
+  Result:=nil;
+  Module:=RootElement;
+  if Module=nil then exit;
+  if Module is TPasProgram then
+    Result:=TPasProgram(Module).ProgramSection
+  else if Module is TPasLibrary then
+    Result:=TPasLibrary(Module).LibrarySection
+  else
+    begin
+    Result:=Module.InterfaceSection;
+    if WithUnitImpl and (Result=nil) then
+      Result:=Module.ImplementationSection;
+    end;
+end;
+
 function TPasResolver.GetLastSection: TPasSection;
 var
   Module: TPasModule;
@@ -29173,6 +29191,19 @@ begin
     Result:=Module.InterfaceSection;
 end;
 
+function TPasResolver.FindUsedUnitInSection(aMod: TPasModule;
+  Section: TPasSection): TPasUsesUnit;
+var
+  Clause: TPasUsesClause;
+  i: Integer;
+begin
+  Result:=nil;
+  if Section=nil then exit;
+  Clause:=Section.UsesClause;
+  for i:=0 to length(Clause)-1 do
+    if Clause[i].Module=aMod then exit(Clause[i]);
+end;
+
 function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
   isLoFunc: Boolean; out Mask: LongWord): Integer;
 const

packages/fcl-passrc/src/pparser.pp

@@ -4428,8 +4428,10 @@ var
   ArrEl: TPasArrayType;
   i: Integer;
   AObjKind: TPasObjKind;
+  ok: Boolean;
 begin
   Result:=nil;
+  ok := false;
   TypeName := CurTokenString;
   NamePos := CurSourcePos;
   TypeParams:=TFPList.Create;
@@ -4510,7 +4512,10 @@ begin
     else
       ParseExcTypeParamsNotAllowed;
     end;
+    ok:=true;
   finally
+    if (not ok) and (Result<>nil) and not AddToParent then
+      Result.Release({$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF});
     for i:=0 to TypeParams.Count-1 do
       TPasElement(TypeParams[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
     TypeParams.Free;

packages/fcl-passrc/src/pscanner.pp

@@ -821,6 +821,8 @@ type
     procedure HandleMessageDirective(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleResource(Param : string); virtual;
+    procedure HandleOptimizations(Param : string); virtual;
+    procedure DoHandleOptimization(OptName, OptValue: string); virtual;
 
     procedure HandleUnDefine(Param: String); virtual;
 
@@ -3416,6 +3418,47 @@ begin
   end;
 end;
 
+procedure TPascalScanner.HandleOptimizations(Param: string);
+// $optimization A,B-,C+
+var
+  p, StartP, l: Integer;
+  OptName, Value: String;
+begin
+  p:=1;
+  l:=length(Param);
+  while p<=l do
+    begin
+    // read next flag
+    // skip whitespace
+    while (p<=l) and (Param[p] in [' ',#9,#10,#13]) do
+      inc(p);
+    // read name
+    StartP:=p;
+    while (p<=l) and (Param[p] in ['a'..'z','A'..'Z','0'..'9','_']) do
+      inc(p);
+    if p=StartP then
+      Error(nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization']);
+    OptName:=copy(Param,StartP,p-StartP);
+    // skip whitespace
+    while (p<=l) and (Param[p] in [' ',#9,#10,#13]) do
+      inc(p);
+    // read value
+    StartP:=p;
+    while (p<=l) and (Param[p]<>',') do
+      inc(p);
+    Value:=TrimRight(copy(Param,StartP,p-StartP));
+    DoHandleOptimization(OptName,Value);
+    inc(p);
+    end;
+end;
+
+procedure TPascalScanner.DoHandleOptimization(OptName, OptValue: string);
+begin
+  // default: skip any optimization directive
+  if OptName='' then ;
+  if OptValue='' then ;
+end;
+
 function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
 
 Var
@@ -4010,66 +4053,68 @@ begin
       Handled:=true;
       Param:=Trim(Param);
       Case UpperCase(Directive) of
-        'ASSERTIONS':
-          DoBoolDirective(bsAssertions);
-        'DEFINE':
-          HandleDefine(Param);
-        'GOTO':
-          DoBoolDirective(bsGoto);
-        'DIRECTIVEFIELD':
-          HandleDispatchField(Param,vsDispatchField);
-        'DIRECTIVESTRFIELD':
-          HandleDispatchField(Param,vsDispatchStrField);
-        'ERROR':
-          HandleError(Param);
-        'HINT':
-          DoLog(mtHint,nUserDefined,SUserDefined,[Param]);
-        'HINTS':
-          DoBoolDirective(bsHints);
-        'I','INCLUDE':
-          Result:=HandleInclude(Param);
-        'INTERFACES':
-          HandleInterfaces(Param);
-        'LONGSTRINGS':
-          DoBoolDirective(bsLongStrings);
-        'MACRO':
-          DoBoolDirective(bsMacro);
-        'MESSAGE':
-          HandleMessageDirective(Param);
-        'MODE':
-          HandleMode(Param);
-        'MODESWITCH':
-          HandleModeSwitch(Param);
-        'NOTE':
-          DoLog(mtNote,nUserDefined,SUserDefined,[Param]);
-        'NOTES':
-          DoBoolDirective(bsNotes);
-        'OBJECTCHECKS':
-          DoBoolDirective(bsObjectChecks);
-        'OVERFLOWCHECKS','OV':
-          DoBoolDirective(bsOverflowChecks);
-        'POINTERMATH':
-          DoBoolDirective(bsPointerMath);
-        'R' :
-          HandleResource(Param);
-        'RANGECHECKS':
-          DoBoolDirective(bsRangeChecks);
-        'SCOPEDENUMS':
-          DoBoolDirective(bsScopedEnums);
-        'TYPEDADDRESS':
-          DoBoolDirective(bsTypedAddress);
-        'TYPEINFO':
-          DoBoolDirective(bsTypeInfo);
-        'UNDEF':
-          HandleUnDefine(Param);
-        'WARN':
-          HandleWarn(Param);
-        'WARNING':
-          DoLog(mtWarning,nUserDefined,SUserDefined,[Param]);
-        'WARNINGS':
-          DoBoolDirective(bsWarnings);
-        'WRITEABLECONST':
-          DoBoolDirective(bsWriteableConst);
+      'ASSERTIONS':
+        DoBoolDirective(bsAssertions);
+      'DEFINE':
+        HandleDefine(Param);
+      'GOTO':
+        DoBoolDirective(bsGoto);
+      'DIRECTIVEFIELD':
+        HandleDispatchField(Param,vsDispatchField);
+      'DIRECTIVESTRFIELD':
+        HandleDispatchField(Param,vsDispatchStrField);
+      'ERROR':
+        HandleError(Param);
+      'HINT':
+        DoLog(mtHint,nUserDefined,SUserDefined,[Param]);
+      'HINTS':
+        DoBoolDirective(bsHints);
+      'I','INCLUDE':
+        Result:=HandleInclude(Param);
+      'INTERFACES':
+        HandleInterfaces(Param);
+      'LONGSTRINGS':
+        DoBoolDirective(bsLongStrings);
+      'MACRO':
+        DoBoolDirective(bsMacro);
+      'MESSAGE':
+        HandleMessageDirective(Param);
+      'MODE':
+        HandleMode(Param);
+      'MODESWITCH':
+        HandleModeSwitch(Param);
+      'NOTE':
+        DoLog(mtNote,nUserDefined,SUserDefined,[Param]);
+      'NOTES':
+        DoBoolDirective(bsNotes);
+      'OBJECTCHECKS':
+        DoBoolDirective(bsObjectChecks);
+      'OPTIMIZATION':
+        HandleOptimizations(Param);
+      'OVERFLOWCHECKS','OV':
+        DoBoolDirective(bsOverflowChecks);
+      'POINTERMATH':
+        DoBoolDirective(bsPointerMath);
+      'R' :
+        HandleResource(Param);
+      'RANGECHECKS':
+        DoBoolDirective(bsRangeChecks);
+      'SCOPEDENUMS':
+        DoBoolDirective(bsScopedEnums);
+      'TYPEDADDRESS':
+        DoBoolDirective(bsTypedAddress);
+      'TYPEINFO':
+        DoBoolDirective(bsTypeInfo);
+      'UNDEF':
+        HandleUnDefine(Param);
+      'WARN':
+        HandleWarn(Param);
+      'WARNING':
+        DoLog(mtWarning,nUserDefined,SUserDefined,[Param]);
+      'WARNINGS':
+        DoBoolDirective(bsWarnings);
+      'WRITEABLECONST':
+        DoBoolDirective(bsWriteableConst);
       else
         Handled:=false;
       end;

packages/fcl-passrc/tests/tcgenerics.pp

@@ -9,7 +9,7 @@ uses
 
 Type
 
-  { TTestGenerics }
+  { TTestGenerics - for resolver see unit tcresolvegenerics }
 
   TTestGenerics = Class(TBaseTestTypeParser)
   Published

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -51,6 +51,7 @@ type
     procedure TestGen_RecordDelphi;
     procedure TestGen_RecordNestedSpecialized;
     procedure TestGen_Record_SpecializeSelfInsideFail;
+    procedure TestGen_Record_ReferGenericSelfFail;
     procedure TestGen_RecordAnoArray;
     // ToDo: unitname.specialize TBird<word>.specialize
     procedure TestGen_RecordNestedSpecialize;
@@ -697,6 +698,21 @@ begin
     nTypeXIsNotYetCompletelyDefined);
 end;
 
+procedure TTestResolveGenerics.TestGen_Record_ReferGenericSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'Type',
+  '  TBird<T> = record',
+  '    b: TBird<T>;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird<>" is not yet completely defined',
+    nTypeXIsNotYetCompletelyDefined);
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordAnoArray;
 begin
   StartProgram(false);

packages/pastojs/src/pas2jscompiler.pp

@@ -5185,7 +5185,7 @@ var
   FoundPasIsForeign: Boolean;
   FoundPCUFilename, FoundPCUUnitName: string;
 
-  procedure TryUnitName(const TestUnitName: string);
+  function TryUnitName(const TestUnitName: string): boolean;
   var
     aFile: TPas2jsCompilerFile;
   begin
@@ -5220,6 +5220,9 @@ var
       if FoundPCUFilename<>'' then
         FoundPCUUnitName:=TestUnitName;
     end;
+
+    Result:=(FoundPasFilename<>'')
+        and (not Assigned(PCUSupport) or (FoundPCUFilename<>''));
   end;
 
 var
@@ -5239,32 +5242,34 @@ begin
   begin
     CheckUnitAlias(UseUnitName);
 
-    if Pos('.',UseUnitname)<1 then
+    // first search with name as written in module
+    if not TryUnitName(UseUnitname) then
     begin
-      // generic unit name -> search with namespaces
-      // first the default program namespace
-      DefNameSpace:=GetDefaultNamespace;
-      if DefNameSpace<>'' then
-        TryUnitName(DefNameSpace+'.'+UseUnitname);
-
-      if (FoundPasFilename='') or (FoundPCUFilename='') then
+      if Pos('.',UseUnitname)<1 then
       begin
-        // then the cmdline namespaces
+        // generic unit name -> search with namespaces
+        // first the cmdline namespaces
         for i:=0 to Namespaces.Count-1 do
         begin
           aNameSpace:=Namespaces[i];
           if aNameSpace='' then continue;
-          if SameText(aNameSpace,DefNameSpace) then continue;
-          TryUnitName(aNameSpace+'.'+UseUnitname);
+          if TryUnitName(aNameSpace+'.'+UseUnitname) then break;
         end;
-      end;
-    end;
 
-    if (FoundPasFilename='') or (FoundPCUFilename='') then
-    begin
-      // search unitname
-      TryUnitName(UseUnitname);
-    end;
+        if (FoundPasFilename='') or (FoundPCUFilename='') then
+        begin
+          // then the default program namespace
+          DefNameSpace:=GetDefaultNamespace;
+          if DefNameSpace<>'' then
+          begin
+            i:=Namespaces.Count-1;
+            while (i>=0) and not SameText(Namespaces[i],DefNameSpace) do dec(i);
+            if i<0 then
+              TryUnitName(DefNameSpace+'.'+UseUnitname);
+          end;
+        end;
+      end;
+    end
   end else begin
     // search Pascal file with InFilename
     FoundPasFilename:=FS.FindUnitFileName(UseUnitname,InFilename,ModuleDir,FoundPasIsForeign);

packages/pastojs/src/pas2jsfiler.pp

@@ -252,7 +252,8 @@ const
     'StoreImplJS',
     'RTLVersionCheckMain',
     'RTLVersionCheckSystem',
-    'RTLVersionCheckUnit'
+    'RTLVersionCheckUnit',
+    'AliasGlobals'
     );
 
   PCUDefaultTargetPlatform = PlatformBrowser;
@@ -844,7 +845,7 @@ type
     procedure WriteEnumType(Obj: TJSONObject; El: TPasEnumType; aContext: TPCUWriterContext); virtual;
     procedure WriteSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUWriterContext); virtual;
     procedure WriteRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUWriterContext); virtual;
-    procedure WriteRecordTypeScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUWriterContext); virtual;
+    procedure WriteRecordTypeScope(Obj: TJSONObject; Scope: TPas2jsRecordScope; aContext: TPCUWriterContext); virtual;
     procedure WriteRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUWriterContext); virtual;
     procedure WriteClassScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasClassScopeFlags); virtual;
     procedure WriteClassIntfMapProcs(Obj: TJSONObject; Map: TPasClassIntfMap); virtual;
@@ -1137,7 +1138,7 @@ type
     procedure ReadSetType(Obj: TJSONObject; El: TPasSetType; aContext: TPCUReaderContext); virtual;
     function ReadPackedMode(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement): TPackMode; virtual;
     procedure ReadRecordVariant(Obj: TJSONObject; El: TPasVariant; aContext: TPCUReaderContext); virtual;
-    procedure ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope; aContext: TPCUReaderContext); virtual;
+    procedure ReadRecordScope(Obj: TJSONObject; Scope: TPas2jsRecordScope; aContext: TPCUReaderContext); virtual;
     procedure ReadRecordType(Obj: TJSONObject; El: TPasRecordType; aContext: TPCUReaderContext); virtual;
     function ReadClassInterfaceType(Obj: TJSONObject; const PropName: string; ErrorEl: TPasElement; DefaultValue: TPasClassInterfaceType): TPasClassInterfaceType;
     function ReadClassScopeFlags(Obj: TJSONObject; El: TPasElement;
@@ -4038,7 +4039,7 @@ begin
 end;
 
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
-  Scope: TPasRecordScope; aContext: TPCUWriterContext);
+  Scope: TPas2jsRecordScope; aContext: TPCUWriterContext);
 begin
   AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
   WriteIdentifierScope(Obj,Scope,aContext);
@@ -4059,7 +4060,7 @@ begin
     WriteElementProperty(Obj,El,'VariantEl',El.VariantEl,aContext);
   WriteElementList(Obj,El,'Variants',El.Variants,aContext);
 
-  WriteRecordTypeScope(Obj,El.CustomData as TPasRecordScope,aContext);
+  WriteRecordTypeScope(Obj,El.CustomData as TPas2jsRecordScope,aContext);
 end;
 
 procedure TPCUWriter.WriteClassScopeFlags(Obj: TJSONObject;
@@ -5076,7 +5077,7 @@ end;
 procedure TPCUReader.Set_RecordScope_DefaultProperty(RefEl: TPasElement;
   Data: TObject);
 var
-  Scope: TPasRecordScope absolute Data;
+  Scope: TPas2jsRecordScope absolute Data;
 begin
   if RefEl is TPasProperty then
     Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
@@ -8168,7 +8169,7 @@ begin
   ReadElType(Obj,'Members',El,@Set_Variant_Members,aContext);
 end;
 
-procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
+procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPas2jsRecordScope;
   aContext: TPCUReaderContext);
 begin
   ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
@@ -8180,13 +8181,13 @@ procedure TPCUReader.ReadRecordType(Obj: TJSONObject; El: TPasRecordType;
 var
   Data: TJSONData;
   Id: Integer;
-  Scope: TPasRecordScope;
+  Scope: TPas2jsRecordScope;
   SubObj: TJSONObject;
 begin
   if FileVersion<3 then
     RaiseMsg(20190109214718,El,'record format changed');
 
-  Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
+  Scope:=TPas2jsRecordScope(Resolver.CreateScope(El,TPas2jsRecordScope));
   El.CustomData:=Scope;
 
   ReadPasElement(Obj,El,aContext);

packages/pastojs/tests/tcconverter.pp

@@ -385,14 +385,14 @@ begin
   F.Body:=CreateAssignStatement();
   ForSt:=TJSForStatement(Convert(F,TJSForStatement));
   // Should be
-  //   for(var $l1=1, $le2=100; $l1<=$le2; $l1++){
-  //     I=$l1;
+  //   for(var $l=1, $end=100; $l<=$end2; $l++){
+  //     I=$l;
   //     a=b;
   //   }
-  LoopVar:=Pas2JSBuiltInNames[pbivnLoop]+'1';
-  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'2';
+  LoopVar:=Pas2JSBuiltInNames[pbivnLoop];
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd];
 
-  // "var $l1=1, $le2=100"
+  // "var $l=1, $end=100"
   VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
   VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
@@ -402,20 +402,20 @@ begin
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
   AssertLiteral('Correct end value',VD.Init,100);
 
-  // $l1<=$le2
+  // $l<=$end
   Cond:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,ForSt.Cond));
   AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
   AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
 
-  // $l1++
+  // $l++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,ForSt.Incr));
   AssertIdentifier('++ on correct variable name',I.A,LoopVar);
 
   // body
   L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
 
-  // I:=$l1
-  A:=TJSSimpleAssignStatement(AssertElement('I:=$l1',TJSSimpleAssignStatement,L.A));
+  // I:=$l
+  A:=TJSSimpleAssignStatement(AssertElement('I:='+LoopVar,TJSSimpleAssignStatement,L.A));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
   AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
 
@@ -446,14 +446,14 @@ begin
   F.Body:=CreateAssignStatement();
   ForSt:=TJSForStatement(Convert(F,TJSForStatement));
   // Should be
-  //   for(var $l1=100, $le2=1; $l1>=$le2; $l1--){
-  //     I=$l1;
+  //   for(var $l=100, $end=1; $l>=$end; $l--){
+  //     I=$l;
   //     a=b;
   //   }
-  LoopVar:=Pas2JSBuiltInNames[pbivnLoop]+'1';
-  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'2';
+  LoopVar:=Pas2JSBuiltInNames[pbivnLoop];
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd];
 
-  // "var $l1=100, $le2=1"
+  // "var $l=100, $end=1"
   VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
   VDL:=TJSVariableDeclarationList(AssertElement('For init var has comma',TJSVariableDeclarationList,VS.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,VDL.A));
@@ -463,20 +463,20 @@ begin
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
   AssertLiteral('Correct end value',VD.Init,1);
 
-  // $l1>=$le2
+  // $l>=$end
   Cond:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,ForSt.Cond));
   AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
   AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
 
-  // $l1--
+  // $l--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,ForSt.Incr));
   AssertIdentifier('-- on correct variable name',I.A,LoopVar);
 
   // body
   L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
 
-  // I:=$l1
-  A:=TJSSimpleAssignStatement(AssertElement('I:=$l1',TJSSimpleAssignStatement,L.A));
+  // I:=$l
+  A:=TJSSimpleAssignStatement(AssertElement('I:='+LoopVar,TJSSimpleAssignStatement,L.A));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
   AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
 

packages/pastojs/tests/tcfiler.pas

@@ -75,7 +75,7 @@ type
     procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPas2JSSectionScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredInitialFinalizationScope(const Path: string; Orig, Rest: TPas2JSInitialFinalizationScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredEnumTypeScope(const Path: string; Orig, Rest: TPasEnumTypeScope; Flags: TPCCheckFlags); virtual;
-    procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPasRecordScope; Flags: TPCCheckFlags); virtual;
+    procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
@@ -805,7 +805,7 @@ begin
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
-  Orig, Rest: TPasRecordScope; Flags: TPCCheckFlags);
+  Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags);
 begin
   CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
   CheckRestoredIdentifierScope(Path,Orig,Rest,Flags);
@@ -1107,8 +1107,8 @@ begin
     CheckRestoredInitialFinalizationScope(Path+'[TPas2JSInitialFinalizationScope]',TPas2JSInitialFinalizationScope(Orig),TPas2JSInitialFinalizationScope(Rest),Flags)
   else if C=TPasEnumTypeScope then
     CheckRestoredEnumTypeScope(Path+'[TPasEnumTypeScope]',TPasEnumTypeScope(Orig),TPasEnumTypeScope(Rest),Flags)
-  else if C=TPasRecordScope then
-    CheckRestoredRecordScope(Path+'[TPasRecordScope]',TPasRecordScope(Orig),TPasRecordScope(Rest),Flags)
+  else if C=TPas2jsRecordScope then
+    CheckRestoredRecordScope(Path+'[TPas2jsRecordScope]',TPas2jsRecordScope(Orig),TPas2jsRecordScope(Rest),Flags)
   else if C=TPas2JSClassScope then
     CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest),Flags)
   else if C=TPas2JSProcedureScope then

packages/pastojs/tests/tcgenerics.pas

@@ -16,9 +16,8 @@ type
   Published
     // generic record
     Procedure TestGen_RecordEmpty;
-    Procedure TestGen_Record_ClassProc_ObjFPC;
-    //Procedure TestGen_Record_ClassProc_Delphi;
-    //Procedure TestGen_Record_ReferGenClass_DelphiFail;
+    Procedure TestGen_Record_ClassProc;
+    Procedure TestGen_Record_DelayProgram; // ToDo
 
     // generic class
     Procedure TestGen_ClassEmpty;
@@ -29,20 +28,20 @@ type
     Procedure TestGen_Class_TypeInfo;
     Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird<T>, TBird<S,T>
     Procedure TestGen_Class_ClassProperty;
-    Procedure TestGen_Class_ClassProc_ObjFPC;
-    //Procedure TestGen_Class_ClassProc_Delphi;
-    //Procedure TestGen_Class_ReferGenClass_DelphiFail;
+    Procedure TestGen_Class_ClassProc;
+    //Procedure TestGen_Record_ReferGenClass_DelphiFail; TBird<T> = class x:TBird; end;
     Procedure TestGen_Class_ClassConstructor;
-    // ToDo: rename local const T
     Procedure TestGen_Class_TypeCastSpecializesWarn;
     Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn;
     procedure TestGen_Class_VarArgsOfType;
+    procedure TestGen_Class_OverloadsInUnit;
+    procedure TestGen_ClassForward_CircleRTTI;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
     procedure TestGen_ExtClass_GenJSValueAssign;
     procedure TestGen_ExtClass_AliasMemberType;
-    Procedure TestGen_ExtClass_RTTI;
+    Procedure TestGen_ExtClass_RTTI; // ToDo: use "TGJSSET<JSValue>"
 
     // class interfaces
     procedure TestGen_ClassInterface_Corba;
@@ -105,7 +104,7 @@ begin
     ]));
 end;
 
-procedure TTestGenerics.TestGen_Record_ClassProc_ObjFPC;
+procedure TTestGenerics.TestGen_Record_ClassProc;
 begin
   StartProgram(false);
   Add([
@@ -155,6 +154,54 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Record_DelayProgram;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  generic TAnt<T> = record',
+  '    class var x: T;',
+  '  end;',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var f: specialize TAnt<TBird>;',
+  'begin',
+  '  f.x.b:=f.x.b+10;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Record_DelayProgram',
+    LinesToStr([ // statements
+    'rtl.recNewS($mod, "TAnt$G1", function () {',
+    '  this.x = $mod.TBird.$new();',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '}, true);',
+    'rtl.recNewT($mod, "TBird", function () {',
+    '  this.b = 0;',
+    '  this.$eq = function (b) {',
+    '    return this.b === b.b;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.b = s.b;',
+    '    return this;',
+    '  };',
+    '});',
+    '$mod.TAnt$G1();',
+    'this.f = $mod.TAnt$G1.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.f.x.b = $mod.f.x.b + 10;',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ClassEmpty;
 begin
   StartProgram(false);
@@ -408,8 +455,9 @@ begin
   '  p:=typeinfo(b);',
   '']);
   ConvertProgram;
-  CheckSource('TestGen_TypeInfo',
+  CheckSource('TestGen_Class_TypeInfo',
     LinesToStr([ // statements
+    '$mod.$rtti.$Class("TBird$G1");',
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
@@ -501,7 +549,7 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGen_Class_ClassProc_ObjFPC;
+procedure TTestGenerics.TestGen_Class_ClassProc;
 begin
   StartProgram(false);
   Add([
@@ -772,6 +820,159 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Class_OverloadsInUnit;
+begin
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  generic TBird<T> = class',
+    '  const c = 13;',
+    '    constructor Create(w: T);',
+    '    constructor Create(b: boolean);',
+    '  end;',
+    '']),
+  LinesToStr([
+    'constructor TBird.Create(w: T);',
+    'const c = 14;',
+    'begin',
+    'end;',
+    'constructor TBird.Create(b: boolean);',
+    'const c = 15;',
+    'begin',
+    'end;',
+    '']));
+  Add([
+  'uses UnitA;',
+  'type',
+  '  TWordBird = specialize TBird<word>;',
+  '  TDoubleBird = specialize TBird<double>;',
+  'var',
+  '  wb: TWordBird;',
+  '  db: TDoubleBird;',
+  'begin',
+  '  wb:=TWordBird.Create(3);',
+  '  wb:=TWordBird.Create(true);',
+  '  db:=TDoubleBird.Create(1.3);',
+  '  db:=TDoubleBird.Create(true);',
+  '']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  rtl.createClass($mod, "TBird$G1", pas.system.TObject, function () {',
+    '    this.c = 13;',
+    '    var c$1 = 14;',
+    '    this.Create$1 = function (w) {',
+    '      return this;',
+    '    };',
+    '    var c$2 = 15;',
+    '    this.Create$2 = function (b) {',
+    '      return this;',
+    '    };',
+    '  });',
+    '  rtl.createClass($mod, "TBird$G2", pas.system.TObject, function () {',
+    '    this.c = 13;',
+    '    var c$1 = 14;',
+    '    this.Create$1 = function (w) {',
+    '      return this;',
+    '    };',
+    '    var c$2 = 15;',
+    '    this.Create$2 = function (b) {',
+    '      return this;',
+    '    };',
+    '  });',
+    '});',
+    '']));
+  CheckSource('TestGen_Class_OverloadsInUnit',
+    LinesToStr([ // statements
+    'this.wb = null;',
+    'this.db = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.wb = pas.UnitA.TBird$G1.$create("Create$1", [3]);',
+    '$mod.wb = pas.UnitA.TBird$G1.$create("Create$2", [true]);',
+    '$mod.db = pas.UnitA.TBird$G2.$create("Create$1", [1.3]);',
+    '$mod.db = pas.UnitA.TBird$G2.$create("Create$2", [true]);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ClassForward_CircleRTTI;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  {$M+}',
+  '  TPersistent = class end;',
+  '  {$M-}',
+  '  generic TAnt<T> = class;',
+  '  generic TFish<U> = class(TPersistent)',
+  '    private type AliasU = U;',
+  '  published',
+  '    a: specialize TAnt<AliasU>;',
+  '  end;',
+  '  generic TAnt<T> = class(TPersistent)',
+  '    private type AliasT = T;',
+  '  published',
+  '    f: specialize TFish<AliasT>;',
+  '  end;',
+  'var',
+  '  WordFish: specialize TFish<word>;',
+  '  p: pointer;',
+  'begin',
+  '  p:=typeinfo(specialize TAnt<word>);',
+  '  p:=typeinfo(specialize TFish<word>);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassForward_CircleRTTI',
+    LinesToStr([ // statements
+    '$mod.$rtti.$Class("TAnt$G2");',
+    '$mod.$rtti.$Class("TFish$G2");',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TPersistent", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "TAnt$G2", $mod.TPersistent, function () {',
+    '  this.$init = function () {',
+    '    $mod.TPersistent.$init.call(this);',
+    '    this.f = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.f = undefined;',
+    '    $mod.TPersistent.$final.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("f", $mod.$rtti["TFish$G2"]);',
+    '});',
+    'rtl.createClass($mod, "TFish$G2", $mod.TPersistent, function () {',
+    '  this.$init = function () {',
+    '    $mod.TPersistent.$init.call(this);',
+    '    this.a = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.a = undefined;',
+    '    $mod.TPersistent.$final.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("a", $mod.$rtti["TAnt$G2"]);',
+    '});',
+    'this.WordFish = null;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TAnt$G2"];',
+    '$mod.p = $mod.$rtti["TFish$G2"];',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);

packages/pastojs/tests/tcoptimizations.pas

@@ -56,6 +56,18 @@ type
 
   TTestOptimizations = class(TCustomTestOptimizations)
   published
+    // unit optimization: aliasglobals
+    procedure TestOptAliasGlobals_Program;
+    procedure TestOptAliasGlobals_Unit; // ToDo
+    // ToDo: external var, const, class
+    // ToDo: RTTI
+    // ToDo: typeinfo(var), typeinfo(type)
+    // ToDo: resourcestring
+    // ToDo: Global EnumType, EnumValue, EnumType.Value, unit.EnumType.Value
+    // ToDo: Nested EnumType: EnumValue, EnumType.Value, unit.aType.EnumType.Value, aType.EnumType.Value, Instance.EnumType.Value
+    // ToDo: Instance.RecordType, Instance.RecordType.ClassVar
+    // ToDo: ClassVarRecord
+
     // Whole Program Optimization
     procedure TestWPO_OmitLocalVar;
     procedure TestWPO_OmitLocalProc;
@@ -187,6 +199,157 @@ end;
 
 { TTestOptimizations }
 
+procedure TTestOptimizations.TestOptAliasGlobals_Program;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'const',
+    '  cWidth = 17;',
+    'type',
+    '  TBird = class',
+    '  public',
+    '    class var c: word;',
+    '    class function Run(w: word): word; virtual; abstract;',
+    '  end;',
+    '  TRec = record',
+    '    x: word;',
+    '  end;',
+    'var b: TBird;',
+    '']),
+  LinesToStr([
+    '']));
+
+  StartProgram(true,[supTObject]);
+  Add([
+  '{$optimization AliasGlobals}',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    class function Run(w: word = 5): word; override;',
+  '  end;',
+  'class function TEagle.Run(w: word): word;',
+  'begin',
+  'end;',
+  'var',
+  '  e: TEagle;',
+  '  r: TRec;',
+  'begin',
+  '  e:=TEagle.Create;',
+  '  b:=TBird.Create;',
+  '  e.c:=e.c+1;',
+  '  r.x:=TBird.c;',
+  '  r.x:=b.c;',
+  '  r.x:=e.Run;',
+  '  r.x:=e.Run();',
+  '  r.x:=e.Run(4);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestOptAliasGlobals_Program',
+    LinesToStr([
+    'var $lmr = pas.UnitA;',
+    'var $ltr = $lmr.TBird;',
+    'var $ltr1 = $lmr.TRec;',
+    'rtl.createClass($mod, "TEagle", $ltr, function () {',
+    '  this.Run = function (w) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.e = null;',
+    'this.r = $ltr1.$new();',
+    '']),
+    LinesToStr([
+    '$mod.e = $mod.TEagle.$create("Create");',
+    '$lmr.b = $ltr.$create("Create");',
+    '$ltr.c = $mod.e.c + 1;',
+    '$mod.r.x = $ltr.c;',
+    '$mod.r.x = $lmr.b.c;',
+    '$mod.r.x = $mod.e.$class.Run(5);',
+    '$mod.r.x = $mod.e.$class.Run(5);',
+    '$mod.r.x = $mod.e.$class.Run(4);',
+    '']));
+end;
+
+procedure TTestOptimizations.TestOptAliasGlobals_Unit;
+begin
+  exit;
+
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'const',
+    '  cWidth = 17;',
+    'type',
+    '  TBird = class',
+    '  public',
+    '    class var Span: word;',
+    '    class procedure Fly(w: word); virtual; abstract;',
+    '  end;',
+    '  TRecA = record',
+    '    x: word;',
+    '  end;',
+    'var Bird: TBird;',
+    '']),
+  LinesToStr([
+    '']));
+  AddModuleWithIntfImplSrc('UnitB.pas',
+  LinesToStr([
+    'const',
+    '  cHeight = 23;',
+    'type',
+    '  TAnt = class',
+    '  public',
+    '    class var Legs: word;',
+    '    class procedure Run(w: word); virtual; abstract;',
+    '  end;',
+    '  TRecB = record',
+    '    y: word;',
+    '  end;',
+    'var Ant: TAnt;',
+    '']),
+  LinesToStr([
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization AliasGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    class var EagleRec: TRecA;',
+  '    class procedure Fly(w: word = 5); override;',
+  '  end;',
+  'implementation',
+  'uses unitb;',
+  'type',
+  '  TRedAnt = class(TAnt)',
+  '    class var RedAntRecA: TRecA;',
+  '    class var RedAntRecB: TRecB;',
+  '    class procedure Run(w: word = 6); override;',
+  '  end;',
+  'class procedure TEagle.Fly(w: word);',
+  'begin',
+  'end;',
+  'class procedure TRedAnt.Run(w: word);',
+  'begin',
+  'end;',
+  'var',
+  '  Eagle: TEagle;',
+  '  RedAnt: TRedAnt;',
+  'initialization',
+  '  Eagle:=TEagle.Create;',
+  '  RedAnt:=TRedAnt.Create;',
+  '  Bird:=TBird.Create;',
+  '  Ant:=TAnt.Create;',
+  '  TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptAliasGlobals_Unit',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestOptimizations.TestWPO_OmitLocalVar;
 begin
   StartProgram(false);

packages/pastojs/tests/tcsrcmap.pas

@@ -421,8 +421,8 @@ begin
   '    var Runner = 0;',
   '    var j = 0;',
   '    j = 0;',
-  '    for (var $l1 = 3, $end2 = j; $l1 <= $end2; $l1++) {',
-  '      Runner = $l1;',
+  '    for (var $l = 3, $end = j; $l <= $end; $l++) {',
+  '      Runner = $l;',
   '      j += 1;',
   '    };',
   '    Result = j;',

packages/pastojs/tests/tcunitsearch.pas

@@ -154,6 +154,12 @@ type
 
     procedure TestUS_UseUnitTwiceFail;
     procedure TestUS_UseUnitTwiceViaNameSpace;
+
+    // namespace
+    Procedure TestDefaultNameSpaceLast;
+    Procedure TestDefaultNameSpaceAfterNameSpace;
+    Procedure TestNoNameSpaceBeforeDefaultNameSpace;
+    Procedure TestNoNameSpaceAndDefaultNameSpace;
   end;
 
 function LinesToStr(const Lines: array of string): string;
@@ -843,6 +849,88 @@ begin
   Compile(['test1.pas','-FNsub','-Jc']);
 end;
 
+procedure TTestCLI_UnitSearch.TestDefaultNameSpaceLast;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('Unit2.pas',
+    ['var i: longint;'],
+    ['']);
+  AddUnit('NS1.Unit2.pas',
+    ['var j: longint;'],
+    ['']);
+  AddFile('test1.pas',[
+    'uses unIt2;',
+    'var',
+    '  k: longint;',
+    'begin',
+    '  k:=i;',
+    'end.']);
+  Compile(['test1.pas','','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestDefaultNameSpaceAfterNameSpace;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('prg.Unit2.pas',
+    ['var j: longint;'],
+    ['']);
+  AddUnit('sub.Unit2.pas',
+    ['var i: longint;'],
+    ['']);
+  AddFile('prg.test1.pas',[
+    'uses unIt2;',
+    'var',
+    '  k: longint;',
+    'begin',
+    '  k:=i;',
+    'end.']);
+  Compile(['prg.test1.pas','-FNsub','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestNoNameSpaceBeforeDefaultNameSpace;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('prg.Unit2.pas',
+    ['var j: longint;'],
+    ['']);
+  AddUnit('Unit2.pas',
+    ['var i: longint;'],
+    ['']);
+  AddFile('prg.test1.pas',[
+    'uses unIt2;',
+    'var',
+    '  k: longint;',
+    'begin',
+    '  k:=i;',
+    'end.']);
+  Compile(['prg.test1.pas','','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestNoNameSpaceAndDefaultNameSpace;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('UnitA.pas',
+    ['type TBool = boolean;'],
+    ['']);
+  AddUnit('ThirdParty.UnitB.pas',
+    ['uses UnitA;',
+     'type TAlias = TBool;'],
+    ['']);
+  AddUnit('MyProject.UnitA.pas',
+    [
+    'uses ThirdParty.UnitB;',
+    'var a: TAlias;'],
+    ['']);
+  AddFile('MyProject.Main.pas',[
+    'uses MyProject.UnitA;',
+    'var',
+    '  b: boolean;',
+    'begin',
+    '  b:=a;',
+    'end.']);
+  Compile(['MyProject.Main.pas','','-Jc']);
+end;
+
 Initialization
   RegisterTests([TTestCLI_UnitSearch]);
 end.

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

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

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

@@ -13,6 +13,8 @@ uses
   tests.generics.trees,
   tests.generics.stdcollections,
   tests.generics.sets,
+  tests.generics.queue,
+  tests.generics.stack,
   tests.generics.dictionary
   ;
 

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

@@ -0,0 +1,388 @@
+unit tests.generics.queue;
+
+{$mode objfpc}
+
+interface
+
+uses
+  fpcunit, testregistry, Classes, SysUtils, Generics.Defaults, Generics.Collections;
+
+
+Type
+  TMySimpleQueue = Class(Specialize TQueue<String>);
+{$IFDEF FPC}
+  EList = EListError;
+{$ENDIF}
+
+  { TTestSimpleQueue }
+
+  TTestSimpleQueue = Class(TTestCase)
+  Private
+    FQueue : TMySimpleQueue;
+    FnotifyMessage : String;
+    FCurrentValueNotify : Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction: Array of TCollectionNotification;
+    procedure DoAdd(aCount: Integer; aOffset: Integer=0);
+    procedure DoAdd2;
+    Procedure DoneExpectValues;
+    procedure DoGetValue(Match: String; ExceptionClass: TClass=nil);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+  Public
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Queue : TMySimpleQueue Read FQueue;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAdd;
+    Procedure TestClear;
+    Procedure TestGetValue;
+    Procedure TestPeek;
+    Procedure TestDequeue;
+    Procedure TestToArray;
+    Procedure TestEnumerator;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+  end;
+
+  { TMyObject }
+
+  TMyObject = Class(TObject)
+  Private
+    fOnDestroy : TNotifyEvent;
+    FID : Integer;
+  public
+    Constructor Create(aID : Integer; aOnDestroy : TNotifyEvent);
+    destructor destroy; override;
+    Property ID : Integer Read FID;
+  end;
+
+  TSingleObjectQueue = Class(Specialize TObjectQueue<TMyObject>);
+
+  { TTestSingleObjectQueue }
+
+  TTestSingleObjectQueue = Class(TTestCase)
+  private
+    FOQueue: TSingleObjectQueue;
+    FList : TFPList;
+    procedure DoAdd(aID: Integer);
+    procedure DoDestroy(Sender: TObject);
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Queue : TSingleObjectQueue Read FOQueue;
+  Published
+    Procedure TestEmpty;
+    Procedure TestFreeOnDequeue;
+    Procedure TestNoFreeOnDeQueue;
+  end;
+
+implementation
+
+{ TTestSingleObjectQueue }
+
+procedure TTestSingleObjectQueue.SetUp;
+begin
+  FOQueue:=TSingleObjectQueue.Create(True);
+  FList:=TFPList.Create;
+  inherited SetUp;
+end;
+
+procedure TTestSingleObjectQueue.TearDown;
+begin
+  FreeAndNil(FOQueue);
+  FreeAndNil(FList);
+  inherited TearDown;
+end;
+
+procedure TTestSingleObjectQueue.TestEmpty;
+begin
+  AssertNotNull('Have object',Queue);
+  AssertEquals('Have empty object',0,Queue.Count);
+end;
+
+procedure TTestSingleObjectQueue.DoAdd(aID : Integer);
+
+Var
+  O :  TMyObject;
+
+begin
+  O:=TMyObject.Create(aID,@DoDestroy);
+  FOQueue.EnQueue(O);
+  FList.Add(O);
+end;
+
+procedure TTestSingleObjectQueue.DoDestroy(Sender: TObject);
+
+Var
+  I : Integer;
+
+begin
+  I:=FList.IndexOf(Sender);
+  AssertTrue('Have object in Queue',I<>-1);
+  FList.Delete(I);
+end;
+
+procedure TTestSingleObjectQueue.TestFreeOnDeQueue;
+
+begin
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Queue.Dequeue;
+  AssertEquals('Have no obj',0,FList.Count);
+end;
+
+procedure TTestSingleObjectQueue.TestNoFreeOnDeQueue;
+begin
+  Queue.OwnsObjects:=False;
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Queue.DeQueue;
+  AssertEquals('Have  obj',1,FList.Count);
+end;
+
+
+{ TMyObject }
+
+constructor TMyObject.Create(aID: Integer; aOnDestroy: TNotifyEvent);
+begin
+  FOnDestroy:=aOnDestroy;
+  FID:=AID;
+end;
+
+destructor TMyObject.destroy;
+begin
+  if Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+  inherited destroy;
+end;
+
+{ TTestSimpleQueue }
+
+procedure TTestSimpleQueue.SetUp;
+begin
+  inherited SetUp;
+  FQueue:=TMySimpleQueue.Create;
+  FCurrentValueNotify:=0;
+  FExpectValues:=[];
+  FExpectValueAction:=[];
+end;
+
+procedure TTestSimpleQueue.TearDown;
+begin
+  // So we don't get clear messages
+  FQueue.OnNotify:=Nil;
+  FreeAndNil(FQueue);
+  inherited TearDown;
+end;
+
+procedure TTestSimpleQueue.TestEmpty;
+begin
+  AssertNotNull('Have dictionary',Queue);
+  AssertEquals('empty dictionary',0,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.DoAdd(aCount : Integer; aOffset : Integer=0);
+
+Var
+  I : Integer;
+
+begin
+  if aOffset=-1 then
+    aOffset:=Queue.Count;
+  For I:=aOffset+1 to aOffset+aCount do
+    Queue.EnQueue(IntToStr(i));
+end;
+
+procedure TTestSimpleQueue.TestAdd;
+
+begin
+  DoAdd(1);
+  AssertEquals('Count OK',1,Queue.Count);
+  DoAdd(1,1);
+  AssertEquals('Count OK',2,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.TestClear;
+begin
+  DoAdd(3);
+  AssertEquals('Count OK',3,Queue.Count);
+  Queue.Clear;
+  AssertEquals('Count after clear OK',0,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.DoGetValue(Match: String; ExceptionClass: TClass);
+
+Var
+  EC : TClass;
+  A,EM : String;
+
+begin
+  EC:=Nil;
+  try
+    A:=Queue.DeQueue;
+  except
+    On E : Exception do
+      begin
+      EC:=E.ClassType;
+      EM:=E.Message;
+      end
+  end;
+  if ExceptionClass=Nil then
+    begin
+    if EC<>Nil then
+      Fail('Got exception '+EC.ClassName+' with message: '+EM);
+    AssertEquals('Value is correct',Match,A)
+    end
+  else
+    begin
+    if EC=Nil then
+      Fail('Expected exception '+ExceptionClass.ClassName+' but got none');
+    if EC<>ExceptionClass then
+      Fail('Expected exception class '+ExceptionClass.ClassName+' but got '+EC.ClassName+' with message '+EM);
+    end;
+end;
+
+procedure TTestSimpleQueue.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+//  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FQueue,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+
+procedure TTestSimpleQueue.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleQueue.TestGetValue;
+
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    DoGetValue(IntToStr(I));
+  DoGetValue('4',EArgumentOutOfRangeException);
+end;
+
+procedure TTestSimpleQueue.TestPeek;
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=1 to 3 do
+    begin
+    AssertEquals('Peek ',IntToStr(I),FQueue.Peek);
+    DoGetValue(IntToStr(I));
+    end;
+end;
+
+
+procedure TTestSimpleQueue.DoAdd2;
+
+begin
+  Queue.Enqueue('A new 2');
+end;
+
+procedure TTestSimpleQueue.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
+procedure TTestSimpleQueue.TestDequeue;
+
+begin
+  DoAdd(3);
+  AssertEquals('1',Queue.Dequeue);
+  AssertEquals('Count',2,Queue.Count);
+end;
+
+procedure TTestSimpleQueue.TestToArray;
+
+Var
+  A : specialize TArray<String>;
+
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Queue.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[i-1]);
+    end;
+end;
+
+
+procedure TTestSimpleQueue.TestEnumerator;
+
+Var
+  A : String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Queue do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A);
+    Inc(I);
+    end;
+end;
+
+procedure TTestSimpleQueue.TestValueNotification;
+begin
+  Queue.OnNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleQueue.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Queue.OnNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['1','2','3'],[cnRemoved,cnRemoved,cnRemoved],{$IFDEF FPC}true{$ELSE}False{$endif});
+  Queue.Clear;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTests([ TTestSimpleQueue,TTestSingleObjectQueue]);
+end.
+

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

@@ -0,0 +1,403 @@
+unit tests.generics.stack;
+
+{$mode objfpc}
+
+interface
+
+uses
+  fpcunit, testregistry, Classes, SysUtils, Generics.Defaults, Generics.Collections;
+
+
+Type
+  TMySimpleStack = Class(Specialize TStack<String>);
+{$IFDEF FPC}
+  EList = EListError;
+{$ENDIF}
+
+  { TTestSimpleStack }
+
+  TTestSimpleStack = Class(TTestCase)
+  Private
+    FStack : TMySimpleStack;
+    FnotifyMessage : String;
+    FCurrentValueNotify : Integer;
+    FExpectValues : Array of String;
+    FExpectValueAction: Array of TCollectionNotification;
+    procedure DoAdd(aCount: Integer);
+    procedure DoAdd2;
+    Procedure DoneExpectValues;
+    procedure DoGetValue(Match: String; ExceptionClass: TClass=nil);
+    procedure DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+  Public
+    Procedure SetExpectValues(aMessage : string; AKeys : Array of String; AActions : Array of TCollectionNotification; DoReverse : Boolean = False);
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Stack : TMySimpleStack Read FStack;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAdd;
+    Procedure TestClear;
+    Procedure TestGetValue;
+    Procedure TestPeek;
+    Procedure TestPop;
+    Procedure TestToArray;
+    Procedure TestEnumerator;
+    procedure TestValueNotification;
+    procedure TestValueNotificationDelete;
+  end;
+
+  { TMyObject }
+
+  TMyObject = Class(TObject)
+  Private
+    fOnDestroy : TNotifyEvent;
+    FID : Integer;
+  public
+    Constructor Create(aID : Integer; aOnDestroy : TNotifyEvent);
+    destructor destroy; override;
+    Property ID : Integer Read FID;
+  end;
+
+  TSingleObjectStack = Class(Specialize TObjectStack<TMyObject>);
+
+  { TTestSingleObjectStack }
+
+  TTestSingleObjectStack = Class(TTestCase)
+  private
+    FOStack: TSingleObjectStack;
+    FList : TFPList;
+    procedure DoAdd(aID: Integer);
+    procedure DoDestroy(Sender: TObject);
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Stack : TSingleObjectStack Read FOStack;
+  Published
+    Procedure TestEmpty;
+    Procedure TestFreeOnPop;
+    Procedure TestNoFreeOnPop;
+  end;
+
+implementation
+
+{ TTestSingleObjectStack }
+
+procedure TTestSingleObjectStack.SetUp;
+begin
+  FOStack:=TSingleObjectStack.Create(True);
+  FList:=TFPList.Create;
+  inherited SetUp;
+end;
+
+procedure TTestSingleObjectStack.TearDown;
+
+Var
+  I : integer;
+  A : TObject;
+
+begin
+  FreeAndNil(FOStack);
+  for I:=0 to FList.Count-1 do
+    begin
+    A:=TObject(FList[i]);
+    A.Free;
+    end;
+  FreeAndNil(FList);
+  inherited TearDown;
+end;
+
+procedure TTestSingleObjectStack.TestEmpty;
+begin
+  AssertNotNull('Have object',Stack);
+  AssertEquals('Have empty object',0,Stack.Count);
+end;
+
+procedure TTestSingleObjectStack.DoAdd(aID : Integer);
+
+Var
+  O :  TMyObject;
+
+begin
+  O:=TMyObject.Create(aID,@DoDestroy);
+  FOStack.Push(O);
+  FList.Add(O);
+end;
+
+procedure TTestSingleObjectStack.DoDestroy(Sender: TObject);
+
+Var
+  I : Integer;
+
+begin
+  I:=FList.IndexOf(Sender);
+  AssertTrue('Have object in Stack',I<>-1);
+  FList.Delete(I);
+end;
+
+procedure TTestSingleObjectStack.TestFreeOnPop;
+
+begin
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Stack.Pop;
+  AssertEquals('Have no obj',0,FList.Count);
+end;
+
+procedure TTestSingleObjectStack.TestNoFreeOnPop;
+begin
+  Stack.OwnsObjects:=False;
+  DoAdd(1);
+  AssertEquals('Have obj',1,FList.Count);
+  Stack.Pop;
+  AssertEquals('Have  obj',1,FList.Count);
+end;
+
+
+{ TMyObject }
+
+constructor TMyObject.Create(aID: Integer; aOnDestroy: TNotifyEvent);
+begin
+  FOnDestroy:=aOnDestroy;
+  FID:=AID;
+end;
+
+destructor TMyObject.destroy;
+begin
+  if Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+  inherited destroy;
+end;
+
+{ TTestSimpleStack }
+
+procedure TTestSimpleStack.SetUp;
+begin
+  inherited SetUp;
+  FStack:=TMySimpleStack.Create;
+  FCurrentValueNotify:=0;
+  FExpectValues:=[];
+  FExpectValueAction:=[];
+end;
+
+procedure TTestSimpleStack.TearDown;
+begin
+  // So we don't get clear messages
+  FStack.OnNotify:=Nil;
+  FreeAndNil(FStack);
+  inherited TearDown;
+end;
+
+procedure TTestSimpleStack.TestEmpty;
+begin
+  AssertNotNull('Have dictionary',Stack);
+  AssertEquals('empty dictionary',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.DoAdd(aCount : Integer);
+
+Var
+  I : Integer;
+
+begin
+  For I:=1 to aCount do
+    Stack.Push(IntToStr(i));
+end;
+
+procedure TTestSimpleStack.TestAdd;
+
+begin
+  DoAdd(1);
+  AssertEquals('Count OK',1,Stack.Count);
+  DoAdd(1);
+  AssertEquals('Count OK',2,Stack.Count);
+end;
+
+procedure TTestSimpleStack.TestClear;
+begin
+  DoAdd(3);
+  AssertEquals('Count OK',3,Stack.Count);
+  Stack.Clear;
+  AssertEquals('Count after clear OK',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.DoGetValue(Match: String; ExceptionClass: TClass);
+
+Var
+  EC : TClass;
+  A,EM : String;
+
+begin
+  EC:=Nil;
+  try
+    A:=Stack.Pop;
+  except
+    On E : Exception do
+      begin
+      EC:=E.ClassType;
+      EM:=E.Message;
+      end
+  end;
+  if ExceptionClass=Nil then
+    begin
+    if EC<>Nil then
+      Fail('Got exception '+EC.ClassName+' with message: '+EM);
+    AssertEquals('Value is correct',Match,A)
+    end
+  else
+    begin
+    if EC=Nil then
+      Fail('Expected exception '+ExceptionClass.ClassName+' but got none');
+    if EC<>ExceptionClass then
+      Fail('Expected exception class '+ExceptionClass.ClassName+' but got '+EC.ClassName+' with message '+EM);
+    end;
+end;
+
+procedure TTestSimpleStack.DoValueNotify(ASender: TObject; {$ifdef fpc}constref{$else}const{$endif} AItem: String; AAction: TCollectionNotification);
+begin
+//  Writeln(FnotifyMessage+' value Notification',FCurrentValueNotify);
+  AssertSame(FnotifyMessage+' value Correct sender', FStack,aSender);
+  if (FCurrentValueNotify>=Length(FExpectValues)) then
+    Fail(FnotifyMessage+' Too many value notificiations');
+  AssertEquals(FnotifyMessage+' Notification value no '+IntToStr(FCurrentValueNotify),FExpectValues[FCurrentValueNotify],aItem);
+  Inc(FCurrentValueNotify);
+end;
+
+
+procedure TTestSimpleStack.SetExpectValues(aMessage: string; AKeys: array of String;
+  AActions: array of TCollectionNotification; DoReverse: Boolean);
+Var
+  I,L : integer;
+
+begin
+  FnotifyMessage:=aMessage;
+  FCurrentValueNotify:=0;
+  L:=Length(aKeys);
+  AssertEquals('SetExpectValues: Lengths arrays equal',l,Length(aActions));
+  SetLength(FExpectValues,L);
+  SetLength(FExpectValueAction,L);
+  Dec(L);
+  if DoReverse then
+    For I:=0 to L do
+      begin
+      FExpectValues[L-i]:=AKeys[i];
+      FExpectValueAction[L-i]:=AActions[I];
+      end
+  else
+    For I:=0 to L do
+      begin
+      FExpectValues[i]:=AKeys[i];
+      FExpectValueAction[i]:=AActions[I];
+      end;
+end;
+
+procedure TTestSimpleStack.TestGetValue;
+
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    DoGetValue(IntToStr(I));
+  DoGetValue('4',EArgumentOutOfRangeException);
+end;
+
+procedure TTestSimpleStack.TestPeek;
+Var
+  I : integer;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    begin
+    AssertEquals('Peek ',IntToStr(I),FStack.Peek);
+    DoGetValue(IntToStr(I));
+    end;
+end;
+
+
+procedure TTestSimpleStack.DoAdd2;
+
+begin
+  Stack.Push('A new 2');
+end;
+
+procedure TTestSimpleStack.DoneExpectValues;
+begin
+  AssertEquals(FnotifyMessage+' Expected number of values seen',Length(FExpectValues),FCurrentValueNotify);
+end;
+
+procedure TTestSimpleStack.TestPop;
+
+Var
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  For I:=3 downto 1 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,FStack.Pop);
+    end;
+  AssertEquals('Count',0,Stack.Count);
+end;
+
+procedure TTestSimpleStack.TestToArray;
+
+Var
+  A : specialize TArray<String>;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  A:=Stack.ToArray;
+  AssertEquals('Length Ok',3,Length(A));
+  For I:=1 to 3 do
+    begin
+    SI:=IntToStr(I);
+    AssertEquals('Value '+SI,SI,A[i-1]);
+    end;
+end;
+
+
+procedure TTestSimpleStack.TestEnumerator;
+
+Var
+  A : String;
+  I : Integer;
+  SI : String;
+
+begin
+  DoAdd(3);
+  I:=1;
+  For A in Stack do
+    begin
+    SI:=IntToStr(i);
+    AssertEquals('Value '+SI,SI,A);
+    Inc(I);
+    end;
+end;
+
+procedure TTestSimpleStack.TestValueNotification;
+begin
+  Stack.OnNotify:=@DoValueNotify;
+  SetExpectValues('Add',['1','2','3'],[cnAdded,cnAdded,cnAdded]);
+  DoAdd(3);
+  DoneExpectValues;
+end;
+
+procedure TTestSimpleStack.TestValueNotificationDelete;
+begin
+  DoAdd(3);
+  Stack.OnNotify:=@DoValueNotify;
+  SetExpectValues('Clear',['3','2','1'],[cnRemoved,cnRemoved,cnRemoved],False);
+  Stack.Clear;
+  DoneExpectValues;
+end;
+
+begin
+  RegisterTests([ TTestSimpleStack,TTestSingleObjectStack]);
+end.
+

utils/pas2js/dist/rtl.js

@@ -347,19 +347,33 @@ var rtl = {
     // Create a class using an external ancestor.
     // If newinstancefnname is given, use that function to create the new object.
     // If exist call BeforeDestruction and AfterConstruction.
-    var c = Object.create(ancestor);
+    var isFunc = rtl.isFunction(ancestor);
+    var c = null;
+    if (isFunc){
+      // create pascal class descendent from JS function
+      c = Object.create(ancestor.prototype);
+    } else if (ancestor.$func){
+      // create pascal class descendent from a pascal class descendent of a JS function
+      isFunc = true;
+      c = Object.create(ancestor);
+      c.$ancestor = ancestor;
+    } else {
+      c = Object.create(ancestor);
+    }
     c.$create = function(fn,args){
       if (args == undefined) args = [];
       var o = null;
       if (newinstancefnname.length>0){
         o = this[newinstancefnname](fn,args);
+      } else if(isFunc) {
+        o = new this.$func(args);
       } else {
-        o = Object.create(this);
+        o = Object.create(c);
       }
       if (o.$init) o.$init();
       try{
         if (typeof(fn)==="string"){
-          o[fn].apply(o,args);
+          this[fn].apply(o,args);
         } else {
           fn.apply(o,args);
         };
@@ -367,7 +381,7 @@ var rtl = {
       } catch($e){
         // do not call BeforeDestruction
         if (o.Destroy) o.Destroy();
-        if (o.$final) this.$final();
+        if (o.$final) o.$final();
         throw $e;
       }
       return o;
@@ -378,6 +392,11 @@ var rtl = {
       if (this.$final) this.$final();
     };
     rtl.initClass(c,parent,name,initfn);
+    if (isFunc){
+      function f(){}
+      f.prototype = c;
+      c.$func = f;
+    }
   },
 
   createHelper: function(parent,name,ancestor,initfn){
@@ -432,29 +451,34 @@ var rtl = {
     // create new record type
     var t = {};
     if (parent) parent[name] = t;
-    function hide(prop){
-      Object.defineProperty(t,prop,{enumerable:false});
-    }
+    var h = rtl.hideProp;
     if (full){
       rtl.initStruct(t,parent,name);
       t.$record = t;
-      hide('$record');
-      hide('$name');
-      hide('$parent');
-      hide('$module');
+      h(t,'$record');
+      h(t,'$name');
+      h(t,'$parent');
+      h(t,'$module');
     }
     initfn.call(t);
     if (!t.$new){
-      t.$new = function(){ return Object.create(this); };
+      t.$new = function(){ return Object.create(t); };
     }
-    t.$clone = function(r){ return this.$new().$assign(r); };
-    hide('$new');
-    hide('$clone');
-    hide('$eq');
-    hide('$assign');
+    t.$clone = function(r){ return t.$new().$assign(r); };
+    h(t,'$new');
+    h(t,'$clone');
+    h(t,'$eq');
+    h(t,'$assign');
     return t;
   },
 
+  recNewS: function(parent,name,initfn,full){
+    // register specialized record type
+    parent[name] = function(){
+      rtl.recNewT(parent,name,initfn,full);
+    }
+  },
+
   is: function(instance,type){
     return type.isPrototypeOf(instance) || (instance===type);
   },