pastojs: write generic function without body

git-svn-id: trunk@43517 -

packages/pastojs/src/fppas2js.pp

@@ -1453,6 +1453,7 @@ type
     function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
     function HasAnonymousFunctions(El: TPasImplElement): boolean;
     function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
+    function ProcCanBePrecompiled(Proc: TPasProcedure): boolean; virtual;
     function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
     function IsExternalBracketAccessor(El: TPasElement): boolean;
     function IsExternalClassConstructor(El: TPasElement): boolean;
@@ -5926,6 +5927,37 @@ begin
     end;
 end;
 
+function TPas2JSResolver.ProcCanBePrecompiled(Proc: TPasProcedure): boolean;
+var
+  El: TPasElement;
+  TemplTypes: TFPList;
+  ProcScope: TPas2JSProcedureScope;
+  GenScope: TPasGenericScope;
+begin
+  if GetProcTemplateTypes(Proc)<>nil then
+    exit(false); // generic proc
+  ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
+  if ProcScope.SpecializedFromItem<>nil then
+    exit(false); // specialized generic proc
+  El:=Proc;
+  repeat
+    El:=El.Parent;
+    if El=nil then
+      exit(true); // ok
+    if El is TPasProcedure then
+      exit(false); // Proc is a local proc
+    if El is TPasGenericType then
+      begin
+      TemplTypes:=TPasGenericType(El).GenericTemplateTypes;
+      if (TemplTypes<>nil) and (TemplTypes.Count>0) then
+        exit(false); // not fully specialized
+      GenScope:=El.CustomData as TPasGenericScope;
+      if GenScope.SpecializedFromItem<>nil then
+        exit(false); // method of a specialized class/record type
+      end;
+  until false;
+end;
+
 function TPas2JSResolver.IsTObjectFreeMethod(El: TPasExpr): boolean;
 var
   Ref: TResolvedReference;
@@ -14975,7 +15007,7 @@ begin
 
   if (coStoreImplJS in Options) and (aResolver<>nil) then
     begin
-    if aResolver.GetTopLvlProc(El)=El then
+    if aResolver.ProcCanBePrecompiled(El) then
       begin
       ImplProcScope.BodyJS:=CreatePrecompiledJS(Result);
       ImplProcScope.EmptyJS:=BodyPas.Body=nil;

packages/pastojs/src/pas2jsfiler.pp

@@ -781,6 +781,7 @@ type
     procedure WritePropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUWriterContext); virtual;
     procedure WriteProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUWriterContext); virtual;
     procedure WriteMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUWriterContext); virtual;
+    procedure WriteGenericTemplateType(Obj: TJSONObject; El: TPasGenericTemplateType; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedureModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcedureModifiers); virtual;
     procedure WriteProcScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasProcedureScopeFlags); virtual;
@@ -1009,6 +1010,7 @@ type
     procedure ReadPropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUReaderContext); virtual;
     procedure ReadProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUReaderContext); virtual;
     procedure ReadMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUReaderContext); virtual;
+    procedure ReadGenericTemplateType(Obj: TJSONObject; El: TPasGenericTemplateType; aContext: TPCUReaderContext); virtual;
     procedure ReadProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     function ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
       const PropName: string; const DefaultValue: TProcedureModifiers): TProcedureModifiers; virtual;
@@ -3812,6 +3814,15 @@ begin
   WriteExpr(Obj,El,'ImplementationProc',El.ImplementationProc,aContext);
 end;
 
+procedure TPCUWriter.WriteGenericTemplateType(Obj: TJSONObject;
+  El: TPasGenericTemplateType; aContext: TPCUWriterContext);
+begin
+  WritePasElement(Obj,El,aContext);
+  if not (El.CustomData is TPasGenericParamsScope) then
+    RaiseMsg(20191120175118,El,GetObjName(El.CustomData));
+  WriteElementArray(Obj,El,'Constraints',El.Constraints,aContext,true);
+end;
+
 procedure TPCUWriter.WriteProcedureNameParts(Obj: TJSONObject;
   El: TPasProcedure; aContext: TPCUWriterContext);
 var
@@ -3841,8 +3852,7 @@ begin
           GenType:=TPasGenericTemplateType(Templates[j]);
           TemplObj:=TJSONObject.Create;
           TemplArr.Add(TemplObj);
-          TemplObj.Add('Name',GenType.Name);
+          WriteGenericTemplateType(TemplObj,GenType,aContext);
-          WriteElementArray(TemplObj,El,'Constraints',GenType.Constraints,aContext,true);
           end;
         end;
       end;
@@ -3905,6 +3915,7 @@ var
   i: Integer;
   DeclProc: TPasProcedure;
   DeclScope: TPas2JsProcedureScope;
+  TemplTypes: TFPList;
 begin
   WritePasElement(Obj,El,aContext);
   Scope:=El.CustomData as TPas2JSProcedureScope;
@@ -3940,27 +3951,42 @@ begin
 
   if (Scope.ImplProc=nil) and (El.Body<>nil) then
     begin
-    // Note: although the References are in the declaration scope,
+    TemplTypes:=Resolver.GetProcTemplateTypes(El);
-    //       they are stored with the implementation scope, so that
+    if TemplTypes<>nil then
-    //       all references can be resolved immediately by the reader
-    DeclProc:=Scope.DeclarationProc;
-    if DeclProc=nil then
-      DeclProc:=El;
-    DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope;
-    WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
-
-    // precompiled body
-    if Scope.BodyJS<>'' then
       begin
-      if Scope.GlobalJS<>nil then
+      // generic function: store pascal elements
+      if Scope.BodyJS<>'' then
+        RaiseMsg(20191120171941,El);
+      // ToDo
+      Obj.Add('Body','');
+      Obj.Add('Empty',true);
+      end
+    else
+      begin
+      // normal procedure: store references and precompiled JS
+
+      // Note: although the References are in the declaration scope,
+      //       they are stored with the implementation scope, so that
+      //       all references can be resolved immediately by the reader
+      DeclProc:=Scope.DeclarationProc;
+      if DeclProc=nil then
+        DeclProc:=El;
+      DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope;
+      WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
+
+      // precompiled body
+      if Scope.BodyJS<>'' then
         begin
-        Arr:=TJSONArray.Create;
+        if Scope.GlobalJS<>nil then
-        Obj.Add('Globals',Arr);
+          begin
-        for i:=0 to Scope.GlobalJS.Count-1 do
+          Arr:=TJSONArray.Create;
-          Arr.Add(Scope.GlobalJS[i]);
+          Obj.Add('Globals',Arr);
+          for i:=0 to Scope.GlobalJS.Count-1 do
+            Arr.Add(Scope.GlobalJS[i]);
+          end;
+        Obj.Add('Body',Scope.BodyJS);
+        Obj.Add('Empty',Scope.EmptyJS);
         end;
-      Obj.Add('Body',Scope.BodyJS);
-      Obj.Add('Empty',Scope.EmptyJS);
       end;
     end;
   if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then
@@ -7598,6 +7624,20 @@ begin
   El.ImplementationProc:=ReadExpr(Obj,El,'ImplementationProc',aContext);
 end;
 
+procedure TPCUReader.ReadGenericTemplateType(Obj: TJSONObject;
+  El: TPasGenericTemplateType; aContext: TPCUReaderContext);
+var
+  Scope: TPasGenericParamsScope;
+begin
+  ReadPasElement(Obj,El,aContext);
+  Scope:=TPasGenericParamsScope(Resolver.CreateScope(El,TPasGenericParamsScope));
+  El.CustomData:=Scope;
+  // Scope.GenericType only needed during parsing
+  ReadElementArray(Obj,El,'Constraints',El.Constraints,
+     {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+     aContext);
+end;
+
 procedure TPCUReader.ReadProcedureNameParts(Obj: TJSONObject;
   El: TPasProcedure; aContext: TPCUReaderContext);
 var
@@ -7624,19 +7664,18 @@ begin
         begin
         if not ReadString(NamePartObj,'Name',Name,El) then
           RaiseMsg(20190718113739,El,IntToStr(i));
-        if not ReadArray(NamePartObj,'Templates',TemplArr,El) then
+        if ReadArray(NamePartObj,'Templates',TemplArr,El) then
-          continue; // Templates=nil
-        Templates:=TFPList.Create;
-        for j:=0 to TemplArr.Count-1 do
           begin
-          TemplObj:=CheckJSONObject(TemplArr[j],20190718114058);
+          Templates:=TFPList.Create;
-          if not ReadString(TemplObj,'Name',GenTypeName,El) or (GenTypeName='') then
+          for j:=0 to TemplArr.Count-1 do
-            RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
+            begin
-          GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
+            TemplObj:=CheckJSONObject(TemplArr[j],20190718114058);
-          Templates.Add(GenType);
+            if not ReadString(TemplObj,'Name',GenTypeName,El) or (GenTypeName='') then
-          ReadElementArray(TemplObj,El,'Constraints',GenType.Constraints,
+              RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
-             {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+            GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
-             aContext);
+            Templates.Add(GenType);
+            ReadGenericTemplateType(TemplObj,GenType,aContext);
+            end;
           end;
         end;
       end;

packages/pastojs/tests/tcfiler.pas

@@ -75,6 +75,7 @@ type
     procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
     procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences); virtual;
     procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope); virtual;
+    procedure CheckRestoredGenericParamScope(const Path: string; Orig, Rest: TPasGenericParamsScope); virtual;
     procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference); virtual;
     procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
     procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject); virtual;
@@ -171,6 +172,8 @@ type
     procedure TestPC_ClassInterface;
     procedure TestPC_Attributes;
 
+    procedure TestPC_GenericFunction;
+
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
     procedure TestPC_UseIndirectUnit;
@@ -898,6 +901,15 @@ begin
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredGenericParamScope(
+  const Path: string; Orig, Rest: TPasGenericParamsScope);
+begin
+  // Orig.GenericType only needed during parsing
+  if Path='' then ;
+  if Orig<>nil then ;
+  if Rest<>nil then ;
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredResolvedReference(
   const Path: string; Orig, Rest: TResolvedReference);
 var
@@ -1009,6 +1021,8 @@ begin
     CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest))
   else if C=TPasPropertyScope then
     CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest))
+  else if C=TPasGenericParamsScope then
+    CheckRestoredGenericParamScope(Path+'[TPasGenericParamScope]',TPasGenericParamsScope(Orig),TPasGenericParamsScope(Rest))
   else if C.InheritsFrom(TResEvalValue) then
     CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
   else
@@ -2388,7 +2402,22 @@ begin
   '[TCustom]',
   'constructor TObject.Create; begin end;',
   'constructor TCustomAttribute.Create(Id: word); begin end;',
-  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_GenericFunction;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'generic function Run<T>(a: T): T;',
+  'implementation',
+  'generic function Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  b:=a; Result:=b;',
+  'end;',
   '']);
   WriteReadUnit;
 end;

utils/fpcm/revision.inc

@@ -1 +1 @@
-'2019-11-15 rev 43472'
+'2019-11-16 rev 43487'