pastojs: create local record types in global scope

git-svn-id: trunk@40691 -

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -262,8 +262,7 @@ type
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
-    procedure UseRecordType(El: TPasRecordType; Mode: TPAUseMode); virtual;
-    procedure UseClassType(El: TPasClassType; Mode: TPAUseMode); virtual;
+    procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
@@ -1178,7 +1177,7 @@ begin
   UseInitFinal(aModule.FinalizationSection);
   ModScope:=aModule.CustomData as TPasModuleScope;
   if ModScope.RangeErrorClass<>nil then
-    UseClassType(ModScope.RangeErrorClass,paumElement);
+    UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
   if ModScope.RangeErrorConstructor<>nil then
     UseProcedure(ModScope.RangeErrorConstructor);
 
@@ -1815,10 +1814,8 @@ begin
     {$IFDEF VerbosePasAnalyzer}
     writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
     {$ENDIF}
-    if C=TPasRecordType then
-      UseRecordType(TPasRecordType(El),Mode)
-    else if C=TPasClassType then
-      UseClassType(TPasClassType(El),Mode);
+    if (C=TPasRecordType) or (C=TPasClassType) then
+      UseClassOrRecType(TPasMembersType(El),Mode);
     end
   else
     begin
@@ -1848,10 +1845,8 @@ begin
         UseExpr(TPasArrayType(El).Ranges[i]);
       UseElType(El,TPasArrayType(El).ElType,Mode);
       end
-    else if C=TPasRecordType then
-      UseRecordType(TPasRecordType(El),Mode)
-    else if C=TPasClassType then
-      UseClassType(TPasClassType(El),Mode)
+    else if (C=TPasRecordType) or (C=TPasClassType) then
+      UseClassOrRecType(TPasMembersType(El),Mode)
     else if C=TPasEnumType then
       begin
       if not MarkElementAsUsed(El) then exit;
@@ -1883,22 +1878,7 @@ begin
     end;
 end;
 
-procedure TPasAnalyzer.UseRecordType(El: TPasRecordType; Mode: TPAUseMode);
-// called by UseType
-var
-  i: Integer;
-begin
-  if Mode=paumAllExports then exit;
-  MarkElementAsUsed(El);
-  if not ElementVisited(El,Mode) then
-    begin
-    if (Mode=paumAllPasUsable) or Resolver.IsTGUID(El) then
-      for i:=0 to El.Members.Count-1 do
-        UseVariable(TObject(El.Members[i]) as TPasVariable,rraNone,true);
-    end;
-end;
-
-procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
+procedure TPasAnalyzer.UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode);
 // called by UseType
 
   procedure UseDelegations;
@@ -1936,7 +1916,7 @@ procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
         Map:=TPasClassIntfMap(o);
         repeat
           if Map.Intf<>nil then
-            UseClassType(TPasClassType(Map.Intf),paumElement);
+            UseClassOrRecType(TPasClassType(Map.Intf),paumElement);
           if Map.Procs<>nil then
             for j:=0 to Map.Procs.Count-1 do
               UseProcedure(TPasProcedure(Map.Procs[j]));
@@ -1960,6 +1940,7 @@ var
   o: TObject;
   Map: TPasClassIntfMap;
   ImplProc, IntfProc: TPasProcedure;
+  aClass: TPasClassType;
 begin
   FirstTime:=true;
   case Mode of
@@ -1982,35 +1963,54 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
   {$ENDIF}
-  if El.IsForward then
+  aClass:=nil;
+  ClassScope:=nil;
+  IsCOMInterfaceRoot:=false;
+
+  if El is TPasClassType then
     begin
-    Ref:=El.CustomData as TResolvedReference;
-    UseClassType(Ref.Declaration as TPasClassType,Mode);
-    exit;
-    end;
+    aClass:=TPasClassType(El);
+    if aClass.IsForward then
+      begin
+      Ref:=aClass.CustomData as TResolvedReference;
+      UseClassOrRecType(Ref.Declaration as TPasClassType,Mode);
+      exit;
+      end;
 
-  ClassScope:=El.CustomData as TPasClassScope;
-  if ClassScope=nil then
-    exit; // ClassScope can be nil if msIgnoreInterfaces
+    ClassScope:=aClass.CustomData as TPasClassScope;
+    if ClassScope=nil then
+      exit; // ClassScope can be nil if msIgnoreInterfaces
 
-  IsCOMInterfaceRoot:=false;
-  if FirstTime then
-    begin
-    UseElType(El,ClassScope.DirectAncestor,paumElement);
-    UseElType(El,El.HelperForType,paumElement);
-    UseExpr(El.GUIDExpr);
-    // El.Interfaces: using a class does not use automatically the interfaces
-    if El.ObjKind=okInterface then
+    if FirstTime then
       begin
-      UseDelegations;
-      if (El.InterfaceType=citCom) and (El.AncestorType=nil) then
-        IsCOMInterfaceRoot:=true;
+      UseElType(El,ClassScope.DirectAncestor,paumElement);
+      UseElType(El,aClass.HelperForType,paumElement);
+      UseExpr(aClass.GUIDExpr);
+      // aClass.Interfaces: using a class does not use automatically the interfaces
+      if aClass.ObjKind=okInterface then
+        begin
+        UseDelegations;
+        if (aClass.InterfaceType=citCom) and (aClass.AncestorType=nil) then
+          IsCOMInterfaceRoot:=true;
+        end;
+      if (aClass.ObjKind=okClass) and (ScopeModule<>nil)
+          and (ClassScope.Interfaces<>nil) then
+        // when checking a single unit, mark all method+properties implementing the interfaces
+        MarkAllInterfaceImplementations(ClassScope);
       end;
-    if (El.ObjKind=okClass) and (ScopeModule<>nil)
-        and (ClassScope.Interfaces<>nil) then
-      // when checking a single unit, mark all method+properties implementing the interfaces
-      MarkAllInterfaceImplementations(ClassScope);
-    end;
+    end
+  else if El is TPasRecordType then
+    begin
+    if (Mode<>paumAllPasUsable) and Resolver.IsTGUID(TPasRecordType(El)) then
+      for i:=0 to El.Members.Count-1 do
+        begin
+        Member:=TPasElement(El.Members[i]);
+        if Member is TPasVariable then
+          UseVariable(TPasVariable(Member),rraNone,true);
+        end;
+    end
+  else
+    RaiseNotSupported(20181229103139,El);
 
   // members
   AllPublished:=(Mode<>paumAllExports);
@@ -2074,11 +2074,11 @@ begin
       UseTypeInfo(Member);
       end
     else
-      ; // else: class is in unit interface, mark all non private members
+      ; // else: class/record is in unit interface, mark all non private members
     UseElement(Member,rraNone,true);
     end;
 
-  if FirstTime then
+  if FirstTime and (ClassScope<>nil) then
     begin
     // method resolution
     List:=ClassScope.Interfaces;
@@ -2090,7 +2090,7 @@ begin
           begin
           // interface delegation
           // Note: This class is used. When the intftype is used, this delegation is used.
-          AddOverride(TPasType(El.Interfaces[i]),TPasProperty(o));
+          AddOverride(TPasType(aClass.Interfaces[i]),TPasProperty(o));
           end
         else if o is TPasClassIntfMap then
           begin
@@ -2111,7 +2111,7 @@ begin
             end;
           end
         else
-          RaiseNotSupported(20180328224632,El,GetObjName(o));
+          RaiseNotSupported(20180328224632,aClass,GetObjName(o));
         end;
     end;
 end;

packages/pastojs/src/fppas2js.pp

@@ -1206,6 +1206,7 @@ type
     procedure InternalAdd(Item: TPasIdentifier);
     procedure OnClearHashItem(Item, Dummy: pointer);
   protected
+    // overloads: fix name clashes in JS
     FOverloadScopes: TFPList; // list of TPasIdentifierScope
     function HasOverloadIndex(El: TPasElement; WithElevatedLocal: boolean = false): boolean; virtual;
     function GetOverloadIndex(Identifier: TPasIdentifier;
@@ -1219,7 +1220,8 @@ type
     procedure RenameSubOverloads(Declarations: TFPList);
     procedure PushOverloadScope(Scope: TPasIdentifierScope);
     procedure PopOverloadScope;
-    procedure AddType(El: TPasType); override;
+  protected
+    procedure AddRecordType(El: TPasRecordType); override;
     procedure ResolveImplAsm(El: TPasImplAsmStatement); override;
     procedure ResolveNameExpr(El: TPasExpr; const aName: string;
       Access: TResolvedRefAccess); override;
@@ -1245,6 +1247,7 @@ type
     function AddExternalName(const aName: string; El: TPasElement): TPasIdentifier; virtual;
     function FindExternalName(const aName: String): TPasIdentifier; virtual;
     procedure AddExternalPath(aName: string; El: TPasElement);
+    procedure AddElevatedLocal(El: TPasElement); virtual;
     procedure ClearElementData; virtual;
     function GenerateGUID(El: TPasClassType): string; virtual;
   protected
@@ -1697,8 +1700,7 @@ type
     Function CreateRTTIClassField(V: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIClassMethod(Proc: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIClassProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
-    Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext;
-      var First, Last: TJSStatementList); virtual;
+    Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
     // create elements for interfaces
     Procedure AddIntfDelegations(ClassEl: TPasElement; Prop: TPasProperty;
       FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral; aContext: TFunctionContext);
@@ -2499,6 +2501,11 @@ begin
     if TPasClassType(El).IsForward then
       exit(false);
     end
+  else if C=TPasRecordType then
+    begin
+    if (not WithElevatedLocal) and (El.Parent is TProcedureBody) then
+      exit(false); // local record counted via TPas2JSSectionScope.FElevatedLocals
+    end
   else if C.InheritsFrom(TPasProcedure) then
     begin
     if TPasProcedure(El).IsOverride then
@@ -2592,7 +2599,8 @@ begin
     Scope:=TPasIdentifierScope(FOverloadScopes[i]);
     if (Scope.ClassType=TPas2JSSectionScope) and (i<FOverloadScopes.Count-1) then
       begin
-      // Note: the elevated locals are after the section scope and before the next deeper scope
+      // Note: the elevated locals have their index after the section scope and
+      //       before the next deeper scope
 
       // check elevated locals
       Identifier:=TPas2JSSectionScope(Scope).FindElevatedLocal(El.Name);
@@ -2609,14 +2617,12 @@ begin
         end;
       inc(Result,j);
       end;
-    // find last added
+    // add count or index of this scope
     Identifier:=Scope.FindLocalIdentifier(El.Name);
-    // add count or index
     inc(Result,GetOverloadIndex(Identifier,El));
     end;
-  // find in external names
+  // finally add count or index of the external scope
   Identifier:=FindExternalName(El.Name);
-  // add count or index
   inc(Result,GetOverloadIndex(Identifier,El));
 end;
 
@@ -2734,13 +2740,15 @@ var
   El: TPasElement;
   Proc: TPasProcedure;
   ProcScope, OvrProcScope, ImplProcScope: TPas2JSProcedureScope;
+  C: TClass;
 begin
   //IsExternalClass:=(DeclEl is TPasClassType) and (TPasClassType(DeclEl).IsExternal);
   if DeclEl=nil then;
   for i:=0 to Declarations.Count-1 do
     begin
     El:=TPasElement(Declarations[i]);
-    if (El is TPasProcedure) then
+    C:=El.ClassType;
+    if C.InheritsFrom(TPasProcedure) then
       begin
       Proc:=TPasProcedure(El);
       ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
@@ -2772,7 +2780,16 @@ begin
         end;
       // proc declaration (header, not body)
       RenameOverload(Proc);
-      end;
+      end
+    else if (C=TPasClassType) or (C=TPasRecordType) then
+      begin
+      if El.Parent is TProcedureBody then
+        RenameOverload(El);
+      end
+    else if C=TPasConst then
+      RenameOverload(El)
+    else if C.InheritsFrom(TPasVariable) and (El.Parent.ClassType=TPasClassType) then
+      RenameOverload(El);
     end;
   {$IFDEF VerbosePas2JS}
   //writeln('TPas2JSResolver.RenameOverloads END ',GetObjName(DeclEl));
@@ -2798,7 +2815,7 @@ begin
       Proc:=TPasProcedure(El);
       ProcScope:=Proc.CustomData as TPasProcedureScope;
       {$IFDEF VerbosePas2JS}
-      writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
+      //writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
       {$ENDIF}
       if Proc.Body<>nil then
         begin
@@ -2810,32 +2827,36 @@ begin
         PopOverloadScope;
         end;
       end
-    else if C=TPasClassType then
+    else if (C=TPasClassType) or (C=TPasRecordType) then
       begin
-      ClassEl:=TPasClassType(El);
-      if ClassEl.IsForward then continue;
-      ClassScope:=El.CustomData as TPas2JSClassScope;
       OldScopeCount:=FOverloadScopes.Count;
-
-      // add class and ancestor scopes
-      aScope:=ClassScope;
-      repeat
-        PushOverloadScope(aScope);
-        aScope:=aScope.AncestorScope;
-      until aScope=nil;
+      if C=TPasClassType then
+        begin
+        ClassEl:=TPasClassType(El);
+        if ClassEl.IsForward then continue;
+        ClassScope:=El.CustomData as TPas2JSClassScope;
+        // add class and ancestor scopes
+        aScope:=ClassScope;
+        repeat
+          PushOverloadScope(aScope);
+          aScope:=aScope.AncestorScope;
+        until aScope=nil;
+        end
+      else
+        begin
+        // add record scope
+        PushOverloadScope(TPasRecordType(El).CustomData as TPasRecordScope);
+        end;
 
       // first rename all overloads on this level
-      RenameOverloads(ClassEl,ClassEl.Members);
+      RenameOverloads(El,TPasMembersType(El).Members);
       // then process nested procedures
-      RenameSubOverloads(ClassEl.Members);
+      RenameSubOverloads(TPasMembersType(El).Members);
 
+      // restore scope
       while FOverloadScopes.Count>OldScopeCount do
         PopOverloadScope;
-      end
-    else if C=TPasConst then
-      RenameOverload(El)
-    else if C.InheritsFrom(TPasVariable) and (El.Parent.ClassType=TPasClassType) then
-      RenameOverload(El);
+      end;
     end;
   {$IFDEF VerbosePas2JS}
   //writeln('TPas2JSResolver.RenameSubOverloads END');
@@ -2852,9 +2873,12 @@ begin
   FOverloadScopes.Delete(FOverloadScopes.Count-1);
 end;
 
-procedure TPas2JSResolver.AddType(El: TPasType);
+procedure TPas2JSResolver.AddRecordType(El: TPasRecordType);
 begin
-  inherited AddType(El);
+  inherited;
+  if El.Parent is TProcedureBody then
+    // local record
+    AddElevatedLocal(El);
 end;
 
 procedure TPas2JSResolver.ResolveImplAsm(El: TPasImplAsmStatement);
@@ -3307,8 +3331,6 @@ var
   AbsIdent: TPasElement;
   TypeEl, ElTypeEl: TPasType;
   GUID: TGUID;
-  i: Integer;
-  SectionScope: TPas2JSSectionScope;
 begin
   inherited FinishVariable(El);
 
@@ -3389,12 +3411,7 @@ begin
     if (El.ClassType=TPasConst) and TPasConst(El).IsConst then
       begin
       // local const
-      i:=ScopeCount-1;
-      while (i>=0) and not (Scopes[i] is TPas2JSSectionScope) do dec(i);
-      if i<0 then
-        RaiseNotYetImplemented(20180420131358,El);
-      SectionScope:=TPas2JSSectionScope(Scopes[i]);
-      SectionScope.AddElevatedLocal(El.Name,El);
+      AddElevatedLocal(El);
       end;
     end
   else if ParentC=TImplementationSection then
@@ -3846,6 +3863,19 @@ begin
   AddExternalName(LeftStr(aName,p-1),El);
 end;
 
+procedure TPas2JSResolver.AddElevatedLocal(El: TPasElement);
+var
+  i: Integer;
+  SectionScope: TPas2JSSectionScope;
+begin
+  i:=ScopeCount-1;
+  while (i>=0) and not (Scopes[i] is TPas2JSSectionScope) do dec(i);
+  if i<0 then
+    RaiseNotYetImplemented(20180420131358,El);
+  SectionScope:=TPas2JSSectionScope(Scopes[i]);
+  SectionScope.AddElevatedLocal(El.Name,El);
+end;
+
 procedure TPas2JSResolver.ClearElementData;
 var
   Data, Next: TPas2JsElementData;
@@ -7086,7 +7116,7 @@ var
 begin
   if PosEl=nil then PosEl:=El;
   CurName:=TransformVariableName(El,Name,false,AContext);
-  if not (El.Parent is TProcedureBody) then
+  if AContext.IsGlobal then
     begin
     ParentName:=AContext.GetLocalName(El.Parent);
     if ParentName='' then
@@ -15260,20 +15290,33 @@ begin
 end;
 
 procedure TPasToJSConverter.CreateRTTIAnonymous(El: TPasType;
-  AContext: TConvertContext; var First, Last: TJSStatementList);
+  AContext: TConvertContext);
 // if El has any anonymous types, create the RTTI
 var
   C: TClass;
   JS: TJSElement;
+  GlobalCtx: TFunctionContext;
+  Src: TJSSourceElements;
 begin
   if El.Name<>'' then
     RaiseNotSupported(El,AContext,20170905162324,'inconsistency');
 
+  GlobalCtx:=AContext.GetGlobalFunc;
+  if GlobalCtx=nil then
+    RaiseNotSupported(El,AContext,20181229130835);
+  if not (GlobalCtx.JSElement is TJSSourceElements) then
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateRTTIAnonymous GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
+    {$ENDIF}
+    RaiseNotSupported(El,AContext,20181229130926);
+    end;
+  Src:=TJSSourceElements(GlobalCtx.JSElement);
   C:=El.ClassType;
   if C=TPasArrayType then
     begin
     JS:=ConvertArrayType(TPasArrayType(El),AContext);
-    AddToStatementList(First,Last,JS,El);
+    AddToSourceElements(Src,JS);
     end;
 end;
 
@@ -19219,7 +19262,7 @@ Var
   AssignSt: TJSSimpleAssignStatement;
   Obj: TJSObjectLiteral;
   ObjLit: TJSObjectLiteralElement;
-  ConstContext: TFunctionContext;
+  GlobalCtx: TFunctionContext;
   C: TJSElement;
   V: TJSVariableStatement;
   Src: TJSSourceElements;
@@ -19234,15 +19277,15 @@ begin
   if not AContext.IsGlobal then
     begin
     // local const are stored in interface/implementation
-    ConstContext:=AContext.GetGlobalFunc;
-    if not (ConstContext.JSElement is TJSSourceElements) then
+    GlobalCtx:=AContext.GetGlobalFunc;
+    if not (GlobalCtx.JSElement is TJSSourceElements) then
       begin
       {$IFDEF VerbosePas2JS}
-      writeln('TPasToJSConverter.CreateConstDecl ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
+      writeln('TPasToJSConverter.CreateConstDecl GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
       {$ENDIF}
       RaiseNotSupported(El,AContext,20170220153216);
       end;
-    Src:=TJSSourceElements(ConstContext.JSElement);
+    Src:=TJSSourceElements(GlobalCtx.JSElement);
     C:=ConvertVariable(El,AContext);
     if C=nil then
       RaiseInconsistency(20180501114422,El);
@@ -19571,7 +19614,7 @@ const
       RetSt.Expr:=CreateLiteralBoolean(El,true);
   end;
 
-  procedure AddRTTIFields(Args: TJSArguments; var First, Last: TJSStatementList);
+  procedure AddRTTIFields(Args: TJSArguments);
   var
     i: Integer;
     PasVar: TPasVariable;
@@ -19583,7 +19626,7 @@ const
       if not IsElementUsed(PasVar) then continue;
       VarType:=PasVar.VarType;
       if VarType.Name='' then
-        CreateRTTIAnonymous(VarType,AContext,First,Last);
+        CreateRTTIAnonymous(VarType,AContext);
       // add quoted "fieldname"
       Args.AddElement(CreateLiteralString(PasVar,TransformVariableName(PasVar,AContext)));
       // add typeinfo ref
@@ -19595,40 +19638,54 @@ var
   AssignSt: TJSSimpleAssignStatement;
   FDS: TJSFunctionDeclarationStatement;
   FD: TJSFuncDef;
-  BodyFirst, BodyLast, ListFirst, ListLast: TJSStatementList;
+  BodyFirst, BodyLast, ListFirst: TJSStatementList;
   FuncContext: TFunctionContext;
+  GlobalCtx: TConvertContext;
   ObjLit: TJSObjectLiteral;
   IfSt: TJSIfStatement;
   Call, Call2: TJSCallExpression;
   ok: Boolean;
+  Src: TJSSourceElements;
+  Proc: TPasProcedure;
+  ProcScope: TPas2JSProcedureScope;
 begin
+  if El.Name='' then
+    RaiseNotSupported(El,AContext,20181229133138,'anonymous record');
   Result:=nil;
   FuncContext:=nil;
   ListFirst:=nil;
-  ListLast:=nil;
+  Src:=nil;
   ok:=false;
   try
     FDS:=CreateFunctionSt(El);
     FD:=FDS.AFunction;
+    // records are stored in interface/implementation
+    GlobalCtx:=AContext;
     if El.Parent is TProcedureBody then
       begin
-      // ToDo: elevate to non local scope
-      // add 'function TypeName(){}'
-      Result:=FDS;
-      FD.Name:=TJSString(TransformVariableName(El,AContext));
-      end
+      GlobalCtx:=AContext.GetGlobalFunc;
+      if not (GlobalCtx.JSElement is TJSSourceElements) then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.ConvertRecordType GlobalCtx=',GetObjName(GlobalCtx),' JSElement=',GetObjName(GlobalCtx.JSElement));
+        {$ENDIF}
+        RaiseNotSupported(El,AContext,20181229142440);
+        end;
+      Src:=TJSSourceElements(GlobalCtx.JSElement);
+      end;
+    // add 'this.TypeName = function(){}'
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignSt.LHS:=CreateSubDeclNameExpr(El,GlobalCtx);
+    AssignSt.Expr:=FDS;
+    if Src<>nil then
+      AddToSourceElements(Src,AssignSt)
     else
-      begin
-      // add 'this.TypeName = function(){}'
-      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
       Result:=AssignSt;
-      AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
-      AssignSt.Expr:=FDS;
-      end;
+
     // add param s
     FD.Params.Add(SrcParamName);
     // create function body
-    FuncContext:=TFunctionContext.Create(El,FD.Body,AContext);
+    FuncContext:=TFunctionContext.Create(El,FD.Body,GlobalCtx);
     FuncContext.ThisPas:=El;
     FuncContext.IsGlobal:=true;
     BodyFirst:=nil;
@@ -19650,16 +19707,14 @@ begin
     if FD.Body.A=nil then
       FD.Body.A:=BodyFirst;
 
-    if HasTypeInfo(El,AContext) then
+    if HasTypeInfo(El,GlobalCtx) then
       begin
       // add $rtti as second statement
-      if not (AContext is TFunctionContext) then
-        RaiseNotSupported(El,AContext,20170412120012);
+      if not (GlobalCtx is TFunctionContext) then
+        RaiseNotSupported(El,GlobalCtx,20170412120012);
 
-      AddToStatementList(ListFirst,ListLast,Result,El);
-      Result:=nil;
       // module.$rtti.$Record("typename",{});
-      Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewRecord),false,AContext,ObjLit);
+      Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewRecord),false,GlobalCtx,ObjLit);
       if ObjLit=nil then
         RaiseInconsistency(20170412124804,El);
       if El.Members.Count>0 then
@@ -19671,19 +19726,37 @@ begin
         Call2.Expr:=CreateDotExpression(El,Call,
           CreatePrimitiveDotExpr(GetBIName(pbifnRTTIAddFields),El));
         Call:=Call2;
-        AddRTTIFields(Call.Args,ListFirst,ListLast);
+        AddRTTIFields(Call.Args);
+        end;
+      if Src<>nil then
+        // add Call to global statements
+        AddToSourceElements(Src,Call)
+      else
+        begin
+        // combine Result and Call into a statement list
+        ListFirst:=TJSStatementList(CreateElement(TJSStatementList,El));
+        ListFirst.A:=Result;
+        ListFirst.B:=Call;
+        Result:=ListFirst;
+        ListFirst:=nil;
+        end;
+
+      if (GlobalCtx<>AContext) and (coStoreImplJS in Options)
+          and (AContext.Resolver<>nil) then
+        begin
+        // store precompiled record type in proc
+        Proc:=AContext.Resolver.GetTopLvlProc(AContext.PasElement);
+        if Proc<>nil then
+          begin
+          ProcScope:=TPas2JSProcedureScope(Proc.CustomData);
+          ProcScope.AddGlobalJS(CreatePrecompiledJS(AssignSt));
+          end;
         end;
-      AddToStatementList(ListFirst,ListLast,Call,El);
-      Result:=ListFirst;
-      ListFirst:=nil;
-      ListLast:=nil;
       end;
     ok:=true;
   finally
     FuncContext.Free;
-    if ListFirst<>nil then
-      FreeAndNil(ListFirst)
-    else if not ok then
+    if not ok then
       FreeAndNil(Result);
   end;
 end;

packages/pastojs/tests/tcfiler.pas

@@ -90,6 +90,7 @@ type
     procedure CheckRestoredPrimitiveExpr(const Path: string; Orig, Rest: TPrimitiveExpr); virtual;
     procedure CheckRestoredBoolConstExpr(const Path: string; Orig, Rest: TBoolConstExpr); virtual;
     procedure CheckRestoredParamsExpr(const Path: string; Orig, Rest: TParamsExpr); virtual;
+    procedure CheckRestoredProcedureExpr(const Path: string; Orig, Rest: TProcedureExpr); virtual;
     procedure CheckRestoredRecordValues(const Path: string; Orig, Rest: TRecordValues); virtual;
     procedure CheckRestoredPasExprArray(const Path: string; Orig, Rest: TPasExprArray); virtual;
     procedure CheckRestoredArrayValues(const Path: string; Orig, Rest: TArrayValues); virtual;
@@ -140,6 +141,7 @@ type
     procedure TestPC_Set;
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_Record;
+    procedure TestPC_Record_Local;
     procedure TestPC_JSValue;
     procedure TestPC_Array;
     procedure TestPC_ArrayOfAnonymous;
@@ -149,6 +151,7 @@ type
     procedure TestPC_Proc_UTF8;
     procedure TestPC_Proc_Arg;
     procedure TestPC_ProcType;
+    procedure TestPC_Proc_Anonymous;
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
@@ -1078,6 +1081,8 @@ begin
     CheckRestoredPasExpr(Path,TPasExpr(Orig),TPasExpr(Rest))
   else if C=TParamsExpr then
     CheckRestoredParamsExpr(Path,TParamsExpr(Orig),TParamsExpr(Rest))
+  else if C=TProcedureExpr then
+    CheckRestoredProcedureExpr(Path,TProcedureExpr(Orig),TProcedureExpr(Rest))
   else if C=TRecordValues then
     CheckRestoredRecordValues(Path,TRecordValues(Orig),TRecordValues(Rest))
   else if C=TArrayValues then
@@ -1259,6 +1264,13 @@ begin
   CheckRestoredPasExpr(Path,Orig,Rest);
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredProcedureExpr(const Path: string;
+  Orig, Rest: TProcedureExpr);
+begin
+  CheckRestoredProcedure(Path+'$Ano',Orig.Proc,Rest.Proc);
+  CheckRestoredPasExpr(Path,Orig,Rest);
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredRecordValues(const Path: string;
   Orig, Rest: TRecordValues);
 var
@@ -1691,6 +1703,28 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Record_Local;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'procedure DoIt;',
+  'implementation',
+  'procedure DoIt;',
+  'type',
+  '  TRec = record',
+  '    i: longint;',
+  '    s: string;',
+  '  end;',
+  '  P = ^TRec;',
+  '  TArrOfRec = array of TRec;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  'end;']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_JSValue;
 begin
   StartUnit(false);
@@ -1866,6 +1900,32 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Proc_Anonymous;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TFunc = reference to function(w: word): word;',
+  '  function GetIt(f: TFunc): longint;',
+  'implementation',
+  'var k: byte;',
+  'function GetIt(f: TFunc): longint;',
+  'begin',
+  '  f:=function(w: word): word',
+  '    var j: byte;',
+  '      function GetMul(a,b: longint): longint; ',
+  '      begin',
+  '        Result:=a*b;',
+  '      end;',
+  '    begin',
+  '      Result:=j*GetMul(1,2)*k;',
+  '    end;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 begin
   StartUnit(false);

packages/pastojs/tests/tcmodules.pas

@@ -431,7 +431,7 @@ type
     Procedure TestRecord_Empty;
     Procedure TestRecord_Var;
     Procedure TestRecord_VarExternal;
-    Procedure TestWithRecordDo;
+    Procedure TestRecord_WithDo;
     Procedure TestRecord_Assign;
     Procedure TestRecord_PassAsArgClone;
     Procedure TestRecord_AsParams;
@@ -445,6 +445,12 @@ type
     Procedure TestRecord_Const;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_InFunction;
+    // Test name clash const and local record
+    // Test RTTI of local record
+    // Test pcu local record, name clash and rtti
+
+    // advanced record
+    // ToDo: TestRecord_InFunction;
 
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
@@ -9127,7 +9133,7 @@ begin
     ]));
 end;
 
-procedure TTestModule.TestWithRecordDo;
+procedure TTestModule.TestRecord_WithDo;
 begin
   StartProgram(false);
   Add('type');
@@ -9760,6 +9766,7 @@ procedure TTestModule.TestRecord_InFunction;
 begin
   StartProgram(false);
   Add([
+  'var TPoint: longint = 3;',
   'procedure DoIt;',
   'type',
   '  TPoint = record x,y: longint; end;',
@@ -9774,22 +9781,23 @@ begin
   ConvertProgram;
   CheckSource('TestRecord_InFunction',
     LinesToStr([ // statements
-    'this.DoIt = function () {',
-    '  function TPoint(s) {',
-    '    if (s) {',
-    '      this.x = s.x;',
-    '      this.y = s.y;',
-    '    } else {',
-    '      this.x = 0;',
-    '      this.y = 0;',
-    '    };',
-    '    this.$equal = function (b) {',
-    '      return (this.x === b.x) && (this.y === b.y);',
-    '    };',
+    'this.TPoint = 3;',
+    'this.TPoint$1 = function (s) {',
+    '  if (s) {',
+    '    this.x = s.x;',
+    '    this.y = s.y;',
+    '  } else {',
+    '    this.x = 0;',
+    '    this.y = 0;',
     '  };',
-    '  var r = new TPoint();',
+    '  this.$equal = function (b) {',
+    '    return (this.x === b.x) && (this.y === b.y);',
+    '  };',
+    '};',
+    'this.DoIt = function () {',
+    '  var r = new TPoint$1();',
     '  var p = [];',
-    '  p = rtl.arraySetLength(p, TPoint, 2);',
+    '  p = rtl.arraySetLength(p, TPoint$1, 2);',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -21857,6 +21865,9 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
+    '$mod.$rtti.$DynArray("TFloatRec.d$a", {',
+    '  eltype: rtl.char',
+    '});',
     'this.TFloatRec = function (s) {',
     '  if (s) {',
     '    this.d = s.d;',
@@ -21867,9 +21878,6 @@ begin
     '    return this.d === b.d;',
     '  };',
     '};',
-    '$mod.$rtti.$DynArray("TFloatRec.d$a", {',
-    '  eltype: rtl.char',
-    '});',
     '$mod.$rtti.$Record("TFloatRec", {}).addFields("d", $mod.$rtti["TFloatRec.d$a"]);',
     'this.p = null;',
     'this.r = new $mod.TFloatRec();',
@@ -21898,20 +21906,20 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_LocalTypes',
     LinesToStr([ // statements
-    'this.DoIt = function () {',
-    '  function TPoint(s) {',
-    '    if (s) {',
-    '      this.x = s.x;',
-    '      this.y = s.y;',
-    '    } else {',
-    '      this.x = 0;',
-    '      this.y = 0;',
-    '    };',
-    '    this.$equal = function (b) {',
-    '      return (this.x === b.x) && (this.y === b.y);',
-    '    };',
+    'this.TPoint = function(s) {',
+    '  if (s) {',
+    '    this.x = s.x;',
+    '    this.y = s.y;',
+    '  } else {',
+    '    this.x = 0;',
+    '    this.y = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return (this.x === b.x) && (this.y === b.y);',
     '  };',
     '};',
+    'this.DoIt = function () {',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '']));