Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@47671 -
nickysn 4 years ago
parent
commit
8c79c1fe15

+ 8 - 0
compiler/aasmtai.pas

@@ -730,6 +730,7 @@ interface
           constructor Create_rel_sym_offset(_typ : taiconst_type; _sym,_endsym : tasmsymbol; _ofs : int64);
           constructor Create_rva_sym(_sym:tasmsymbol);
           constructor Createname(const name:string;ofs:asizeint);
+          constructor Createname_rel(const name, endname: string);
           constructor Createname(const name:string;_symtyp:Tasmsymtype;ofs:asizeint);
           constructor Create_type_name(_typ:taiconst_type;const name:string;ofs:asizeint);
           constructor Create_type_name(_typ:taiconst_type;const name:string;_symtyp:Tasmsymtype;ofs:asizeint);
@@ -1905,6 +1906,13 @@ implementation
       end;
 
 
+    constructor tai_const.Createname_rel(const name,endname:string);
+      begin
+         self.create_sym_offset(current_asmdata.RefAsmSymbol(name,AT_NONE),0);
+         endsym:=current_asmdata.RefAsmSymbol(endname,AT_NONE)
+      end;
+
+
     constructor tai_const.Create_type_name(_typ:taiconst_type;const name:string;ofs:asizeint);
       begin
          self.Create_type_name(_typ,name,AT_NONE,ofs);

+ 1 - 1
compiler/i8086/n8086con.pas

@@ -44,7 +44,7 @@ interface
 implementation
 
     uses
-      systems,globals,
+      systems,globals,verbose,
       symconst,symdef,symcpu,
       defutil,
       cpubase,

+ 5 - 0
compiler/pdecl.pas

@@ -1187,6 +1187,11 @@ implementation
            if assigned(rtti_attrs_def) and (rtti_attrs_def.get_attribute_count>0) then
              Message1(parser_e_unbound_attribute,trtti_attribute(rtti_attrs_def.rtti_attributes[0]).typesym.prettyname);
 
+ {$ifdef DEBUG_NODE_XML}
+          if Assigned(hdef) then
+            hdef.XMLPrintDef(newtype);
+ {$endif DEBUG_NODE_XML}
+
          until ((token<>_ID) and (token<>_LECKKLAMMER)) or
                (in_structure and
                 ((idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]) or

+ 1 - 1
compiler/raatt.pas

@@ -930,7 +930,7 @@ unit raatt;
                  begin
                    if constsize<>sizeof(pint) then
                     Message(asmr_w_32bit_const_for_address);
-                   ConcatConstSymbol(curlist,asmsym,asmsymtyp,value,constsize,true)
+                   ConcatConstSymbol(curlist,asmsym,'',asmsymtyp,value,constsize,true)
                  end
                 else
                  ConcatConstant(curlist,value,constsize);

+ 2 - 2
compiler/rautils.pas

@@ -206,7 +206,7 @@ Function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
 
   Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
   Procedure ConcatConstant(p : TAsmList;value: tcgint; constsize:byte);
-  Procedure ConcatConstSymbol(p : TAsmList;const sym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
+  Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
   Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
   Procedure ConcatString(p : TAsmList;s:string);
   procedure ConcatAlign(p:TAsmList;l:tcgint);
@@ -1836,7 +1836,7 @@ Begin
 end;
 
 
-  Procedure ConcatConstSymbol(p : TAsmList;const sym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
+  Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
   begin
 {$ifdef i8086}
     { 'DW xx' as well as 'DW OFFSET xx' are just near pointers }

+ 154 - 0
compiler/symdef.pas

@@ -322,6 +322,10 @@ interface
        tabstractrecorddef= class(tstoreddef)
        private
           rttistring     : string;
+{$ifdef DEBUG_NODE_XML}
+       protected
+          procedure XMLPrintDefData(var T: Text; Sym: TSym); override;
+{$endif DEBUG_NODE_XML}
        public
           objname,
           objrealname    : PShortString;
@@ -376,6 +380,10 @@ interface
        end;
 
        trecorddef = class(tabstractrecorddef)
+{$ifdef DEBUG_NODE_XML}
+       protected
+          function XMLPrintType: ansistring; override;
+{$endif DEBUG_NODE_XML}
        public
           variantrecdesc : pvariantrecdesc;
           isunion       : boolean;
@@ -450,6 +458,12 @@ interface
        tobjectdef = class(tabstractrecorddef)
        private
           fcurrent_dispid: longint;
+{$ifdef DEBUG_NODE_XML}
+       protected
+          function XMLPrintType: ansistring; override;
+          procedure XMLPrintDefInfo(var T: Text; Sym: TSym); override;
+          procedure XMLPrintDefData(var T: Text; Sym: TSym); override;
+{$endif DEBUG_NODE_XML}
        public
           childof        : tobjectdef;
           childofderef   : tderef;
@@ -4898,6 +4912,92 @@ implementation
         result:=false;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure tabstractrecorddef.XMLPrintDefData(var T: Text; Sym: TSym);
+
+      procedure WriteSymOptions(SourceSym: TSym);
+        var
+          i: TSymOption;
+          first: Boolean;
+        begin
+          First := True;
+          for i := Low(TSymOption) to High(TSymOption) do
+            if i in SourceSym.symoptions then
+              begin
+                if First then
+                  begin
+                    Write(T, '" symoptions="', i);
+                    First := False;
+                  end
+                else
+                  Write(T, ',', i)
+              end;
+        end;
+
+      var
+        List: TFPHashObjectList;
+        i: Integer;
+      begin
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+
+        if (alignment = structalignment) and (alignment = aggregatealignment) then
+          begin
+            { Straightforward and simple }
+            WriteLn(T, PrintNodeIndention, '<alignment>', alignment, '</alignment>');
+          end
+        else
+          begin
+            WriteLn(T, PrintNodeIndention, '<alignment>');
+            printnodeindent;
+            WriteLn(T, PrintNodeIndention, '<basic>', alignment, '</basic>');
+
+            if (structalignment <> alignment) then
+              WriteLn(T, PrintNodeIndention, '<struct>', structalignment, '</struct>');
+
+            if (aggregatealignment <> alignment) and (aggregatealignment <> structalignment) then
+              WriteLn(T, PrintNodeIndention, '<aggregate>', aggregatealignment, '</aggregate>');
+
+            printnodeunindent;
+            WriteLn(T, PrintNodeIndention, '</alignment>');
+          end;
+
+        { List the fields }
+        List := Symtable.SymList;
+        for i := 0 to List.Count - 1 do
+          case TSym(List[i]).typ of
+{            staticvarsym,localvarsym,paravarsym,fieldvarsym,
+            typesym,procsym,unitsym,}
+            constsym:
+              with TConstSym(List[i]) do
+                begin
+                  Write(T, PrintNodeIndention, '<const name="', RealName, '" pos="', fileinfo.line, ',', fileinfo.column);
+                  WriteSymOptions(TSym(List[i]));
+                  WriteLn(T, '">');
+                  PrintNodeIndent;
+                  XMLPrintConstData(T);
+                  PrintNodeUnindent;
+                  WriteLn(T, PrintNodeIndention, '</const>');
+                end;
+ {
+            errorsym,syssym,labelsym,absolutevarsym,propertysym,
+            macrosym,namespacesym,undefinedsym,programparasym
+}
+            fieldvarsym:
+              with TFieldVarSym(List[i]) do
+                begin
+                  Write(T, PrintNodeIndention, '<field name="', RealName, '" pos="', fileinfo.line, ',', fileinfo.column);
+                  WriteSymOptions(TSym(List[i]));
+                  WriteLn(T, '">');
+                  PrintNodeIndent;
+                  XMLPrintFieldData(T);
+                  PrintNodeUnindent;
+                  WriteLn(T, PrintNodeIndention, '</field>');
+                end;
+            else
+              ;
+          end;
+      end;
+{$endif DEBUG_NODE_XML}
 
 {***************************************************************************
                                   trecorddef
@@ -5227,6 +5327,12 @@ implementation
          GetTypeName:='<record type>'
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    function TRecordDef.XMLPrintType: ansistring;
+      begin
+        Result := '&lt;record&gt;';
+      end;
+{$endif DEBUG_NODE_XML}
 
 {***************************************************************************
                        TABSTRACTPROCDEF
@@ -8343,6 +8449,54 @@ implementation
         self.symtable.DefList.ForEachCall(@do_cpp_import_info,nil);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    function TObjectDef.XMLPrintType: ansistring;
+      begin
+        if (oo_is_forward in objectoptions) then
+          Result := '&lt;class prototype&gt;'
+        else
+          Result := '&lt;class&gt;';
+      end;
+
+
+    procedure TObjectDef.XMLPrintDefInfo(var T: Text; Sym: TSym);
+      var
+        i: TObjectOption;
+        first: Boolean;
+      begin
+        inherited XMLPrintDefInfo(T, Sym);
+
+        First := True;
+        for i := Low(TObjectOption) to High(TObjectOption) do
+          if i in objectoptions then
+            begin
+              if First then
+                begin
+                  Write(T, ' objectoptions="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        if not first then
+          Write(T, '"');
+      end;
+
+
+    procedure TObjectDef.XMLPrintDefData(var T: Text; Sym: TSym);
+      begin
+        { There's nothing useful yet if the type is only forward-declared }
+        if not (oo_is_forward in objectoptions) then
+          begin
+            if Assigned(childof) then
+              WriteLn(T, printnodeindention, '<ancestor>', SanitiseXMLString(childof.typesym.RealName), '</ancestor>');
+
+            inherited XMLPrintDefData(T, Sym);
+          end;
+      end;
+{$endif DEBUG_NODE_XML}
+
 
 {****************************************************************************
                              TImplementedInterface

+ 58 - 0
compiler/symsym.pas

@@ -234,6 +234,10 @@ interface
           procedure set_externalname(const s:string);virtual;
           function mangledname:TSymStr;override;
           destructor destroy;override;
+{$ifdef DEBUG_NODE_XML}
+        public
+          procedure XMLPrintFieldData(var T: Text);
+{$endif DEBUG_NODE_XML}
       end;
       tfieldvarsymclass = class of tfieldvarsym;
 
@@ -410,6 +414,10 @@ interface
           { do not override this routine in platform-specific subclasses,
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
+{$ifdef DEBUG_NODE_XML}
+        public
+          procedure XMLPrintConstData(var T: Text);
+{$endif DEBUG_NODE_XML}
        end;
        tconstsymclass = class of tconstsym;
 
@@ -1961,6 +1969,15 @@ implementation
         inherited destroy;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+      procedure TFieldVarSym.XMLPrintFieldData(var T: Text);
+        begin
+          WriteLn(T, PrintNodeIndention, '<type>', SanitiseXMLString(vardef.GetTypeName), '</type>');
+          WriteLn(T, PrintNodeIndention, '<visibility>', visibility, '</visibility>');
+          WriteLn(T, PrintNodeIndention, '<offset>', fieldoffset, '</offset>');
+          WriteLn(T, PrintNodeIndention, '<size>', vardef.size, '</size>');
+        end;
+{$endif DEBUG_NODE_XML}
 
 {****************************************************************************
                         TABSTRACTNORMALVARSYM
@@ -2684,6 +2701,47 @@ implementation
         writeentry(ppufile,ibconstsym);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TConstSym.XMLPrintConstData(var T: Text);
+      begin
+        WriteLn(T, PrintNodeIndention, '<type>', SanitiseXMLString(constdef.GetTypeName), '</type>');
+
+        case consttyp of
+          constnone:
+            ;
+          conststring,
+          constresourcestring,
+          constwstring:
+            begin
+              WriteLn(T, PrintNodeIndention, '<length>', value.len, '</length>');
+              if value.len = 0 then
+                WriteLn(T, PrintNodeIndention, '<value />')
+              else
+                WriteLn(T, PrintNodeIndention, '<value>', SanitiseXMLString(PChar(value.valueptr)), '</value>');
+            end;
+          constord,
+          constset:
+            WriteLn(T, PrintNodeIndention, '<value>', tostr(value.valueord), '</value>');
+          constpointer:
+            WriteLn(T, PrintNodeIndention, '<value>', WriteConstPUInt(value.valueordptr), '</value>');
+          constreal:
+            WriteLn(T, PrintNodeIndention, '<value>', PBestReal(value.valueptr)^, '</value>');
+          constnil:
+            WriteLn(T, PrintNodeIndention, '<value>nil</value>');
+          constguid:
+            WriteLn(T, PrintNodeIndention, '<value>', WriteGUID(PGUID(value.valueptr)^), '</value>');
+        end;
+
+        WriteLn(T, PrintNodeIndention, '<visibility>', visibility, '</visibility>');
+
+        if not (consttyp in [conststring, constresourcestring, constwstring]) then
+          { constdef.size will return an internal error for string
+            constants because constdef is an open array internally }
+          WriteLn(T, PrintNodeIndention, '<size>', constdef.size, '</size>');
+
+//        WriteLn(T, PrintNodeIndention, '<const_type>', consttyp, '</const_type>');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {****************************************************************************
                                   TENUMSYM

+ 114 - 0
compiler/symtype.pas

@@ -58,6 +58,12 @@ interface
          { initialize the defid field; only call from a constructor as it threats
            0 as an invalid value! }
          procedure init_defid;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintDefTree(var T: Text; Sym: TSym); virtual;
+         procedure XMLPrintDefInfo(var T: Text; Sym: TSym); dynamic;
+         procedure XMLPrintDefData(var T: Text; Sym: TSym); virtual;
+         function XMLPrintType: ansistring; virtual;
+{$endif DEBUG_NODE_XML}
         public
          typesym    : tsym;  { which type the definition was generated this def }
          { stabs debugging }
@@ -102,6 +108,9 @@ interface
            has been requested; otherwise, first call register_def }
          function  deflist_index: longint;
          procedure register_def; virtual; abstract;
+{$ifdef DEBUG_NODE_XML}
+         procedure XMLPrintDef(Sym: TSym);
+{$endif DEBUG_NODE_XML}
          property is_registered: boolean read registered;
       end;
 
@@ -282,6 +291,84 @@ implementation
           defid:=defid_not_registered;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure tdef.XMLPrintDefTree(var T: Text; Sym: TSym);
+      begin
+        Write(T, PrintNodeIndention, '<definition');
+        XMLPrintDefInfo(T, Sym);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        { Printing the type here instead of in XMLPrintDefData ensures it
+          always appears first no matter how XMLPrintDefData is overridden }
+        WriteLn(T, PrintNodeIndention, '<type>', XMLPrintType, '</type>');
+        XMLPrintDefData(T, Sym);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</definition>');
+        WriteLn(T, PrintNodeIndention);
+      end;
+
+
+    procedure tdef.XMLPrintDefInfo(var T: Text; Sym: TSym);
+      var
+        i: TSymOption;
+        first: Boolean;
+      begin
+        { Note that if we've declared something like "INT = Integer", the
+          INT name gets lost in the system and 'typename' just returns
+          Integer, so the correct details can be found via Sym }
+        Write(T, ' name="', SanitiseXMLString(Sym.RealName),
+          '" pos="', Sym.fileinfo.line, ',', Sym.fileinfo.column);
+
+        First := True;
+        for i := Low(TSymOption) to High(TSymOption) do
+          if i in Sym.symoptions then
+            begin
+              if First then
+                begin
+                  Write(T, '" symoptions="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        Write(T, '"');
+      end;
+
+
+    procedure tdef.XMLPrintDefData(var T: Text; Sym: TSym);
+      begin
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+
+        if (alignment = structalignment) and (alignment = aggregatealignment) then
+          begin
+            { Straightforward and simple }
+            WriteLn(T, PrintNodeIndention, '<alignment>', alignment, '</alignment>');
+          end
+        else
+          begin
+            WriteLn(T, PrintNodeIndention, '<alignment>');
+            printnodeindent;
+            WriteLn(T, PrintNodeIndention, '<basic>', alignment, '</basic>');
+
+            if (structalignment <> alignment) then
+              WriteLn(T, PrintNodeIndention, '<struct>', structalignment, '</struct>');
+
+            if (aggregatealignment <> alignment) and (aggregatealignment <> structalignment) then
+              WriteLn(T, PrintNodeIndention, '<aggregate>', aggregatealignment, '</aggregate>');
+
+            printnodeunindent;
+            WriteLn(T, PrintNodeIndention, '</alignment>');
+          end;
+      end;
+
+
+    function tdef.XMLPrintType: ansistring;
+      begin
+        Result := SanitiseXMLString(GetTypeName);
+      end;
+
+{$endif DEBUG_NODE_XML}
 
     constructor tdef.create(dt:tdeftyp);
       begin
@@ -462,6 +549,33 @@ implementation
           internalerror(2015102502)
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TDef.XMLPrintDef(Sym: TSym);
+      var
+        T: Text;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+
+        XMLPrintDefTree(T, Sym);
+        Close(T);
+      end;
+
+{$endif DEBUG_NODE_XML}
+
+
 {****************************************************************************
                           TSYM (base for all symtypes)
 ****************************************************************************}

+ 18 - 0
compiler/verbose.pas

@@ -132,6 +132,7 @@ interface
 {$ifdef DEBUG_NODE_XML}
      function SanitiseXMLString(const S: ansistring): ansistring;
      function WritePointer(const P: Pointer): ansistring;
+     function WriteConstPUInt(const P: TConstPtrUInt): ansistring;
      function WriteGUID(const GUID: TGUID): ansistring;
 {$endif DEBUG_NODE_XML}
 
@@ -1063,6 +1064,23 @@ implementation
       end;
 
 
+    function WriteConstPUInt(const P: TConstPtrUInt): ansistring;
+      begin
+        case P of
+          0:
+            WriteConstPUInt := 'nil';
+          1..$FFFF:
+            WriteConstPUInt := '$' + hexstr(P, 4);
+          $10000..$FFFFFFFF:
+            WriteConstPUInt := '$' + hexstr(P, 8);
+    {$ifdef CPU64BITADDR}
+          else
+            WriteConstPUInt := '$' + hexstr(P, 16);
+    {$endif CPU64BITADDR}
+        end;
+      end;
+
+
     function WriteGUID(const GUID: TGUID): ansistring;
       var
         i: Integer;

+ 1 - 1
compiler/x86/rax86int.pas

@@ -3150,7 +3150,7 @@ Unit Rax86int;
                      end
                    else
 {$endif i8086}
-                     ConcatConstSymbol(curlist,asmsym,asmsymtyp,value,constsize,cseof_hasofs in cse_out_flags);
+                     ConcatConstSymbol(curlist,asmsym,'',asmsymtyp,value,constsize,cseof_hasofs in cse_out_flags);
                  end
                 else
                  ConcatConstant(curlist,value,constsize);

+ 111 - 84
packages/fcl-passrc/src/pasresolver.pp

@@ -1711,7 +1711,6 @@ type
     procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
     procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
       IsOverride: boolean);
-    procedure CheckPendingForwardProcs(El: TPasElement);
     procedure CheckPointerCycle(El: TPasPointerType);
     procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
     procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
@@ -2359,8 +2358,9 @@ type
     function GetGenericConstraintErrorEl(ConstraintEl, TemplType: TPasElement): TPasElement;
     function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
       Params: TFPList): TPasElement; virtual;
-    procedure FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope); virtual;
+    procedure FinishGenericClassOrRecIntf(Scope: TPasGenericScope); virtual;
     procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
+    procedure CheckPendingForwardProcs(El: TPasElement); virtual;
     function IsSpecialized(El: TPasGenericType): boolean; overload;
     function IsFullySpecialized(El: TPasGenericType): boolean; overload;
     function IsFullySpecialized(Proc: TPasProcedure): boolean; overload;
@@ -6296,7 +6296,7 @@ begin
   PopScope;
 
   Scope:=El.CustomData as TPasRecordScope;
-  FinishSpecializedClassOrRecIntf(Scope);
+  FinishGenericClassOrRecIntf(Scope);
 end;
 
 procedure TPasResolver.FinishClassType(El: TPasClassType);
@@ -6490,7 +6490,7 @@ begin
     PopGenericParamScope(El);
 
   if not El.IsForward then
-    FinishSpecializedClassOrRecIntf(ClassScope);
+    FinishGenericClassOrRecIntf(ClassScope);
 end;
 
 procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
@@ -6915,6 +6915,7 @@ var
   Arg: TPasArgument;
   ProcTypeScope: TPasProcTypeScope;
   C: TClass;
+  FuncType: TPasFunctionType;
 begin
   if TopScope.Element=El then
     begin
@@ -6955,7 +6956,11 @@ begin
       end;
 
     if El is TPasFunctionType then
-      CheckUseAsType(TPasFunctionType(El).ResultEl.ResultType,20190123095743,TPasFunctionType(El).ResultEl);
+      begin
+      FuncType:=TPasFunctionType(El);
+      if FuncType.ResultEl<>nil then
+        CheckUseAsType(FuncType.ResultEl.ResultType,20190123095743,FuncType.ResultEl);
+      end;
 
     if (proProcTypeWithoutIsNested in Options) and El.IsNested then
       RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
@@ -9288,6 +9293,7 @@ var
   ImplNameParts: TProcedureNameParts;
   ImplNamePart: TProcedureNamePart;
   ImplTemplType, DeclTemplType: TPasGenericTemplateType;
+  FuncType: TPasFunctionType;
 begin
   ImplProc:=ImplProcScope.Element as TPasProcedure;
   DeclProc:=ImplProcScope.DeclarationProc;
@@ -9351,14 +9357,26 @@ begin
       Identifier.Identifier:=DeclArg.Name;
       end
     else
-      RaiseNotYetImplemented(20170203161826,ImplProc);
+      begin
+      // e.g. when Delphi mode omits ImplProc signature
+      AddIdentifier(ImplProcScope,DeclArg.Name,DeclArg,pikSimple);
+      end;
     end;
   if DeclProc.ProcType is TPasFunctionType then
     begin
     // redirect implementation 'Result' to declaration FuncType.ResultEl
-    Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
-    if Identifier.Element is TPasResultElement then
-      Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
+    FuncType:=TPasFunctionType(DeclProc.ProcType);
+    if FuncType.ResultEl<>nil then
+      begin
+      Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
+      if Identifier=nil then
+        begin
+        // e.g. when Delphi mode omits ImplProc signature
+        AddIdentifier(ImplProcScope,ResolverResultVar,FuncType.ResultEl,pikSimple);
+        end
+      else if Identifier.Element is TPasResultElement then
+        Identifier.Element:=FuncType.ResultEl;
+      end;
     end;
 end;
 
@@ -11835,71 +11853,6 @@ begin
   Traverse(Expr,ArrType,0);
 end;
 
-procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
-var
-  i: Integer;
-  DeclEl: TPasElement;
-  Proc: TPasProcedure;
-  aClassOrRec: TPasMembersType;
-  ClassOrRecScope: TPasClassOrRecordScope;
-begin
-  if IsElementSkipped(El) then exit;
-  if El is TPasDeclarations then
-    begin
-    for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
-      begin
-      DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
-      if DeclEl is TPasProcedure then
-        begin
-        Proc:=TPasProcedure(DeclEl);
-        if ProcNeedsImplProc(Proc)
-            and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
-          RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
-            [GetElementTypeName(Proc),Proc.Name],Proc);
-        end;
-      end;
-    end
-  else if El is TPasMembersType then
-    begin
-    aClassOrRec:=TPasMembersType(El);
-    if (aClassOrRec is TPasClassType) then
-      begin
-      if (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface]) then
-        exit;
-      if TPasClassType(aClassOrRec).IsForward then
-        exit;
-      if TPasClassType(aClassOrRec).IsExternal then
-        exit;
-      end;
-    ClassOrRecScope:=aClassOrRec.CustomData as TPasClassOrRecordScope;
-    if ClassOrRecScope.SpecializedFromItem<>nil then
-      exit;
-    // finish implementation of (generic) class/record
-    if ClassOrRecScope.GenericStep<>psgsInterfaceParsed then
-      RaiseNotYetImplemented(20190804115324,El);
-    for i:=0 to aClassOrRec.Members.Count-1 do
-      begin
-      DeclEl:=TPasElement(aClassOrRec.Members[i]);
-      if DeclEl is TPasProcedure then
-        begin
-        Proc:=TPasProcedure(DeclEl);
-        if Proc.IsAbstract or Proc.IsExternal then continue;
-        if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
-          begin
-          {$IFDEF VerbosePasResolver}
-          writeln('TPasResolver.CheckPendingForwardProcs Proc.ParentPath=',Proc.PathName);
-          {$ENDIF}
-          RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
-            [GetElementTypeName(Proc),Proc.Name],Proc);
-          end;
-        end;
-      end;
-    ClassOrRecScope.GenericStep:=psgsImplementationParsed;
-    if ClassOrRecScope.SpecializedItems<>nil then
-      FinishSpecializations(ClassOrRecScope);
-    end;
-end;
-
 procedure TPasResolver.CheckPointerCycle(El: TPasPointerType);
 var
   C: TClass;
@@ -17773,7 +17726,12 @@ begin
     begin
     GenProcType:=GenEl.ProcType;
     if GenProcType.Parent<>GenEl then
-      RaiseNotYetImplemented(20190803212426,GenEl,GetObjName(GenProcType.Parent));
+      begin
+      {$IFDEF defined(VerbosePCUFiler) or defined(VerbosePJUFiler)}
+      writeln('TPasResolver.SpecializeProcedure GenEl=',GetObjPath(GenEl),' GenProcType.Parent=',GetObjPath(GenProcType.Parent));
+      {$ENDIF}
+      RaiseNotYetImplemented(20190803212426,GenEl,GetObjPath(GenProcType.Parent));
+      end;
     NewClass:=TPTreeElement(GenProcType.ClassType);
     SpecEl.ProcType:=TPasProcedureType(NewClass.Create(GenProcType.Name,SpecEl));
     SpecializeElement(GenProcType,SpecEl.ProcType);
@@ -17855,13 +17813,16 @@ begin
   if SpecEl is TPasFunctionType then
     begin
     GenResultEl:=TPasFunctionType(GenEl).ResultEl;
-    if GenResultEl.Parent<>GenEl then
-      RaiseNotYetImplemented(20190803212935,GenEl,GetObjName(GenResultEl.Parent));
-    NewClass:=TPTreeElement(GenResultEl.ClassType);
-    NewResultEl:=TPasResultElement(NewClass.Create(GenResultEl.Name,SpecEl));
-    TPasFunctionType(SpecEl).ResultEl:=NewResultEl;
-    AddFunctionResult(NewResultEl);
-    SpecializeElType(GenResultEl,NewResultEl,GenResultEl.ResultType,NewResultEl.ResultType);
+    if GenResultEl<>nil then
+      begin
+      if GenResultEl.Parent<>GenEl then
+        RaiseNotYetImplemented(20190803212935,GenEl,GetObjName(GenResultEl.Parent));
+      NewClass:=TPTreeElement(GenResultEl.ClassType);
+      NewResultEl:=TPasResultElement(NewClass.Create(GenResultEl.Name,SpecEl));
+      TPasFunctionType(SpecEl).ResultEl:=NewResultEl;
+      AddFunctionResult(NewResultEl);
+      SpecializeElType(GenResultEl,NewResultEl,GenResultEl.ResultType,NewResultEl.ResultType);
+      end;
     end;
 
   FinishProcedureType(SpecEl);
@@ -28783,7 +28744,7 @@ begin
     end;
 end;
 
-procedure TPasResolver.FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope);
+procedure TPasResolver.FinishGenericClassOrRecIntf(Scope: TPasGenericScope);
 var
   El: TPasGenericType;
   SpecializedItems: TObjectList;
@@ -28831,6 +28792,71 @@ begin
     SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
 end;
 
+procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
+var
+  i: Integer;
+  DeclEl: TPasElement;
+  Proc: TPasProcedure;
+  aClassOrRec: TPasMembersType;
+  ClassOrRecScope: TPasClassOrRecordScope;
+begin
+  if IsElementSkipped(El) then exit;
+  if El is TPasDeclarations then
+    begin
+    for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
+      begin
+      DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
+      if DeclEl is TPasProcedure then
+        begin
+        Proc:=TPasProcedure(DeclEl);
+        if ProcNeedsImplProc(Proc)
+            and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
+          RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
+            [GetElementTypeName(Proc),Proc.Name],Proc);
+        end;
+      end;
+    end
+  else if El is TPasMembersType then
+    begin
+    aClassOrRec:=TPasMembersType(El);
+    if (aClassOrRec is TPasClassType) then
+      begin
+      if (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface]) then
+        exit;
+      if TPasClassType(aClassOrRec).IsForward then
+        exit;
+      if TPasClassType(aClassOrRec).IsExternal then
+        exit;
+      end;
+    ClassOrRecScope:=aClassOrRec.CustomData as TPasClassOrRecordScope;
+    if ClassOrRecScope.SpecializedFromItem<>nil then
+      exit;
+    // finish implementation of (generic) class/record
+    if ClassOrRecScope.GenericStep<>psgsInterfaceParsed then
+      RaiseNotYetImplemented(20190804115324,El);
+    for i:=0 to aClassOrRec.Members.Count-1 do
+      begin
+      DeclEl:=TPasElement(aClassOrRec.Members[i]);
+      if DeclEl is TPasProcedure then
+        begin
+        Proc:=TPasProcedure(DeclEl);
+        if Proc.IsAbstract or Proc.IsExternal then continue;
+        if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
+          begin
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.CheckPendingForwardProcs Proc.ParentPath=',Proc.PathName);
+          {$ENDIF}
+          RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
+            [GetElementTypeName(Proc),Proc.Name],Proc);
+          end;
+        end;
+      end;
+    ClassOrRecScope.GenericStep:=psgsImplementationParsed;
+    if ClassOrRecScope.SpecializedItems<>nil then
+      FinishSpecializations(ClassOrRecScope);
+    end;
+end;
+
 function TPasResolver.IsSpecialized(El: TPasGenericType): boolean;
 begin
   Result:=(El<>nil) and (El.CustomData is TPasGenericScope)
@@ -29665,7 +29691,8 @@ begin
     RaiseInternalError(20180215185302,GetObjName(El));
   if Data.ClassType=TResElDataBaseType then
     Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
-  else if Data.ClassType=TResElDataBuiltInProc then
+  else if (Data.ClassType=TResElDataBuiltInProc)
+      and (TResElDataBuiltInProc(Data).BuiltIn<>bfCustom) then
     Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
   else
     Result:=nil;

+ 65 - 22
packages/pastojs/src/fppas2js.pp

@@ -1091,6 +1091,17 @@ const
     'JSValue'
     );
 
+type
+  TPas2jsBuiltInProc = (
+    pbpDebugger,
+    pbpAWait
+    );
+const
+  Pas2jsBuiltInProcNames: array[TPas2jsBuiltInProc] of string = (
+    'Debugger',
+    'AWait'
+    );
+
 const
   ClassVarModifiersType = [vmClass,vmStatic];
   LowJSNativeInt = MinSafeIntDouble;
@@ -1443,9 +1454,11 @@ type
   TPas2JSResolver = class(TPasResolver)
   private
     FJSBaseTypes: array[TPas2jsBaseType] of TPasUnresolvedSymbolRef;
+    FJSBuiltInProcs: array[TPas2jsBuiltInProc] of TResElDataBuiltInProc;
     FExternalNames: TPasResHashList; // list of TPasIdentifier, case sensitive
     FFirstElementData, FLastElementData: TPas2JsElementData;
     function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
+    function GetJSBuiltInProcs(aProc: TPas2jsBuiltInProc): TResElDataBuiltInProc; inline;
     procedure InternalAdd(Item: TPasIdentifier);
     procedure OnClearHashItem(Item, Dummy: pointer);
   protected
@@ -1602,6 +1615,7 @@ type
       RaiseOnError: boolean): integer; override;
     function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; override;
     property JSBaseTypes[aBaseType: TPas2jsBaseType]: TPasUnresolvedSymbolRef read GetJSBaseTypes;
+    property JSBuiltInProcs[aProc: TPas2jsBuiltInProc]: TResElDataBuiltInProc read GetJSBuiltInProcs;
     // compute literals and constants
     function ExtractPasStringLiteral(El: TPasElement; const S: String): TJSString; virtual;
     function ResolverToJSValue(Value: TResEvalValue; ErrorEl: TPasElement): TJSValue; virtual;
@@ -3177,7 +3191,13 @@ end;
 function TPas2JSResolver.GetJSBaseTypes(aBaseType: TPas2jsBaseType
   ): TPasUnresolvedSymbolRef;
 begin
-  Result:=TPasUnresolvedSymbolRef(FJSBaseTypes[aBaseType]);
+  Result:=FJSBaseTypes[aBaseType];
+end;
+
+function TPas2JSResolver.GetJSBuiltInProcs(aProc: TPas2jsBuiltInProc
+  ): TResElDataBuiltInProc;
+begin
+  Result:=FJSBuiltInProcs[aProc];
 end;
 
 procedure TPas2JSResolver.InternalAdd(Item: TPasIdentifier);
@@ -4553,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;
 
@@ -5224,6 +5249,7 @@ begin
 
   El:=SpecializedItem.SpecializedEl;
   if (El is TPasGenericType)
+      and IsFullySpecialized(TPasGenericType(El))
       and (SpecializeParamsNeedDelay(SpecializedItem)<>nil) then
     TPas2JSResolverHub(Hub).AddJSDelaySpecialize(TPasGenericType(El));
 
@@ -6190,10 +6216,13 @@ end;
 procedure TPas2JSResolver.ClearBuiltInIdentifiers;
 var
   bt: TPas2jsBaseType;
+  pbp: TPas2jsBuiltInProc;
 begin
   inherited ClearBuiltInIdentifiers;
   for bt in TPas2jsBaseType do
     ReleaseAndNil(TPasElement(FJSBaseTypes[bt]){$IFDEF CheckPasTreeRefCount},'TPasResolver.AddCustomBaseType'{$ENDIF});
+  for pbp in TPas2jsBuiltInProc do
+    FJSBuiltInProcs[pbp]:=nil;
 end;
 
 function TPas2JSResolver.IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType
@@ -6236,13 +6265,12 @@ begin
     AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
   if btIntDouble in TheBaseTypes then
     AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
-  AddBuiltInProc('Debugger','procedure Debugger',
+  FJSBuiltInProcs[pbpDebugger]:=AddBuiltInProc(Pas2jsBuiltInProcNames[pbpDebugger],
+      'procedure Debugger',
       @BI_Debugger_OnGetCallCompatibility,nil,
       nil,nil,bfCustom,[bipfCanBeStatement]);
-  // ToDo: AddBuiltInProc('Await','function await(T; const Expr: TJSPromise): T',
-  //    @BI_Await_OnGetCallCompatibility,@BI_Await_OnGetCallResult,
-  //    nil,nil,bfCustom,[bipfCanBeStatement]);
-  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;
@@ -6444,11 +6472,20 @@ begin
 end;
 
 function TPas2JSResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
+var
+  Data: TObject;
+  pbp: TPas2jsBuiltInProc;
 begin
   Result:=inherited FindLocalBuiltInSymbol(El);
   if Result<>nil then exit;
-  if El.CustomData is TResElDataPas2JSBaseType then
-    Result:=JSBaseTypes[TResElDataPas2JSBaseType(El.CustomData).JSBaseType];
+  Data:=El.CustomData;
+  if Data is TResElDataPas2JSBaseType then
+    Result:=JSBaseTypes[TResElDataPas2JSBaseType(Data).JSBaseType]
+  else if (Data.ClassType=TResElDataBuiltInProc)
+      and (TResElDataBuiltInProc(Data).BuiltIn=bfCustom) then
+    for pbp in TPas2jsBuiltInProc do
+      if El.Name=Pas2jsBuiltInProcNames[pbp] then
+        Result:=FJSBuiltInProcs[pbp].Element;
 end;
 
 function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
@@ -14975,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;
@@ -17579,6 +17620,8 @@ var
   aResolver: TPas2JSResolver;
 begin
   if not IsElementUsed(El) then exit;
+  if not AContext.Resolver.IsFullySpecialized(El) then
+    RaiseNotSupported(El,AContext,20201202145045,'not fully specialized, probably a bug in the analyzer');
   if not SpecializeNeedsDelay(El,AContext) then exit;
   C:=El.ClassType;
   if (C=TPasRecordType)

+ 51 - 7
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;

+ 0 - 1
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