pas2js: filer: restore specialize class

git-svn-id: trunk@45537 -

packages/pastojs/src/pas2jsfiler.pp

@@ -964,7 +964,10 @@ type
   public
     Obj: TJSONObject;
     GenericEl: TPasGenericType;
+    Id: integer;
     Params: TFPList; // list of PCUReaderPendingSpecializedParams
+    RefEl: TPasElement; // a TInlineSpecializeExpr or TPasSpecializeType
+    SpecName: string;
     Prev, Next: TPCUReaderPendingSpecialized;
     destructor Destroy; override;
   end;
@@ -976,9 +979,6 @@ type
     FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
-    FPendingSpecialize: TPCUReaderPendingSpecialized; // chain of TPCUReaderPendingSpecialized
-    function AddPendingSpecialize(GenEl: TPasGenericType; ParamCount: integer): TPCUReaderPendingSpecialized;
-    procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized);
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
@@ -1012,8 +1012,15 @@ type
     procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
     procedure Set_ResolvedReference_CtxConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ResolvedReference_CtxAttrProc(RefEl: TPasElement; Data: TObject);
-    procedure Set_SpecializeParam(RefEl: TPasElement; Data: TObject);
     procedure Set_SpecializeTypeData(RefEl: TPasElement; Data: TObject);
+  protected
+    // specialize
+    FPendingSpecialize: TPCUReaderPendingSpecialized; // chain of TPCUReaderPendingSpecialized
+    function AddPendingSpecialize(Id: integer; const SpecName: string): TPCUReaderPendingSpecialized;
+    function CreateSpecializedElement(PendSpec: TPCUReaderPendingSpecialized): boolean; // false=param missing
+    procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized);
+    procedure PromiseSpecialize(SpecId: integer; El: TPasElement; const SpecName: string); virtual;
+    procedure ResolveSpecializedElements;
   protected
     // json
     procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
@@ -1036,7 +1043,7 @@ type
       AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
     procedure PromiseSetElArrReference(Id: integer; Arr: TPasElementArray; Index: integer;
       AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
-    procedure PromiseSpecialize(SpecId: integer; El: TPasElement; const SpecName: string); virtual;
+    procedure ResolvePendingIdentifierScopes; virtual;
     procedure ResolvePending; virtual;
     procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
     // module
@@ -4952,43 +4959,6 @@ end;
 
 { TPCUReader }
 
-function TPCUReader.AddPendingSpecialize(GenEl: TPasGenericType;
-  ParamCount: integer): TPCUReaderPendingSpecialized;
-var
-  Param: TPCUReaderPendingSpecializedParam;
-  i: Integer;
-begin
-  Result:=TPCUReaderPendingSpecialized.Create;
-  Result.GenericEl:=GenEl;
-  if FPendingSpecialize<>nil then
-    begin
-    Result.Next:=FPendingSpecialize;
-    FPendingSpecialize.Prev:=Result;
-    end;
-  FPendingSpecialize:=Result;
-
-  Result.Params:=TFPList.Create;
-  for i:=0 to ParamCount-1 do
-    begin
-    Param:=TPCUReaderPendingSpecializedParam.Create;
-    Result.Params.Add(Param);
-    Param.Spec:=Result;
-    Param.Index:=i;
-    end;
-end;
-
-procedure TPCUReader.DeletePendingSpecialize(
-  PendSpec: TPCUReaderPendingSpecialized);
-begin
-  if FPendingSpecialize=PendSpec then
-    FPendingSpecialize:=PendSpec.Next;
-  if PendSpec.Prev<>nil then PendSpec.Prev.Next:=PendSpec.Next;
-  if PendSpec.Next<>nil then PendSpec.Next.Prev:=PendSpec.Prev;
-  PendSpec.Prev:=nil;
-  PendSpec.Next:=nil;
-  PendSpec.Free;
-end;
-
 procedure TPCUReader.Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
 var
   El: TPasVariable absolute Data;
@@ -5406,36 +5376,6 @@ begin
     RaiseMsg(20190222010821,Ref.Element,GetObjPath(RefEl));
 end;
 
-procedure TPCUReader.Set_SpecializeParam(RefEl: TPasElement; Data: TObject);
-var
-  Param: TPCUReaderPendingSpecializedParam absolute Data;
-  PendSpec: TPCUReaderPendingSpecialized;
-  i: Integer;
-  RefParams, ElParams: TFPList;
-  SpecEl: TPasElement;
-begin
-  PendSpec:=Param.Spec;
-  if not (RefEl is TPasType) then
-    RaiseMsg(20200222195932,PendSpec.GenericEl,GetObjPath(RefEl));
-  Param.Element:=RefEl;
-  RefParams:=PendSpec.Params;
-  i:=RefParams.Count-1;
-  while (i>=0) and (TPCUReaderPendingSpecializedParam(RefParams[i]).Element<>nil) do
-    dec(i);
-  if i>=0 then exit;
-  // all RefParams resolved -> specialize
-  ElParams:=TFPList.Create;
-  try
-    for i:=0 to RefParams.Count-1 do
-      ElParams.Add(TPCUReaderPendingSpecializedParam(RefParams[i]).Element);
-    SpecEl:=Resolver.GetSpecializedEl(Resolver.RootElement,PendSpec.GenericEl,ElParams);
-  finally
-    ElParams.Free;
-  end;
-  // read child declarations
-  ReadExternalReferences(PendSpec.Obj,SpecEl);
-end;
-
 procedure TPCUReader.Set_SpecializeTypeData(RefEl: TPasElement; Data: TObject);
 var
   SpecData: TPasSpecializeTypeData absolute Data;
@@ -5446,6 +5386,130 @@ begin
     RaiseMsg(20200514130809,SpecData.Element,GetObjPath(RefEl));
 end;
 
+function TPCUReader.AddPendingSpecialize(Id: integer; const SpecName: string
+  ): TPCUReaderPendingSpecialized;
+begin
+  Result:=TPCUReaderPendingSpecialized.Create;
+  if FPendingSpecialize<>nil then
+    begin
+    Result.Next:=FPendingSpecialize;
+    FPendingSpecialize.Prev:=Result;
+    end;
+  Result.Id:=Id;
+  Result.SpecName:=SpecName;
+  FPendingSpecialize:=Result;
+end;
+
+function TPCUReader.CreateSpecializedElement(
+  PendSpec: TPCUReaderPendingSpecialized): boolean;
+var
+  RefParams, ElParams: TFPList;
+  i: Integer;
+  SpecEl: TPasElement;
+  Param: TPCUReaderPendingSpecializedParam;
+  Ref: TPCUFilerElementRef;
+  Obj: TJSONObject;
+begin
+  Result:=false;
+  if PendSpec.RefEl=nil then
+    begin
+    if PendSpec.GenericEl=nil then
+      RaiseMsg(20200531101241,PendSpec.SpecName)
+    else
+      RaiseMsg(20200531101105,PendSpec.GenericEl);// nothing uses this specialize
+    end;
+  if PendSpec.GenericEl=nil then
+    RaiseMsg(20200531101333,PendSpec.RefEl);
+  Obj:=PendSpec.Obj;
+  if Obj=nil then
+    RaiseMsg(20200531101128,PendSpec.GenericEl); // specialize missing in JSON
+
+  // resolve params
+  RefParams:=PendSpec.Params;
+  for i:=0 to RefParams.Count-1 do
+    begin
+    Param:=TPCUReaderPendingSpecializedParam(RefParams[i]);
+    if Param.Element<>nil then continue;
+    Ref:=GetElReference(Param.Id,PendSpec.RefEl);
+    if Ref=nil then
+      exit(false);
+    Param.Element:=Ref.Element;
+    end;
+  // all RefParams resolved -> specialize
+  ElParams:=TFPList.Create;
+  try
+    for i:=0 to RefParams.Count-1 do
+      ElParams.Add(TPCUReaderPendingSpecializedParam(RefParams[i]).Element);
+    SpecEl:=Resolver.GetSpecializedEl(Resolver.RootElement,PendSpec.GenericEl,ElParams);
+    DeletePendingSpecialize(PendSpec);
+  finally
+    ElParams.Free;
+  end;
+  // read child declarations
+  ReadExternalReferences(Obj,SpecEl);
+  Result:=true;
+end;
+
+procedure TPCUReader.DeletePendingSpecialize(
+  PendSpec: TPCUReaderPendingSpecialized);
+begin
+  if FPendingSpecialize=PendSpec then
+    FPendingSpecialize:=PendSpec.Next;
+  if PendSpec.Prev<>nil then PendSpec.Prev.Next:=PendSpec.Next;
+  if PendSpec.Next<>nil then PendSpec.Next.Prev:=PendSpec.Prev;
+  PendSpec.Prev:=nil;
+  PendSpec.Next:=nil;
+  PendSpec.Free;
+end;
+
+procedure TPCUReader.PromiseSpecialize(SpecId: integer; El: TPasElement;
+  const SpecName: string);
+var
+  PendSpec: TPCUReaderPendingSpecialized;
+begin
+  PendSpec:=FPendingSpecialize;
+  while PendSpec<>nil do
+    begin
+    if PendSpec.Id=SpecId then
+      break;
+    PendSpec:=PendSpec.Next;
+    end;
+
+  if PendSpec=nil then
+    PendSpec:=AddPendingSpecialize(SpecId,SpecName)
+  else if PendSpec.SpecName<>SpecName then
+    RaiseMsg(20200531093342,El,'Id='+IntToStr(SpecId)+' Expected SpecName "'+SpecName+'", but was "'+PendSpec.SpecName+'"');
+  if PendSpec.RefEl=nil then
+    PendSpec.RefEl:=El;
+end;
+
+procedure TPCUReader.ResolveSpecializedElements;
+var
+  PendSpec, NextPendSpec, UnresolvedSpec: TPCUReaderPendingSpecialized;
+  Changed: Boolean;
+begin
+  repeat
+    UnresolvedSpec:=nil;
+    Changed:=false;
+    PendSpec:=FPendingSpecialize;
+    while PendSpec<>nil do
+      begin
+      NextPendSpec:=PendSpec.Next;
+      if PendSpec.RefEl<>nil then
+        begin
+        if CreateSpecializedElement(PendSpec) then
+          Changed:=true
+        else
+          UnresolvedSpec:=PendSpec;
+        end;
+      PendSpec:=NextPendSpec;
+      end;
+  until not Changed;
+  if UnresolvedSpec<>nil then
+    // a pending specialize cannot resolve its params
+    RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,UnresolvedSpec.SpecName+' Id='+IntToStr(UnresolvedSpec.Id)+' RefEl='+GetObjPath(UnresolvedSpec.RefEl));
+end;
+
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 var
   E: EPas2JsReadError;
@@ -5795,19 +5859,10 @@ begin
     end;
 end;
 
-procedure TPCUReader.PromiseSpecialize(SpecId: integer; El: TPasElement;
+procedure TPCUReader.ResolvePendingIdentifierScopes;
-  const SpecName: string);
-begin
-  // ToDo: add to list, specialize when unit interface/impl has finished, resolve nested references
-  RaiseMsg(20200530134408,El,IntToStr(SpecId)+'='+SpecName);
-end;
-
-procedure TPCUReader.ResolvePending;
 var
   i: Integer;
   PendingIdentifierScope: TPCUReaderPendingIdentifierScope;
-  Node: TAVLTreeNode;
-  Ref: TPCUFilerElementRef;
 begin
   for i:=0 to FPendingIdentifierScopes.Count-1 do
     begin
@@ -5815,7 +5870,18 @@ begin
     ReadIdentifierScopeArray(PendingIdentifierScope.Arr,PendingIdentifierScope.Scope);
     end;
   FPendingIdentifierScopes.Clear;
+end;
 
+procedure TPCUReader.ResolvePending;
+var
+  Node: TAVLTreeNode;
+  Ref: TPCUFilerElementRef;
+begin
+  ResolvePendingIdentifierScopes;
+
+  ResolveSpecializedElements;
+
+  // check dangling references
   Node:=FElementRefs.FindLowest;
   while Node<>nil do
     begin
@@ -6405,12 +6471,21 @@ var
   ErrorEl: TPasElement;
   PendSpec: TPCUReaderPendingSpecialized;
   PendParam: TPCUReaderPendingSpecializedParam;
+  SpecName: string;
 begin
   ErrorEl:=GenEl;
   if ParamIDs.Count=0 then
     RaiseMsg(20200222190934,ErrorEl);
-  PendSpec:=AddPendingSpecialize(GenEl,ParamIDs.Count);
+  if not ReadInteger(Obj,'Id',Id,GenEl) then
+    RaiseMsg(20200531085133,GenEl);
+  if not ReadString(Obj,'SpecName',SpecName,GenEl) then
+    RaiseMsg(20200531085133,GenEl);
+
+  PendSpec:=AddPendingSpecialize(Id,SpecName);
   PendSpec.Obj:=Obj;
+  PendSpec.GenericEl:=GenEl;
+
+  PendSpec.Params:=TFPList.Create;
   for i:=0 to ParamIDs.Count-1 do
     begin
     if ParamIDs.Types[i]<>jtNumber then
@@ -6418,9 +6493,11 @@ begin
     Id:=ParamIDs[i].AsInteger;
     if Id<=0 then
       RaiseMsg(20200222191724,ErrorEl,IntToStr(i));
-    PendParam:=TPCUReaderPendingSpecializedParam(PendSpec.Params[i]);
+    PendParam:=TPCUReaderPendingSpecializedParam.Create;
+    PendSpec.Params.Add(PendParam);
+    PendParam.Spec:=PendSpec;
+    PendParam.Index:=i;
     PendParam.Id:=Id;
-    //PromiseSetElReference(Id,@Set_SpecializeParam,PendParam,ErrorEl);
     end;
 end;
 

packages/pastojs/tests/tcfiler.pas

@@ -1187,7 +1187,17 @@ begin
 
   AModule:=Orig.GetModule;
   if AModule<>Module then
+    begin
+    if (Orig is TPasUnresolvedSymbolRef) then
+      begin
+      // built-in identifier
+      if not SameText(Orig.Name,Rest.Name) then
+        AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
+      if not CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData) then exit;
+      exit;
+      end;
     Fail(Path+' wrong module: Orig='+GetObjName(AModule)+' '+GetObjName(Module));
+    end;
 
   AssertEquals(Path+'.Name',Orig.Name,Rest.Name);
   AssertEquals(Path+'.SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
@@ -3067,8 +3077,6 @@ end;
 
 procedure TTestPrecompile.TestPC_SpecializeClassSameUnit;
 begin
-  exit;
-
   StartUnit(false);
   Add([
   '{$mode delphi}',