pastojs: filer: specializetype after spec was already created

git-svn-id: trunk@47199 -

packages/pastojs/src/fppas2js.pp

@@ -1112,6 +1112,13 @@ type
   end;
   TPas2JsElementDataClass = class of TPas2JsElementData;
 
+  TPas2JSStoredLocalVar = class(TPasElementBase)
+  public
+    Name: string;
+    Element: TPasElement;
+  end;
+  TPas2JSStoredLocalVarArray = array of TPas2JSStoredLocalVar;
+
   TPas2JSModuleScopeFlag = (
     p2msfPromiseSearched // TJSPromise searched
     );
@@ -1126,6 +1133,8 @@ type
   public
     FlagsJS: TPas2JSModuleScopeFlags;
     SystemVarRecs: TPasFunction;
+    StoreJSLocalVars: TPas2JSStoredLocalVarArray; // only with coStoreImplJS
+    procedure ClearStoreJSLocalVars;
     destructor Destroy; override;
     property JSPromiseClass: TPasClassType read FJSPromiseClass write SetJSPromiseClass;
   end;
@@ -2025,6 +2034,7 @@ type
     Function CreateGlobalElPath(El: TPasElement; AContext: TConvertContext): string; virtual;
     Function GetLocalName(El: TPasElement; const Filter: TCtxVarKinds; AContext: TConvertContext): string;
     Procedure StoreImplJSLocal(El: TPasElement; AContext: TConvertContext); virtual;
+    Procedure StoreImplJSLocals(ModScope: TPas2JSModuleScope; IntfContext: TSectionContext); virtual;
     // section
     Function CreateImplementationSection(El: TPasModule; IntfContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement; virtual;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
@@ -2515,8 +2525,18 @@ begin
     FJSPromiseClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPas2JSModuleScope.SetJSPromiseClass'){$ENDIF};
 end;
 
+procedure TPas2JSModuleScope.ClearStoreJSLocalVars;
+var
+  i: Integer;
+begin
+  for i:=0 to length(StoreJSLocalVars)-1 do
+    FreeAndNil(StoreJSLocalVars[i]);
+  StoreJSLocalVars:=nil;
+end;
+
 destructor TPas2JSModuleScope.Destroy;
 begin
+  ClearStoreJSLocalVars;
   JSPromiseClass:=nil;
   inherited Destroy;
 end;
@@ -7824,6 +7844,7 @@ Var
   Lib: TPasLibrary;
   AssignSt: TJSSimpleAssignStatement;
   IntfSecCtx: TInterfaceSectionContext;
+  ModScope: TPas2JSModuleScope;
 begin
   Result:=Nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@@ -7943,6 +7964,12 @@ begin
         CreateInitSection(El,Src,IntfSecCtx);
 
         end;
+
+      if AContext.Resolver<>nil then
+        begin
+        ModScope:=El.CustomData as TPas2JSModuleScope;
+        StoreImplJSLocals(ModScope,IntfContext);
+        end;
     finally
       IntfContext.Free;
     end;
@@ -24496,6 +24523,38 @@ begin
     end;
 end;
 
+procedure TPasToJSConverter.StoreImplJSLocals(ModScope: TPas2JSModuleScope;
+  IntfContext: TSectionContext);
+var
+  i, StoredIndex: Integer;
+  CtxVar: TFCLocalIdentifier;
+  StoredVar: TPas2JSStoredLocalVar;
+  CurName: String;
+begin
+  ModScope.ClearStoreJSLocalVars;
+  SetLength(ModScope.StoreJSLocalVars,length(IntfContext.LocalVars));
+  StoredIndex:=0;
+  for i:=0 to length(IntfContext.LocalVars)-1 do
+    begin
+    CtxVar:=IntfContext.LocalVars[i];
+    if (CtxVar.Element=nil) or (CtxVar.Kind<>cvkGlobal) then
+      continue;
+    if CtxVar.Element.Parent is TProcedureBody then
+      continue;
+    CurName:=CtxVar.Name;
+    if (CurName='') or (CurName='this')
+        or (CurName=GetBIName(pbivnModule))
+        or (CurName=GetBIName(pbivnImplementation))
+      then continue;
+    StoredVar:=TPas2JSStoredLocalVar.Create;
+    StoredVar.Name:=CurName;
+    StoredVar.Element:=CtxVar.Element;
+    ModScope.StoreJSLocalVars[StoredIndex]:=StoredVar;
+    inc(StoredIndex);
+    end;
+  SetLength(ModScope.StoreJSLocalVars,StoredIndex);
+end;
+
 procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
   Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext);
 // create a call, adding call by reference and default values

packages/pastojs/src/pas2jsfiler.pp

@@ -91,7 +91,7 @@ uses
   {$endif}
   fpjson, jsonparser, jsonscanner,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver,
-  Pas2jsFileUtils, FPPas2Js;
+  Pas2jsFileUtils, FPPas2Js, jsbase;
 
 const
   PCUMagic = 'Pas2JSCache';
@@ -242,7 +242,8 @@ const
     'Goto'
     );
 
-  PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];
+  PCUDefaultConverterOptions: TPasToJsConverterOptions =
+    [coUseStrict,coStoreImplJS,coShortRefGlobals,coShortRefGenFunc];
   PCUConverterOptions: array[TPasToJsConverterOption] of string = (
     'LowerCase',
     'SwitchStatement',
@@ -1016,6 +1017,7 @@ type
     procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_SystemTVarRec(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_SystemVarRecs(RefEl: TPasElement; Data: TObject);
+    procedure Set_LocalVar(RefEl: TPasElement; Data: TObject);
     procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
     procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
@@ -1842,6 +1844,7 @@ var
 begin
   Obj:=nil;
   GenericEl:=nil;
+  RefEl:=nil;
   if Params<>nil then
     begin
     for i:=0 to Params.Count-1 do
@@ -2152,7 +2155,7 @@ begin
   ParserOptions:=PCUDefaultParserOptions;
   ModeSwitches:=PCUDefaultModeSwitches;
   BoolSwitches:=PCUDefaultBoolSwitches;
-  ConverterOptions:=PCUDefaultConverterOptions;
+  ConverterOptions:=PCUDefaultConverterOptions-[coStoreImplJS];
   TargetPlatform:=PCUDefaultTargetPlatform;
   TargetProcessor:=PCUDefaultTargetProcessor;
 end;
@@ -2778,6 +2781,10 @@ procedure TPCUWriter.WriteModuleScope(Obj: TJSONObject;
   Scope: TPas2JSModuleScope; aContext: TPCUWriterContext);
 var
   aModule: TPasModule;
+  i: Integer;
+  SubObj: TJSONObject;
+  LocalVar: TPas2JSStoredLocalVar;
+  LocalVars: TPas2JSStoredLocalVarArray;
 begin
   aModule:=Scope.Element as TPasModule;
   if Scope.FirstName<>FirstDottedIdentifier(aModule.Name) then
@@ -2792,6 +2799,24 @@ begin
   AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
   AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
   AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
+
+  // StoreJSLocalVars
+  LocalVars:=Scope.StoreJSLocalVars;
+  if length(LocalVars)>0 then
+    begin
+    SubObj:=TJSONObject.Create;
+    Obj.Add('LocalVars',SubObj);
+    for i:=0 to length(LocalVars)-1 do
+      begin
+      LocalVar:=LocalVars[i];
+      if LocalVar.Name='' then
+        RaiseMsg(20201023013605,Scope.Element,GetObjPath(LocalVar.Element));
+      if LocalVar.Element=nil then
+        RaiseMsg(20201023013954,Scope.Element,LocalVar.Name);
+      AddReferenceToObj(SubObj,LocalVar.Name,LocalVar.Element);
+      end;
+    end;
+
   WritePasScope(Obj,Scope,aContext);
 end;
 
@@ -5315,6 +5340,13 @@ begin
     RaiseMsg(20190215230857,Scope.Element,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_LocalVar(RefEl: TPasElement; Data: TObject);
+var
+  LocalVar: TPas2JSStoredLocalVar absolute Data;
+begin
+  LocalVar.Element:=RefEl;
+end;
+
 procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
   Data: TObject);
 var
@@ -5449,7 +5481,7 @@ function TPCUReader.CreateSpecializedElement(
 var
   RefParams, ElParams: TFPList;
   i, Id: Integer;
-  SpecEl: TPasElement;
+  SpecEl, RefEl: TPasElement;
   Param: TPCUReaderPendingSpecializedParam;
   Ref: TPCUFilerElementRef;
   Obj: TJSONObject;
@@ -5457,9 +5489,10 @@ var
 begin
   Result:=false;
   {$IFDEF VerbosePCUFiler}
-  writeln('TPCUReader.CreateSpecializedElement Gen=',GetObjPath(PendSpec.GenericEl));
+  writeln('TPCUReader.CreateSpecializedElement Gen=',GetObjPath(PendSpec.GenericEl),' ',PendSpec.SpecName);
   {$ENDIF}
-  if PendSpec.RefEl=nil then
+  RefEl:=PendSpec.RefEl;
+  if RefEl=nil then
     begin
     if PendSpec.GenericEl=nil then
       RaiseMsg(20200531101241,PendSpec.SpecName)
@@ -5467,7 +5500,7 @@ begin
       RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize
     end;
   if PendSpec.GenericEl=nil then
-    RaiseMsg(20200531101333,PendSpec.RefEl,PendSpec.SpecName);
+    RaiseMsg(20200531101333,RefEl,PendSpec.SpecName);
   Obj:=PendSpec.Obj;
   if Obj=nil then
     RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON
@@ -5480,7 +5513,7 @@ begin
     begin
     Param:=TPCUReaderPendingSpecializedParam(RefParams[i]);
     if Param.Element<>nil then continue;
-    Ref:=GetElReference(Param.Id,PendSpec.RefEl);
+    Ref:=GetElReference(Param.Id,RefEl);
     if Ref=nil then
       begin
       //writeln('TPCUReader.CreateSpecializedElement SpecName=',PendSpec.SpecName,' Id=',PendSpec.Id,' WAITING for param ',i,': ',Param.Id);
@@ -5497,7 +5530,7 @@ begin
     GenericEl:=PendSpec.GenericEl;
     SpecEl:=Resolver.GetSpecializedEl(Resolver.RootElement,GenericEl,ElParams);
     DeletePendingSpecialize(PendSpec);
-    Ref:=AddElReference(Id,PendSpec.RefEl,SpecEl);
+    AddElReference(Id,RefEl,SpecEl);
   finally
     ElParams.Free;
   end;
@@ -5547,6 +5580,7 @@ begin
       NextPendSpec:=PendSpec.Next;
       if PendSpec.RefEl=nil then
         begin
+        // no referrer -> use the first element, waiting for this ID
         Ref:=GetElReference(PendSpec.Id,PendSpec.GenericEl);
         if Ref<>nil then
           PendSpec.RefEl:=GetReferrerEl(Ref.Pending);
@@ -5554,6 +5588,7 @@ begin
       if (PendSpec.RefEl<>nil) and (PendSpec.GenericEl<>nil) then
         begin
         if CreateSpecializedElement(PendSpec) then
+          // Note: PendSpec has been freed
           Changed:=true
         else
           UnresolvedSpec:=PendSpec;
@@ -5566,6 +5601,7 @@ begin
   if UnresolvedSpec<>nil then
     begin
     {$IF defined(VerbosePJUFiler) or defined(VerbosePas2JS)}
+    writeln('TPCUReader.ResolveSpecializedElements Complete=',Complete);
     PendSpec:=FPendingSpecialize;
     while PendSpec<>nil do
       begin
@@ -6641,6 +6677,8 @@ begin
   if ReadInteger(Obj,'Id',Id,El) then
     begin
     Ref:=AddElReference(Id,El,El);
+    if (Ref.Obj<>nil) and (Ref.Obj<>Obj) then
+      RaiseMsg(20201025181840,El);
     Ref.Obj:=Obj;
     end;
   if ReadArray(Obj,'El',Arr,El) then
@@ -6938,6 +6976,8 @@ begin
     ErrorEl:=TPasElement(Instance)
   else if Instance is TResolveData then
     ErrorEl:=TResolveData(Instance).Element
+  else if Instance is TPas2JSStoredLocalVar then
+    ErrorEl:=TPasElement(TPas2JSStoredLocalVar(Instance).CustomData)
   else
     RaiseMsg(20180211120642,GetObjName(Instance)+'.'+PropName);
   if Data is TJSONIntegerNumber then
@@ -7475,6 +7515,9 @@ procedure TPCUReader.ReadModuleScope(Obj: TJSONObject;
   Scope: TPas2JSModuleScope; aContext: TPCUReaderContext);
 var
   aModule: TPasModule;
+  SubObj: TJSONObject;
+  Cnt, i: Integer;
+  LocalVar: TPas2JSStoredLocalVar;
 begin
   aModule:=Scope.Element as TPasModule;
   Scope.FirstName:=FirstDottedIdentifier(aModule.Name);
@@ -7487,6 +7530,25 @@ begin
   ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
   ReadElementReference(Obj,Scope,'SystemTVarRec',@Set_ModScope_SystemTVarRec);
   ReadElementReference(Obj,Scope,'SystemVarRecs',@Set_ModScope_SystemVarRecs);
+
+  if ReadObject(Obj,'LocalVars',SubObj,aModule) then
+    begin
+    Cnt:=SubObj.Count;
+    SetLength(Scope.StoreJSLocalVars,Cnt);
+    for i:=0 to Cnt-1 do
+      Scope.StoreJSLocalVars[i]:=nil;
+    for i:=0 to Cnt-1 do
+      begin
+      LocalVar:=TPas2JSStoredLocalVar.Create;
+      LocalVar.CustomData:=aModule;
+      Scope.StoreJSLocalVars[i]:=LocalVar;
+      LocalVar.Name:=SubObj.Names[i];
+      if not IsValidJSIdentifier(TJSString(LocalVar.Name)) then
+        RaiseMsg(20201023015048,aModule);
+      ReadElementReference(SubObj,LocalVar,LocalVar.Name,@Set_LocalVar);
+      end;
+    end;
+
   ReadPasScope(Obj,Scope,aContext);
 end;
 
@@ -8185,7 +8247,8 @@ begin
   if SpecName='' then
     RaiseMsg(20200530134152,El);
 
-  PromiseSpecialize(SpecId,SpecName,El,El);
+  if Data.SpecializedType=nil then
+    PromiseSpecialize(SpecId,SpecName,El,El);
 end;
 
 procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
@@ -9708,7 +9771,7 @@ begin
     'InitParserOpts': InitialFlags.ParserOptions:=ReadParserOptions(Obj,nil,aName,PCUDefaultParserOptions);
     'InitModeSwitches': InitialFlags.ModeSwitches:=ReadModeSwitches(Obj,nil,aName,PCUDefaultModeSwitches);
     'InitBoolSwitches': InitialFlags.BoolSwitches:=ReadBoolSwitches(Obj,nil,aName,PCUDefaultBoolSwitches);
-    'InitConverterOpts': InitialFlags.ConverterOptions:=ReadConverterOptions(Obj,nil,aName,PCUDefaultConverterOptions);
+    'InitConverterOpts': InitialFlags.ConverterOptions:=ReadConverterOptions(Obj,nil,aName,PCUDefaultConverterOptions-[coStoreImplJS]);
     'FinalParserOpts': Parser.Options:=ReadParserOptions(Obj,nil,aName,InitialFlags.ParserOptions);
     'FinalModeSwitches': Scanner.CurrentModeSwitches:=ReadModeSwitches(Obj,nil,aName,InitialFlags.ModeSwitches);
     'FinalBoolSwitches': Scanner.CurrentBoolSwitches:=ReadBoolSwitches(Obj,nil,aName,InitialFlags.BoolSwitches);

packages/pastojs/tests/tcfiler.pas

@@ -76,6 +76,7 @@ type
     procedure CheckRestoredElementBase(const Path: string; Orig, Rest: TPasElementBase; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredResolveData(const Path: string; Orig, Rest: TResolveData; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredPasScope(const Path: string; Orig, Rest: TPasScope; Flags: TPCCheckFlags); virtual;
+    procedure CheckRestoredLocalVar(const Path: string; Orig, Rest: TPas2JSStoredLocalVar); virtual;
     procedure CheckRestoredModuleScope(const Path: string; Orig, Rest: TPas2JSModuleScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredIdentifierScope(const Path: string; Orig, Rest: TPasIdentifierScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPas2JSSectionScope; Flags: TPCCheckFlags); virtual;
@@ -801,8 +802,19 @@ begin
   CheckRestoredResolveData(Path,Orig,Rest,Flags);
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredLocalVar(const Path: string; Orig,
+  Rest: TPas2JSStoredLocalVar);
+begin
+  AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
+  CheckRestoredReference(Path+'.Id',Orig.Element,Rest.Element);
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredModuleScope(const Path: string;
   Orig, Rest: TPas2JSModuleScope; Flags: TPCCheckFlags);
+var
+  OrigLocalVars, RestLocalVars: TPas2JSStoredLocalVarArray;
+  i, j: Integer;
+  OrigLocalVar, RestLocalVar: TPas2JSStoredLocalVar;
 begin
   AssertEquals(Path+'.FirstName',Orig.FirstName,Rest.FirstName);
   if Orig.Flags<>Rest.Flags then
@@ -816,6 +828,32 @@ begin
   CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
   CheckRestoredReference(Path+'.SystemTVarRec',Orig.SystemTVarRec,Rest.SystemTVarRec);
   CheckRestoredReference(Path+'.SystemVarRecs',Orig.SystemVarRecs,Rest.SystemVarRecs);
+
+  // StoreJSLocalVars
+  OrigLocalVars:=Orig.StoreJSLocalVars;
+  RestLocalVars:=Rest.StoreJSLocalVars;
+  //for i:=0 to length(RestLocalVars)-1 do
+  //  writeln('TCustomTestPrecompile.CheckRestoredModuleScope Rest ',i,'/',length(RestLocalVars),' ',RestLocalVars[i].Name);
+  for i:=0 to length(OrigLocalVars)-1 do
+  begin
+    OrigLocalVar:=OrigLocalVars[i];
+    //writeln('TCustomTestPrecompile.CheckRestoredModuleScope Orig ',i,'/',length(OrigLocalVars),' ',OrigLocalVar.Name);
+    j:=length(OrigLocalVars)-1;
+    while (j>=0) do
+      begin
+      RestLocalVar:=RestLocalVars[j];
+      if OrigLocalVar.Name=RestLocalVar.Name then
+        begin
+        CheckRestoredLocalVar(Path+'.LocalVars['+IntToStr(i)+']',OrigLocalVar,RestLocalVar);
+        break;
+        end;
+      dec(j);
+      end;
+    if j<0 then
+      Fail(Path+'.LocalVars['+IntToStr(i)+'] Name="'+OrigLocalVar.Name+'" missing in Rest');
+  end;
+  AssertEquals('LocalVars.Count',length(OrigLocalVars),length(RestLocalVars));
+
   CheckRestoredPasScope(Path,Orig,Rest,Flags);
 end;