pastojs: fixed specialize impl procs

git-svn-id: trunk@47670 -

packages/pastojs/src/fppas2js.pp

@@ -4573,19 +4573,24 @@ var
   ClassScope: TPas2JSClassScope;
   ptm: TProcTypeModifier;
   TypeEl, ElTypeEl, HelperForType: TPasType;
+  FuncType: TPasFunctionType;
 begin
   inherited FinishProcedureType(El);
 
   if El is TPasFunctionType then
     begin
-    TypeEl:=ResolveAliasType(TPasFunctionType(El).ResultEl.ResultType);
-    if TypeEl.ClassType=TPasPointerType then
+    FuncType:=TPasFunctionType(El);
+    if FuncType.ResultEl<>nil then
       begin
-      ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
-      if ElTypeEl.ClassType=TPasRecordType then
-        // ^record
-      else
-        RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
+      TypeEl:=ResolveAliasType(FuncType.ResultEl.ResultType);
+      if TypeEl.ClassType=TPasPointerType then
+        begin
+        ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
+        if ElTypeEl.ClassType=TPasRecordType then
+          // ^record
+        else
+          RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
+        end;
       end;
     end;
 
@@ -6260,10 +6265,12 @@ begin
     AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
   if btIntDouble in TheBaseTypes then
     AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
-  FJSBuiltInProcs[pbpDebugger]:=AddBuiltInProc('Debugger','procedure Debugger',
+  FJSBuiltInProcs[pbpDebugger]:=AddBuiltInProc(Pas2jsBuiltInProcNames[pbpDebugger],
+      'procedure Debugger',
       @BI_Debugger_OnGetCallCompatibility,nil,
       nil,nil,bfCustom,[bipfCanBeStatement]);
-  FJSBuiltInProcs[pbpAWait]:=AddBuiltInProc('AWait','function await(const Expr: T): T',
+  FJSBuiltInProcs[pbpAWait]:=AddBuiltInProc(Pas2jsBuiltInProcNames[pbpAWait],
+      'function await(const Expr: T): T',
       @BI_AWait_OnGetCallCompatibility,@BI_AWait_OnGetCallResult,
       @BI_AWait_OnEval,@BI_AWait_OnFinishParamsExpr,bfCustom,[bipfCanBeStatement]);
 end;
@@ -6467,6 +6474,7 @@ end;
 function TPas2JSResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
 var
   Data: TObject;
+  pbp: TPas2jsBuiltInProc;
 begin
   Result:=inherited FindLocalBuiltInSymbol(El);
   if Result<>nil then exit;
@@ -6475,10 +6483,9 @@ begin
     Result:=JSBaseTypes[TResElDataPas2JSBaseType(Data).JSBaseType]
   else if (Data.ClassType=TResElDataBuiltInProc)
       and (TResElDataBuiltInProc(Data).BuiltIn=bfCustom) then
-    case El.Name of
-    'Debugger': Result:=FJSBuiltInProcs[pbpDebugger].Element;
-    'AWait': Result:=FJSBuiltInProcs[pbpAWait].Element;
-    end;
+    for pbp in TPas2jsBuiltInProc do
+      if El.Name=Pas2jsBuiltInProcNames[pbp] then
+        Result:=FJSBuiltInProcs[pbp].Element;
 end;
 
 function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
@@ -15005,22 +15012,26 @@ Var
     Proc: TPasProcedure;
     FunType: TPasFunctionType;
     VarSt: TJSVariableStatement;
-    SrcEl: TPasElement;
-    Scope: TPas2JSProcedureScope;
+    ImplScope: TPas2JSProcedureScope;
   begin
     Proc:=El.Parent as TPasProcedure;
     FunType:=Proc.ProcType as TPasFunctionType;
     ResultEl:=FunType.ResultEl;
-    Scope:=Proc.CustomData as TPas2JSProcedureScope;
-    if Scope.ResultVarName<>'' then
-      ResultVarName:=Scope.ResultVarName
+    ImplScope:=Proc.CustomData as TPas2JSProcedureScope;
+    if (ResultEl=nil) or (ResultEl.ResultType=nil) then
+      begin
+      Proc:=ImplScope.DeclarationProc;
+      FunType:=Proc.ProcType as TPasFunctionType;
+      ResultEl:=FunType.ResultEl;
+      end;
+    if ImplScope.ResultVarName<>'' then
+      ResultVarName:=ImplScope.ResultVarName
     else
       ResultVarName:=ResolverResultVar;
 
     // add 'var result=initvalue'
-    SrcEl:=ResultEl;
     VarSt:=CreateVarStatement(ResultVarName,
-      CreateValInit(ResultEl.ResultType,nil,SrcEl,aContext),ResultEl);
+      CreateValInit(ResultEl.ResultType,nil,ResultEl,aContext),ResultEl);
     Add(VarSt,ResultEl);
     Result:=SLFirst;
   end;

packages/pastojs/src/pas2jsfiler.pp

@@ -1000,6 +1000,7 @@ type
     FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
+    FPendingForwardProcs: TFPList; // list of TPasElement waiting for implementation of methods
     FIntfSectionObj: TJSONObject;
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
@@ -6106,6 +6107,7 @@ var
   BuiltInProc: TResElDataBuiltInProc;
   bp: TResolverBuiltInProc;
   pbt: TPas2jsBaseType;
+  pbp: TPas2jsBuiltInProc;
 begin
   if not ReadArray(Obj,BuiltInNodeName,Arr,ErrorEl) then exit;
   for i:=0 to Arr.Count-1 do
@@ -6164,6 +6166,21 @@ begin
           end;
         end;
       end;
+    if not Found then
+      begin
+      for pbp in TPas2jsBuiltInProc do
+        begin
+        BuiltInProc:=Resolver.JSBuiltInProcs[pbp];
+        if BuiltInProc=nil then continue;
+        El:=BuiltInProc.Element;
+        if (CompareText(El.Name,aName)=0) then
+          begin
+          Found:=true;
+          AddElReference(Id,ErrorEl,El);
+          break;
+          end;
+        end;
+      end;
     if not Found then
       RaiseMsg(20180216231551,ErrorEl,aName);
     end;
@@ -6931,6 +6948,8 @@ procedure TPCUReader.ReadSection(Obj: TJSONObject; Section: TPasSection;
 // Note: can be called twice for each section if there are pending used interfaces
 var
   Scope: TPas2JSSectionScope;
+  i: Integer;
+  El: TPasElement;
 begin
   {$IFDEF VerbosePCUFiler}
   writeln('TPCUReader.ReadSection ',GetObjName(Section));
@@ -6965,10 +6984,19 @@ begin
   end;
 
   Scope.Finished:=true;
-  if Section is TInterfaceSection then
+  if Section.ClassType=TInterfaceSection then
     begin
     ResolvePending(false);
     Resolver.NotifyPendingUsedInterfaces;
+    end
+  else if Section.ClassType=TImplementationSection then
+    begin
+    for i:=0 to FPendingForwardProcs.Count-1 do
+      begin
+      El:=TPasElement(FPendingForwardProcs[i]);
+      Resolver.CheckPendingForwardProcs(El);
+      end;
+    FPendingForwardProcs.Clear;
     end;
 end;
 
@@ -8543,7 +8571,7 @@ begin
     Resolver.PopScope;
   end;
   ReadRecordScope(Obj,Scope,aContext);
-  Resolver.FinishSpecializedClassOrRecIntf(Scope);
+  Resolver.FinishGenericClassOrRecIntf(Scope);
   Resolver.FinishSpecializations(Scope);
 
   ReadSpecializations(Obj,El);
@@ -8914,8 +8942,9 @@ begin
     finally
       Resolver.PopScope;
     end;
-    Resolver.FinishSpecializedClassOrRecIntf(Scope);
-    Resolver.FinishSpecializations(Scope);
+    Resolver.FinishGenericClassOrRecIntf(Scope);
+    if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+      FPendingForwardProcs.Add(El);
     ReadSpecializations(Obj,El);
     end;
 end;
@@ -9446,7 +9475,7 @@ var
   DefProcMods: TProcedureModifiers;
   t: TProcedureMessageType;
   s: string;
-  Found: Boolean;
+  Found, HasBody: Boolean;
   Scope: TPas2JSProcedureScope;
   DeclProcId: integer;
   Ref: TPCUFilerElementRef;
@@ -9470,6 +9499,7 @@ begin
 
   ReadPasElement(Obj,El,aContext);
 
+  HasBody:=Obj.Find('Body')<>nil;
   if ReadInteger(Obj,'DeclarationProc',DeclProcId,El) then
     begin
     // ImplProc
@@ -9481,8 +9511,19 @@ begin
     DeclProc:=TPasProcedure(Ref.Element);
     Scope.DeclarationProc:=DeclProc; // no AddRef
 
-    El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',DeclProc));
+    El.ProcType:=TPasProcedureType(CreateElement(TPasProcedureTypeClass(DeclProc.ProcType.ClassType),'',El));
     El.Modifiers:=ReadProcedureModifiers(Obj,El,'PMods',DeclProc.Modifiers*PCUProcedureModifiersImplProc);
+
+    if HasBody then
+      begin
+      // not a precompiled proc -> copy signature
+      //if El.ProcType is TPasFunctionType then
+      //  begin
+      //  FuncType:=TPasFunctionType(El.ProcType);
+      //  FuncType.ResultEl:=TPasResultElement(CreateElement(TPasResultElement,
+      //    TPasFunctionType(DeclProc.ProcType).ResultEl.Name,FuncType));
+      //  end;
+      end;
     end
   else
     begin
@@ -9526,7 +9567,7 @@ begin
   if (Scope<>nil) and (Obj.Find('ImplProc')=nil) then
     ReadProcScopeReferences(Obj,Scope);
 
-  if Obj.Find('Body')<>nil then
+  if HasBody then
     ReadProcedureBody(Obj,El,aContext);
 end;
 
@@ -9813,12 +9854,14 @@ begin
   inherited Create;
   FInitialFlags:=TPCUInitialFlags.Create;
   FPendingIdentifierScopes:=TObjectList.Create(true);
+  FPendingForwardProcs:=TFPList.Create;
 end;
 
 destructor TPCUReader.Destroy;
 begin
   FreeAndNil(FJSON);
   inherited Destroy;
+  FreeAndNil(FPendingForwardProcs);
   FreeAndNil(FPendingIdentifierScopes);
   FreeAndNil(FInitialFlags);
 end;
@@ -9834,6 +9877,7 @@ begin
   FPendingIdentifierScopes.Clear;
   while FPendingSpecialize<>nil do
     DeletePendingSpecialize(FPendingSpecialize);
+  FPendingForwardProcs.Clear;
 
   inherited Clear;
   FInitialFlags.Clear;

packages/pastojs/tests/tcprecompile.pas

@@ -130,7 +130,6 @@ begin
       Params.AddStrings(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
-    writeln('BBB1 TCustomTestCLI_Precompile.CheckPrecompile ',Params.Text);
     Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
     if ExpExitCode=0 then
       begin