Răsfoiți Sursa

* synchronized with trunk

git-svn-id: branches/wasm@48022 -
nickysn 4 ani în urmă
părinte
comite
052d1bc38a
51 a modificat fișierele cu 1863 adăugiri și 1089 ștergeri
  1. 9 0
      .gitattributes
  2. 3 0
      compiler/dbgstabs.pas
  3. 58 23
      compiler/nadd.pas
  4. 17 3
      compiler/pdecsub.pas
  5. 2 2
      compiler/pexports.pas
  6. 41 19
      compiler/pexpr.pas
  7. 18 13
      compiler/pgenutil.pas
  8. 10 0
      compiler/symtable.pas
  9. 3 1
      compiler/x86/nx86inl.pas
  10. 2 0
      packages/fcl-passrc/src/pasresolveeval.pas
  11. 57 9
      packages/fcl-passrc/src/pasresolver.pp
  12. 3 0
      packages/fcl-passrc/src/pastree.pp
  13. 36 20
      packages/fcl-passrc/src/pparser.pp
  14. 20 0
      packages/fcl-passrc/tests/tcresolver.pas
  15. 2 0
      packages/pastojs/src/pas2jsfiler.pp
  16. 1 0
      packages/pastojs/tests/tcfiler.pas
  17. 14 0
      packages/rtl-objpas/src/inc/nullable.pp
  18. 1 1
      rtl/aarch64/mathu.inc
  19. 2 1
      rtl/arm/mathu.inc
  20. 1 0
      rtl/i386/mathu.inc
  21. 1 0
      rtl/i8086/mathu.inc
  22. 1 1
      rtl/m68k/mathu.inc
  23. 1 0
      rtl/mips/mathu.inc
  24. 1 1
      rtl/powerpc/mathu.inc
  25. 1 1
      rtl/powerpc64/mathu.inc
  26. 1 1
      rtl/riscv64/mathu.inc
  27. 1 0
      rtl/sparc/mathu.inc
  28. 1 0
      rtl/sparc64/mathu.inc
  29. 8 0
      rtl/win/syswin.inc
  30. 1 0
      rtl/x86_64/mathu.inc
  31. 1 0
      rtl/xtensa/mathu.inc
  32. 25 0
      tests/test/tgenfunc24.pp
  33. 24 0
      tests/test/tgenfunc25.pp
  34. 24 0
      tests/test/tgenfunc26.pp
  35. 24 0
      tests/test/tgenfunc27.pp
  36. 152 4
      tests/test/units/math/trndcurr.pp
  37. 8 0
      tests/webtbf/tw38289a.pp
  38. 8 0
      tests/webtbf/tw38289b.pp
  39. 30 1
      tests/webtbs/tw38267b.pp
  40. 19 0
      tests/webtbs/tw38295.pp
  41. 15 0
      tests/webtbs/tw38299.pp
  42. 13 1
      utils/fpdoc/dglobals.pp
  43. 1060 0
      utils/fpdoc/dw_basehtml.pp
  44. 20 7
      utils/fpdoc/dw_basemd.pp
  45. 15 8
      utils/fpdoc/dw_chm.pp
  46. 70 962
      utils/fpdoc/dw_html.pp
  47. 12 7
      utils/fpdoc/dw_markdown.pp
  48. 19 0
      utils/fpdoc/dwriter.pp
  49. 5 1
      utils/fpdoc/fpdoc.lpi
  50. 1 1
      utils/fpdoc/fpdoc.pp
  51. 1 1
      utils/fpdoc/fpdocclasstree.pp

+ 9 - 0
.gitattributes

@@ -15229,6 +15229,10 @@ tests/test/tgenfunc20.pp svneol=native#text/pascal
 tests/test/tgenfunc21.pp svneol=native#text/pascal
 tests/test/tgenfunc21.pp svneol=native#text/pascal
 tests/test/tgenfunc22.pp svneol=native#text/pascal
 tests/test/tgenfunc22.pp svneol=native#text/pascal
 tests/test/tgenfunc23.pp svneol=native#text/pascal
 tests/test/tgenfunc23.pp svneol=native#text/pascal
+tests/test/tgenfunc24.pp svneol=native#text/pascal
+tests/test/tgenfunc25.pp svneol=native#text/pascal
+tests/test/tgenfunc26.pp svneol=native#text/pascal
+tests/test/tgenfunc27.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
 tests/test/tgenfunc5.pp svneol=native#text/pascal
 tests/test/tgenfunc5.pp svneol=native#text/pascal
@@ -16745,6 +16749,8 @@ tests/webtbf/tw37476.pp svneol=native#text/pascal
 tests/webtbf/tw37763.pp svneol=native#text/pascal
 tests/webtbf/tw37763.pp svneol=native#text/pascal
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3812.pp svneol=native#text/plain
 tests/webtbf/tw3812.pp svneol=native#text/plain
+tests/webtbf/tw38289a.pp svneol=native#text/pascal
+tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3930a.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3931b.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
 tests/webtbf/tw3969.pp svneol=native#text/plain
@@ -18672,6 +18678,8 @@ tests/webtbs/tw38267a.pp svneol=native#text/pascal
 tests/webtbs/tw38267b.pp svneol=native#text/pascal
 tests/webtbs/tw38267b.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
+tests/webtbs/tw38295.pp svneol=native#text/pascal
+tests/webtbs/tw38299.pp svneol=native#text/pascal
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain
@@ -19338,6 +19346,7 @@ utils/fpdoc/Makefile.fpc.fpcmake svneol=native#text/plain
 utils/fpdoc/README.txt svneol=native#text/plain
 utils/fpdoc/README.txt svneol=native#text/plain
 utils/fpdoc/css.inc svneol=native#text/plain
 utils/fpdoc/css.inc svneol=native#text/plain
 utils/fpdoc/dglobals.pp svneol=native#text/plain
 utils/fpdoc/dglobals.pp svneol=native#text/plain
+utils/fpdoc/dw_basehtml.pp svneol=native#text/plain
 utils/fpdoc/dw_basemd.pp svneol=native#text/plain
 utils/fpdoc/dw_basemd.pp svneol=native#text/plain
 utils/fpdoc/dw_chm.pp svneol=native#text/plain
 utils/fpdoc/dw_chm.pp svneol=native#text/plain
 utils/fpdoc/dw_dxml.pp svneol=native#text/plain
 utils/fpdoc/dw_dxml.pp svneol=native#text/plain

+ 3 - 0
compiler/dbgstabs.pas

@@ -480,6 +480,9 @@ implementation
       begin
       begin
         if tsym(p).typ = procsym then
         if tsym(p).typ = procsym then
          begin
          begin
+           if (sp_generic_dummy in tsym(p).symoptions) and
+               (tprocsym(p).procdeflist.count=0) then
+             exit;
            pd :=tprocdef(tprocsym(p).ProcdefList[0]);
            pd :=tprocdef(tprocsym(p).ProcdefList[0]);
            if (po_virtualmethod in pd.procoptions) and
            if (po_virtualmethod in pd.procoptions) and
                not is_objectpascal_helper(pd.struct) then
                not is_objectpascal_helper(pd.struct) then

+ 58 - 23
compiler/nadd.pas

@@ -536,12 +536,28 @@ implementation
 
 
       function SwapLeftWithRightRight : tnode;
       function SwapLeftWithRightRight : tnode;
         var
         var
-          hp: tnode;
+          hp,hp2 : tnode;
         begin
         begin
-          hp:=left;
-          left:=taddnode(right).right;
-          taddnode(right).right:=hp;
-          right:=right.simplify(false);
+          { keep the order of val+const else string operations might cause an error }
+          hp:=taddnode(right).right;
+
+          taddnode(right).right:=taddnode(right).left;
+          taddnode(right).left:=left;
+
+          right.resultdef:=nil;
+          do_typecheckpass(right);
+          hp2:=right.simplify(forinline);
+          if assigned(hp2) then
+            right:=hp2;
+          if resultdef.typ<>pointerdef then
+            begin
+              { ensure that the constant is not expanded to a larger type due to overflow,
+                but this is only useful if no pointer operation is done }
+              right:=ctypeconvnode.create_internal(right,resultdef);
+              do_typecheckpass(right);
+            end;
+          left:=right;
+          right:=hp;
           result:=GetCopyAndTypeCheck;
           result:=GetCopyAndTypeCheck;
         end;
         end;
 
 
@@ -1207,23 +1223,7 @@ implementation
              exit;
              exit;
           end;
           end;
 
 
-        { try to fold
-                    op
-                   /  \
-                 op  const1
-                /  \
-              val const2
-
-          while operating on strings
-        }
-        if (cs_opt_level2 in current_settings.optimizerswitches) and (nodetype=addn) and ((rt=stringconstn) or is_constcharnode(right)) and (left.nodetype=nodetype) and
-          (compare_defs(resultdef,left.resultdef,nothingn)=te_exact) and ((taddnode(left).right.nodetype=stringconstn) or is_constcharnode(taddnode(left).right)) then
-          begin
-            Result:=SwapRightWithLeftLeft;
-            exit;
-          end;
-
-          { set constant evaluation }
+        { set constant evaluation }
         if (right.nodetype=setconstn) and
         if (right.nodetype=setconstn) and
            not assigned(tsetconstnode(right).left) and
            not assigned(tsetconstnode(right).left) and
            (left.nodetype=setconstn) and
            (left.nodetype=setconstn) and
@@ -1381,9 +1381,44 @@ implementation
             exit;
             exit;
           end;
           end;
 
 
-        { slow simplifications }
+        { slow simplifications and/or more sophisticated transformations which might make debugging harder }
         if cs_opt_level2 in current_settings.optimizerswitches then
         if cs_opt_level2 in current_settings.optimizerswitches then
           begin
           begin
+            if nodetype=addn then
+              begin
+                { try to fold
+                            op
+                           /  \
+                         op  const1
+                        /  \
+                      val const2
+
+                  while operating on strings
+                }
+                if ((rt=stringconstn) or is_constcharnode(right)) and (left.nodetype=nodetype) and
+                  (compare_defs(resultdef,left.resultdef,nothingn)=te_exact) and ((taddnode(left).right.nodetype=stringconstn) or is_constcharnode(taddnode(left).right)) then
+                  begin
+                    Result:=SwapRightWithLeftLeft;
+                    exit;
+                  end;
+
+                { try to fold
+                              op
+                             /  \
+                         const1  op
+                                /  \
+                            const2 val
+
+                  while operating on strings
+                }
+                if ((lt=stringconstn) or is_constcharnode(left)) and (right.nodetype=nodetype) and
+                  (compare_defs(resultdef,right.resultdef,nothingn)=te_exact) and ((taddnode(right).left.nodetype=stringconstn) or is_constcharnode(taddnode(right).left)) then
+                  begin
+                    Result:=SwapLeftWithRightRight;
+                    exit;
+                  end;
+              end;
+
             { the comparison is might be expensive and the nodes are usually only
             { the comparison is might be expensive and the nodes are usually only
               equal if some previous optimizations were done so don't check
               equal if some previous optimizations were done so don't check
               this simplification always
               this simplification always

+ 17 - 3
compiler/pdecsub.pas

@@ -1066,7 +1066,8 @@ implementation
                            end
                            end
                          else if (srsym.typ=typesym) and
                          else if (srsym.typ=typesym) and
                              (sp_generic_dummy in srsym.symoptions) and
                              (sp_generic_dummy in srsym.symoptions) and
-                             (ttypesym(srsym).typedef.typ=undefineddef) then
+                             (ttypesym(srsym).typedef.typ=undefineddef) and
+                             not assigned(genericparams) then
                            begin
                            begin
                              { this is a generic dummy symbol that has not yet
                              { this is a generic dummy symbol that has not yet
                                been used; so we rename the dummy symbol and continue
                                been used; so we rename the dummy symbol and continue
@@ -1162,13 +1163,26 @@ implementation
               end;
               end;
             if not assigned(dummysym) then
             if not assigned(dummysym) then
               begin
               begin
-                dummysym:=ctypesym.create(orgspnongen,cundefineddef.create(true));
+                { overloading generic routines with non-generic types is not
+                  allowed, so we create a procsym as dummy }
+                dummysym:=cprocsym.create(orgspnongen);
                 if assigned(astruct) then
                 if assigned(astruct) then
                   astruct.symtable.insert(dummysym)
                   astruct.symtable.insert(dummysym)
                 else
                 else
                   symtablestack.top.insert(dummysym);
                   symtablestack.top.insert(dummysym);
+              end
+            else if (dummysym.typ<>procsym) and
+                (
+                  { show error only for the declaration, not also the implementation }
+                  not assigned(astruct) or
+                  (symtablestack.top.symtablelevel<>main_program_level)
+                ) then
+              Message1(sym_e_duplicate_id,dummysym.realname);
+            if not (sp_generic_dummy in dummysym.symoptions) then
+              begin
+                include(dummysym.symoptions,sp_generic_dummy);
+                add_generic_dummysym(dummysym);
               end;
               end;
-            include(dummysym.symoptions,sp_generic_dummy);
             { start token recorder for the declaration }
             { start token recorder for the declaration }
             pd.init_genericdecl;
             pd.init_genericdecl;
             current_scanner.startrecordtokens(pd.genericdecltokenbuf);
             current_scanner.startrecordtokens(pd.genericdecltokenbuf);

+ 2 - 2
compiler/pexports.pas

@@ -149,7 +149,7 @@ implementation
                        else
                        else
                         begin
                         begin
                           index:=0;
                           index:=0;
-                          consume(_INTCONST);
+                          message(type_e_ordinal_expr_expected);
                         end;
                         end;
                        include(options,eo_index);
                        include(options,eo_index);
                        pt.free;
                        pt.free;
@@ -166,7 +166,7 @@ implementation
                        else if is_constcharnode(pt) then
                        else if is_constcharnode(pt) then
                          hpname:=chr(tordconstnode(pt).value.svalue and $ff)
                          hpname:=chr(tordconstnode(pt).value.svalue and $ff)
                        else
                        else
-                         consume(_CSTRING);
+                         message(type_e_string_expr_expected);
                        include(options,eo_name);
                        include(options,eo_name);
                        pt.free;
                        pt.free;
                        DefString:=hpname+'='+InternalProcName;
                        DefString:=hpname+'='+InternalProcName;

+ 41 - 19
compiler/pexpr.pas

@@ -1514,13 +1514,15 @@ implementation
             begin
             begin
               if srsym.typ=typesym then
               if srsym.typ=typesym then
                 spezdef:=ttypesym(srsym).typedef
                 spezdef:=ttypesym(srsym).typedef
+              else if tprocsym(srsym).procdeflist.count>0 then
+                spezdef:=tdef(tprocsym(srsym).procdeflist[0])
               else
               else
-                spezdef:=tdef(tprocsym(srsym).procdeflist[0]);
-              if (spezdef.typ=errordef) and (sp_generic_dummy in srsym.symoptions) then
+                spezdef:=nil;
+              if (not assigned(spezdef) or (spezdef.typ=errordef)) and (sp_generic_dummy in srsym.symoptions) then
                 symname:=srsym.RealName
                 symname:=srsym.RealName
               else
               else
                 symname:='';
                 symname:='';
-              spezdef:=generate_specialization_phase1(spezcontext,spezdef,symname);
+              spezdef:=generate_specialization_phase1(spezcontext,spezdef,symname,srsym.owner);
               case spezdef.typ of
               case spezdef.typ of
                 errordef:
                 errordef:
                   begin
                   begin
@@ -2994,7 +2996,7 @@ implementation
                      begin
                      begin
                        {$push}
                        {$push}
                        {$warn 5036 off}
                        {$warn 5036 off}
-                       hdef:=generate_specialization_phase1(spezcontext,nil,nil,orgstoredpattern,dummypos);
+                       hdef:=generate_specialization_phase1(spezcontext,nil,nil,orgstoredpattern,nil,dummypos);
                        {$pop}
                        {$pop}
                        if hdef=generrordef then
                        if hdef=generrordef then
                          begin
                          begin
@@ -3048,12 +3050,20 @@ implementation
                wasgenericdummy:=false;
                wasgenericdummy:=false;
                if assigned(srsym) and
                if assigned(srsym) and
                    (sp_generic_dummy in srsym.symoptions) and
                    (sp_generic_dummy in srsym.symoptions) and
-                   (srsym.typ=typesym) and
+                   (srsym.typ in [procsym,typesym]) and
                    (
                    (
                      (
                      (
                        (m_delphi in current_settings.modeswitches) and
                        (m_delphi in current_settings.modeswitches) and
                        not (token in [_LT, _LSHARPBRACKET]) and
                        not (token in [_LT, _LSHARPBRACKET]) and
-                       (ttypesym(srsym).typedef.typ=undefineddef)
+                       (
+                         (
+                           (srsym.typ=typesym) and
+                           (ttypesym(srsym).typedef.typ=undefineddef)
+                         ) or (
+                           (srsym.typ=procsym) and
+                           (tprocsym(srsym).procdeflist.count=0)
+                         )
+                       )
                      )
                      )
                      or
                      or
                      (
                      (
@@ -3306,8 +3316,14 @@ implementation
                 procsym :
                 procsym :
                   begin
                   begin
                     p1:=nil;
                     p1:=nil;
+                    if (m_delphi in current_settings.modeswitches) and
+                        (sp_generic_dummy in srsym.symoptions) and
+                        (token in [_LT,_LSHARPBRACKET]) then
+                      begin
+                        p1:=cspecializenode.create(nil,getaddr,srsym)
+                      end
                     { check if it's a method/class method }
                     { check if it's a method/class method }
-                    if is_member_read(srsym,srsymtable,p1,hdef) then
+                    else if is_member_read(srsym,srsymtable,p1,hdef) then
                       begin
                       begin
                         { if we are accessing a owner procsym from the nested }
                         { if we are accessing a owner procsym from the nested }
                         { class we need to call it as a class member          }
                         { class we need to call it as a class member          }
@@ -3558,17 +3574,20 @@ implementation
                  (block_type=bt_body) and
                  (block_type=bt_body) and
                  (token in [_LT,_LSHARPBRACKET]) then
                  (token in [_LT,_LSHARPBRACKET]) then
                begin
                begin
-                 if p1.nodetype=typen then
-                   idstr:=ttypenode(p1).typesym.name
-                 else
-                   if (p1.nodetype=loadvmtaddrn) and
-                       (tloadvmtaddrnode(p1).left.nodetype=typen) then
-                     idstr:=ttypenode(tloadvmtaddrnode(p1).left).typesym.name
+                 idstr:='';
+                 case p1.nodetype of
+                   typen:
+                     idstr:=ttypenode(p1).typesym.name;
+                   loadvmtaddrn:
+                     if tloadvmtaddrnode(p1).left.nodetype=typen then
+                       idstr:=ttypenode(tloadvmtaddrnode(p1).left).typesym.name;
+                   loadn:
+                     idstr:=tloadnode(p1).symtableentry.name;
+                   calln:
+                     idstr:=tcallnode(p1).symtableprocentry.name;
                    else
                    else
-                     if (p1.nodetype=loadn) then
-                       idstr:=tloadnode(p1).symtableentry.name
-                     else
-                       idstr:='';
+                     ;
+                 end;
                  { if this is the case then the postfix handling is done in
                  { if this is the case then the postfix handling is done in
                    sub_expr if necessary }
                    sub_expr if necessary }
                  dopostfix:=not could_be_generic(idstr);
                  dopostfix:=not could_be_generic(idstr);
@@ -4211,7 +4230,8 @@ implementation
             typesym:
             typesym:
               result:=ttypesym(sym).typedef;
               result:=ttypesym(sym).typedef;
             procsym:
             procsym:
-              result:=tdef(tprocsym(sym).procdeflist[0]);
+              if not (sp_generic_dummy in sym.symoptions) or (tprocsym(sym).procdeflist.count>0) then
+                result:=tdef(tprocsym(sym).procdeflist[0]);
             else
             else
               internalerror(2015092701);
               internalerror(2015092701);
           end;
           end;
@@ -4230,6 +4250,8 @@ implementation
             loadn:
             loadn:
               if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
               if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
                 srsym:=nil;
                 srsym:=nil;
+            calln:
+              srsym:=tcallnode(n).symtableprocentry;
             specializen:
             specializen:
               srsym:=tspecializenode(n).sym;
               srsym:=tspecializenode(n).sym;
             { TODO : handle const nodes }
             { TODO : handle const nodes }
@@ -4264,7 +4286,7 @@ implementation
             end;
             end;
 
 
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
-            gendef:=generate_specialization_phase1(spezcontext,gendef,parseddef,gensym.realname,p2.fileinfo)
+            gendef:=generate_specialization_phase1(spezcontext,gendef,parseddef,gensym.realname,gensym.owner,p2.fileinfo)
           else
           else
             gendef:=generate_specialization_phase1(spezcontext,gendef);
             gendef:=generate_specialization_phase1(spezcontext,gendef);
           case gendef.typ of
           case gendef.typ of

+ 18 - 13
compiler/pgenutil.pas

@@ -39,8 +39,8 @@ uses
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);inline;
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);inline;
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);inline;
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string):tdef;inline;
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string;symtable:tsymtable):tdef;inline;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
     function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
     function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
     function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
     function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
@@ -613,23 +613,23 @@ uses
 {$push}
 {$push}
 {$warn 5036 off}
 {$warn 5036 off}
       begin
       begin
-        result:=generate_specialization_phase1(context,genericdef,nil,'',dummypos);
+        result:=generate_specialization_phase1(context,genericdef,nil,'',nil,dummypos);
       end;
       end;
 {$pop}
 {$pop}
 
 
 
 
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string;symtable:tsymtable):tdef;
       var
       var
         dummypos : tfileposinfo;
         dummypos : tfileposinfo;
 {$push}
 {$push}
 {$warn 5036 off}
 {$warn 5036 off}
       begin
       begin
-        result:=generate_specialization_phase1(context,genericdef,nil,symname,dummypos);
+        result:=generate_specialization_phase1(context,genericdef,nil,symname,symtable,dummypos);
       end;
       end;
 {$pop}
 {$pop}
 
 
 
 
-    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef;
+    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
       var
       var
         found,
         found,
         err : boolean;
         err : boolean;
@@ -637,6 +637,7 @@ uses
         gencount : longint;
         gencount : longint;
         countstr,genname,ugenname : string;
         countstr,genname,ugenname : string;
         tmpstack : tfpobjectlist;
         tmpstack : tfpobjectlist;
+        symowner : tsymtable;
       begin
       begin
         context:=nil;
         context:=nil;
         result:=nil;
         result:=nil;
@@ -741,12 +742,17 @@ uses
 
 
         context.genname:=genname;
         context.genname:=genname;
 
 
-        if assigned(genericdef) and (genericdef.owner.symtabletype in [objectsymtable,recordsymtable]) then
+        if assigned(genericdef) then
+          symowner:=genericdef.owner
+        else
+          symowner:=symtable;
+
+        if assigned(symowner) and (symowner.symtabletype in [objectsymtable,recordsymtable]) then
           begin
           begin
-            if genericdef.owner.symtabletype = objectsymtable then
-              found:=searchsym_in_class(tobjectdef(genericdef.owner.defowner),tobjectdef(genericdef.owner.defowner),ugenname,context.sym,context.symtable,[])
+            if symowner.symtabletype = objectsymtable then
+              found:=searchsym_in_class(tobjectdef(symowner.defowner),tobjectdef(symowner.defowner),ugenname,context.sym,context.symtable,[])
             else
             else
-              found:=searchsym_in_record(tabstractrecorddef(genericdef.owner.defowner),ugenname,context.sym,context.symtable);
+              found:=searchsym_in_record(tabstractrecorddef(symowner.defowner),ugenname,context.sym,context.symtable);
             if not found then
             if not found then
               found:=searchsym(ugenname,context.sym,context.symtable);
               found:=searchsym(ugenname,context.sym,context.symtable);
           end
           end
@@ -1350,7 +1356,7 @@ uses
         context : tspecializationcontext;
         context : tspecializationcontext;
         genericdef : tstoreddef;
         genericdef : tstoreddef;
       begin
       begin
-        genericdef:=tstoreddef(generate_specialization_phase1(context,tt,parsedtype,symname,parsedpos));
+        genericdef:=tstoreddef(generate_specialization_phase1(context,tt,parsedtype,symname,nil,parsedpos));
         if genericdef<>generrordef then
         if genericdef<>generrordef then
           genericdef:=tstoreddef(generate_specialization_phase2(context,genericdef,parse_class_parent,_prettyname));
           genericdef:=tstoreddef(generate_specialization_phase2(context,genericdef,parse_class_parent,_prettyname));
         tt:=genericdef;
         tt:=genericdef;
@@ -1790,8 +1796,7 @@ uses
                 if not searchsym_with_flags(sym.name,srsym,srsymtable,[ssf_no_addsymref]) then
                 if not searchsym_with_flags(sym.name,srsym,srsymtable,[ssf_no_addsymref]) then
                   srsym:=nil;
                   srsym:=nil;
               end
               end
-            else if (sym.typ=procsym) and
-                (tprocsym(sym).procdeflist.count>0) then
+            else if sym.typ=procsym then
               srsym:=sym
               srsym:=sym
             else
             else
               { dummy symbol is already not so dummy anymore }
               { dummy symbol is already not so dummy anymore }

+ 10 - 0
compiler/symtable.pas

@@ -3374,6 +3374,8 @@ implementation
                     exit;
                     exit;
                   end;
                   end;
               end;
               end;
+            if (tprocsym(sym).procdeflist.count=0) and (sp_generic_dummy in tprocsym(sym).symoptions) then
+              result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
           end
           end
         else
         else
           result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
           result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
@@ -4254,6 +4256,14 @@ implementation
                         result:=true;
                         result:=true;
                         exit;
                         exit;
                       end;
                       end;
+                    if (sp_generic_dummy in tprocsym(srsym).symoptions) and
+                        (tprocsym(srsym).procdeflist.count=0) and
+                        is_visible_for_object(srsym.owner,srsym.visibility,contextclassh) then
+                      begin
+                        srsymtable:=srsym.owner;
+                        result:=true;
+                        exit;
+                      end;
                   end;
                   end;
                 typesym,
                 typesym,
                 fieldvarsym,
                 fieldvarsym,

+ 3 - 1
compiler/x86/nx86inl.pas

@@ -1223,7 +1223,9 @@ implementation
              { only one memory operand is allowed }
              { only one memory operand is allowed }
              gotmem:=false;
              gotmem:=false;
              memop:=0;
              memop:=0;
-             for i:=1 to 3 do
+             { in case parameters come on the FPU stack, we have to pop them in reverse order as we
+               called secondpass }
+             for i:=3 downto 1 do
                begin
                begin
                  if not(paraarray[i].location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
                  if not(paraarray[i].location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
                    begin
                    begin

+ 2 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -208,6 +208,7 @@ const
   nClassTypesAreNotRelatedXY = 3142;
   nClassTypesAreNotRelatedXY = 3142;
   nDirectiveXNotAllowedHere = 3143;
   nDirectiveXNotAllowedHere = 3143;
   nAwaitWithoutPromise = 3144;
   nAwaitWithoutPromise = 3144;
+  nSymbolCannotExportedFromALibrary = 3145;
 
 
   // using same IDs as FPC
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -363,6 +364,7 @@ resourcestring
   sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
   sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
   sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
   sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
   sAwaitWithoutPromise = 'Await without promise';
   sAwaitWithoutPromise = 'Await without promise';
+  sSymbolCannotExportedFromALibrary = 'The symbol cannot be exported from a library';
 
 
 type
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
   { TResolveData - base class for data stored in TPasElement.CustomData }

+ 57 - 9
packages/fcl-passrc/src/pasresolver.pp

@@ -1612,6 +1612,7 @@ type
     procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual;
     procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual;
     procedure AddVariable(El: TPasVariable); virtual;
     procedure AddVariable(El: TPasVariable); virtual;
     procedure AddResourceString(El: TPasResString); virtual;
     procedure AddResourceString(El: TPasResString); virtual;
+    procedure AddExportSymbol(El: TPasExportSymbol); virtual;
     procedure AddEnumType(El: TPasEnumType); virtual;
     procedure AddEnumType(El: TPasEnumType); virtual;
     procedure AddEnumValue(El: TPasEnumValue); virtual;
     procedure AddEnumValue(El: TPasEnumValue); virtual;
     procedure AddProperty(El: TPasProperty); virtual;
     procedure AddProperty(El: TPasProperty); virtual;
@@ -9139,7 +9140,7 @@ end;
 
 
 procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
 procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
 
 
-  procedure CheckExpExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string);
+  procedure CheckConstExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string);
   var
   var
     Value: TResEvalValue;
     Value: TResEvalValue;
     ResolvedEl: TPasResolverResult;
     ResolvedEl: TPasResolverResult;
@@ -9157,9 +9158,40 @@ procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
     RaiseXExpectedButYFound(20210101194628,Expected,GetTypeDescription(ResolvedEl),Expr);
     RaiseXExpectedButYFound(20210101194628,Expected,GetTypeDescription(ResolvedEl),Expr);
   end;
   end;
 
 
+var
+  Expr: TPasExpr;
+  DeclEl: TPasElement;
+  FindData: TPRFindData;
+  Ref: TResolvedReference;
+  ResolvedEl: TPasResolverResult;
 begin
 begin
-  CheckExpExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
-  CheckExpExpr(El.ExportName,[revkString,revkUnicodeString],'string');
+  Expr:=El.NameExpr;
+  if Expr<>nil then
+    begin
+    ResolveExpr(Expr,rraRead);
+    //ResolveGlobalSymbol(Expr);
+    ComputeElement(Expr,ResolvedEl,[rcConstant]);
+    DeclEl:=ResolvedEl.IdentEl;
+    if DeclEl=nil then
+      RaiseMsg(20210103012907,nXExpectedButYFound,sXExpectedButYFound,['symbol',GetTypeDescription(ResolvedEl)],Expr);
+    if not (DeclEl.Parent is TPasSection) then
+      RaiseMsg(20210103012908,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetElementTypeName(DeclEl)],Expr);
+    end
+  else
+    begin
+    FindFirstEl(El.Name,FindData,El);
+    DeclEl:=FindData.Found;
+    if DeclEl=nil then
+      RaiseMsg(20210103002747,nIdentifierNotFound,sIdentifierNotFound,[El.Name],El);
+    if not (DeclEl.Parent is TPasSection) then
+      RaiseMsg(20210103003244,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetObjPath(DeclEl)],El);
+    Ref:=CreateReference(DeclEl,El,rraRead,@FindData);
+    CheckFoundElement(FindData,Ref);
+    end;
+
+  // check index and name
+  CheckConstExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
+  CheckConstExpr(El.ExportName,[revkString,revkUnicodeString],'string');
 end;
 end;
 
 
 procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
 procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
@@ -10276,7 +10308,7 @@ begin
       if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
       if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
         begin
         begin
         {$IFDEF VerbosePasResolver}
         {$IFDEF VerbosePasResolver}
-        writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
+        writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El));
         {$ENDIF}
         {$ENDIF}
         RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
         RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
           sWrongNumberOfParametersForCallTo,[Proc.Name],El);
           sWrongNumberOfParametersForCallTo,[Proc.Name],El);
@@ -12205,6 +12237,14 @@ begin
   AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
   AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 end;
 end;
 
 
+procedure TPasResolver.AddExportSymbol(El: TPasExportSymbol);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddExportSymbol ',GetObjName(El));
+  {$ENDIF}
+  // Note: export symbol is not added to scope
+end;
+
 procedure TPasResolver.AddEnumType(El: TPasEnumType);
 procedure TPasResolver.AddEnumType(El: TPasEnumType);
 var
 var
   CanonicalSet: TPasSetType;
   CanonicalSet: TPasSetType;
@@ -17452,6 +17492,8 @@ begin
     AddProcedureType(TPasProcedureType(SpecEl),nil);
     AddProcedureType(TPasProcedureType(SpecEl),nil);
     SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
     SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
     end
     end
+  else if C=TPasExportSymbol then
+    RaiseMsg(20210101234958,nSymbolCannotExportedFromALibrary,sSymbolCannotExportedFromALibrary,[],GenEl)
   else
   else
     RaiseNotYetImplemented(20190728151215,GenEl);
     RaiseNotYetImplemented(20190728151215,GenEl);
 end;
 end;
@@ -20866,6 +20908,7 @@ begin
       // resolved when finished
       // resolved when finished
     else if AClass=TPasAttributes then
     else if AClass=TPasAttributes then
     else if AClass=TPasExportSymbol then
     else if AClass=TPasExportSymbol then
+      AddExportSymbol(TPasExportSymbol(El))
     else if AClass=TPasUnresolvedUnitRef then
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
     else
@@ -28209,10 +28252,12 @@ function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
   e.g. '@p().o[].El' or '@El[]'
   e.g. '@p().o[].El' or '@El[]'
   b) mode delphi: the last element of a right side of an assignment
   b) mode delphi: the last element of a right side of an assignment
   c) an accessor function, e.g. property P read El;
   c) an accessor function, e.g. property P read El;
+  d) an export
 }
 }
 var
 var
   Parent: TPasElement;
   Parent: TPasElement;
   Prop: TPasProperty;
   Prop: TPasProperty;
+  C: TClass;
 begin
 begin
   Result:=false;
   Result:=false;
   if El=nil then exit;
   if El=nil then exit;
@@ -28221,31 +28266,34 @@ begin
   repeat
   repeat
     Parent:=El.Parent;
     Parent:=El.Parent;
     //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
     //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
-    if Parent.ClassType=TUnaryExpr then
+    C:=Parent.ClassType;
+    if C=TUnaryExpr then
       begin
       begin
       if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
       if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
       end
       end
-    else if Parent.ClassType=TBinaryExpr then
+    else if C=TBinaryExpr then
       begin
       begin
       if TBinaryExpr(Parent).right<>El then exit;
       if TBinaryExpr(Parent).right<>El then exit;
       if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
       if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
       end
       end
-    else if Parent.ClassType=TParamsExpr then
+    else if C=TParamsExpr then
       begin
       begin
       if TParamsExpr(Parent).Value<>El then exit;
       if TParamsExpr(Parent).Value<>El then exit;
       end
       end
-    else if Parent.ClassType=TPasProperty then
+    else if C=TPasProperty then
       begin
       begin
       Prop:=TPasProperty(Parent);
       Prop:=TPasProperty(Parent);
       Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
       Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
       exit;
       exit;
       end
       end
-    else if Parent.ClassType=TPasImplAssign then
+    else if C=TPasImplAssign then
       begin
       begin
       if TPasImplAssign(Parent).right<>El then exit;
       if TPasImplAssign(Parent).right<>El then exit;
       if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
       if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
       exit;
       exit;
       end
       end
+    else if C=TPasExportSymbol then
+      exit(true)
     else
     else
       exit;
       exit;
     El:=TPasExpr(Parent);
     El:=TPasExpr(Parent);

+ 3 - 0
packages/fcl-passrc/src/pastree.pp

@@ -975,6 +975,7 @@ type
 
 
   TPasExportSymbol = class(TPasElement)
   TPasExportSymbol = class(TPasElement)
   public
   public
+    NameExpr: TPasExpr; // only if name is not a simple identifier
     ExportName : TPasExpr;
     ExportName : TPasExpr;
     ExportIndex : TPasExpr;
     ExportIndex : TPasExpr;
     Destructor Destroy; override;
     Destructor Destroy; override;
@@ -2601,6 +2602,7 @@ end;
 
 
 destructor TPasExportSymbol.Destroy;
 destructor TPasExportSymbol.Destroy;
 begin
 begin
+  ReleaseAndNil(TPasElement(NameExpr){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.NameExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(ExportName){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportName'{$ENDIF});
   ReleaseAndNil(TPasElement(ExportName){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportName'{$ENDIF});
   ReleaseAndNil(TPasElement(ExportIndex){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportIndex'{$ENDIF});
   ReleaseAndNil(TPasElement(ExportIndex){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportIndex'{$ENDIF});
   inherited Destroy;
   inherited Destroy;
@@ -2624,6 +2626,7 @@ procedure TPasExportSymbol.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
   const Arg: Pointer);
 begin
 begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
   ForEachChildCall(aMethodCall,Arg,ExportName,false);
   ForEachChildCall(aMethodCall,Arg,ExportName,false);
   ForEachChildCall(aMethodCall,Arg,ExportIndex,false);
   ForEachChildCall(aMethodCall,Arg,ExportIndex,false);
 end;
 end;

+ 36 - 20
packages/fcl-passrc/src/pparser.pp

@@ -4341,27 +4341,43 @@ end;
 procedure TPasParser.ParseExportDecl(Parent: TPasElement; List: TFPList);
 procedure TPasParser.ParseExportDecl(Parent: TPasElement; List: TFPList);
 Var
 Var
   E : TPasExportSymbol;
   E : TPasExportSymbol;
+  aName: String;
+  NameExpr: TPasExpr;
 begin
 begin
-  Repeat
-    if List.Count<>0 then
-      ExpectIdentifier;
-    E:=TPasExportSymbol(CreateElement(TPasExportSymbol,CurtokenString,Parent));
-    List.Add(E);
-    NextToken;
-    if CurTokenIsIdentifier('INDEX') then
-      begin
-      NextToken;
-      E.Exportindex:=DoParseExpression(E,Nil)
-      end
-    else if CurTokenIsIdentifier('NAME') then
-      begin
-      NextToken;
-      E.ExportName:=DoParseExpression(E,Nil)
-      end;
-    if not (CurToken in [tkComma,tkSemicolon]) then
-      ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
-    Engine.FinishScope(stDeclaration,E);
-  until (CurToken=tkSemicolon);
+  try
+    Repeat
+      if List.Count>0 then
+        ExpectIdentifier;
+      aName:=ReadDottedIdentifier(Parent,NameExpr,true);
+      E:=TPasExportSymbol(CreateElement(TPasExportSymbol,aName,Parent));
+      if NameExpr.Kind=pekIdent then
+        // simple identifier -> no need to store NameExpr
+        NameExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}
+      else
+        begin
+        E.NameExpr:=NameExpr;
+        NameExpr.Parent:=E;
+        end;
+      NameExpr:=nil;
+      List.Add(E);
+      if CurTokenIsIdentifier('INDEX') then
+        begin
+        NextToken;
+        E.Exportindex:=DoParseExpression(E,Nil)
+        end
+      else if CurTokenIsIdentifier('NAME') then
+        begin
+        NextToken;
+        E.ExportName:=DoParseExpression(E,Nil)
+        end;
+      if not (CurToken in [tkComma,tkSemicolon]) then
+        ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
+      Engine.FinishScope(stDeclaration,E);
+    until (CurToken=tkSemicolon);
+  finally
+    if NameExpr<>nil then
+      NameExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}
+  end;
 end;
 end;
 
 
 function TPasParser.ParseProcedureType(Parent: TPasElement;
 function TPasParser.ParseProcedureType(Parent: TPasElement;

+ 20 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -986,6 +986,7 @@ type
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_Initialization_Finalization;
     Procedure TestLibrary_Initialization_Finalization;
+    Procedure TestLibrary_ExportFuncOverloadFail; // ToDo
     // ToDo Procedure TestLibrary_UnitExports;
     // ToDo Procedure TestLibrary_UnitExports;
   end;
   end;
 
 
@@ -18833,6 +18834,25 @@ begin
   ParseLibrary;
   ParseLibrary;
 end;
 end;
 
 
+procedure TTestResolver.TestLibrary_ExportFuncOverloadFail;
+begin
+  exit;
+
+  StartLibrary(false);
+  Add([
+  'procedure Run(w: word); overload;',
+  'begin',
+  'end;',
+  'procedure Run(d: double); overload;',
+  'begin',
+  'end;',
+  'exports',
+  '  Run,',
+  '  afile.run;',
+  'begin']);
+  CheckResolverException('The symbol cannot be exported from a library',123);
+end;
+
 initialization
 initialization
   RegisterTests([TTestResolver]);
   RegisterTests([TTestResolver]);
 
 

+ 2 - 0
packages/pastojs/src/pas2jsfiler.pp

@@ -4430,6 +4430,7 @@ procedure TPCUWriter.WriteExportSymbol(Obj: TJSONObject; El: TPasExportSymbol;
   aContext: TPCUWriterContext);
   aContext: TPCUWriterContext);
 begin
 begin
   WritePasElement(Obj,El,aContext);
   WritePasElement(Obj,El,aContext);
+  WriteExpr(Obj,El,'NameExpr',El.NameExpr,aContext);
   WriteExpr(Obj,El,'ExportName',El.ExportName,aContext);
   WriteExpr(Obj,El,'ExportName',El.ExportName,aContext);
   WriteExpr(Obj,El,'ExportIndex',El.ExportIndex,aContext);
   WriteExpr(Obj,El,'ExportIndex',El.ExportIndex,aContext);
 end;
 end;
@@ -9256,6 +9257,7 @@ procedure TPCUReader.ReadExportSymbol(Obj: TJSONObject; El: TPasExportSymbol;
   aContext: TPCUReaderContext);
   aContext: TPCUReaderContext);
 begin
 begin
   ReadPasElement(Obj,El,aContext);
   ReadPasElement(Obj,El,aContext);
+  El.NameExpr:=ReadExpr(Obj,El,'NameExpr',aContext);
   El.ExportName:=ReadExpr(Obj,El,'ExportName',aContext);
   El.ExportName:=ReadExpr(Obj,El,'ExportName',aContext);
   El.ExportIndex:=ReadExpr(Obj,El,'ExportIndex',aContext);
   El.ExportIndex:=ReadExpr(Obj,El,'ExportIndex',aContext);
 end;
 end;

+ 1 - 0
packages/pastojs/tests/tcfiler.pas

@@ -1935,6 +1935,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredExportSymbol(const Path: string;
 procedure TCustomTestPrecompile.CheckRestoredExportSymbol(const Path: string;
   Orig, Rest: TPasExportSymbol; Flags: TPCCheckFlags);
   Orig, Rest: TPasExportSymbol; Flags: TPCCheckFlags);
 begin
 begin
+  CheckRestoredElement(Path+'.NameExpr',Orig.NameExpr,Rest.NameExpr,Flags);
   CheckRestoredElement(Path+'.ExportName',Orig.ExportName,Rest.ExportName,Flags);
   CheckRestoredElement(Path+'.ExportName',Orig.ExportName,Rest.ExportName,Flags);
   CheckRestoredElement(Path+'.ExportIndex',Orig.ExportIndex,Rest.ExportIndex,Flags);
   CheckRestoredElement(Path+'.ExportIndex',Orig.ExportIndex,Rest.ExportIndex,Flags);
 end;
 end;

+ 14 - 0
packages/rtl-objpas/src/inc/nullable.pp

@@ -1,3 +1,17 @@
+{
+  This file is part of the Free Pascal run time library.
+  Copyright (C) 2020 Michael Van Canneyt
+  member of the Free Pascal development team.
+
+  Nullable generic type.
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
 unit nullable;
 unit nullable;
 
 
 {$mode objfpc}
 {$mode objfpc}

+ 1 - 1
rtl/aarch64/mathu.inc

@@ -51,7 +51,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
     rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
   begin
   begin
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
-    SetRoundMode:=RoundMode;
+    SetRoundMode:=GetRoundMode;
     setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
     setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
   end;
   end;
 
 

+ 2 - 1
rtl/arm/mathu.inc

@@ -62,9 +62,10 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   c: dword;
   c: dword;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
+  Reslut:=GetRoundMode;
   c:=Ord(RoundMode) shl 16;
   c:=Ord(RoundMode) shl 16;
   c:=_controlfp(c, _MCW_RC);
   c:=_controlfp(c, _MCW_RC);
-  Result:=TFPURoundingMode((c shr 16) and 3);
 end;
 end;
 
 
 function GetPrecisionMode: TFPUPrecisionMode;
 function GetPrecisionMode: TFPUPrecisionMode;

+ 1 - 0
rtl/i386/mathu.inc

@@ -147,6 +147,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   CtlWord: Word;
   CtlWord: Word;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
   CtlWord := Get8087CW;
   CtlWord := Get8087CW;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   if has_sse_support then
   if has_sse_support then

+ 1 - 0
rtl/i8086/mathu.inc

@@ -155,6 +155,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 var
 var
   CtlWord: Word;
   CtlWord: Word;
 begin
 begin
+  softfloat_rounding_mode:=RoundMode;
   CtlWord := Get8087CW;
   CtlWord := Get8087CW;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
 {  if has_sse_support then
 {  if has_sse_support then

+ 1 - 1
rtl/m68k/mathu.inc

@@ -137,10 +137,10 @@ const
 var
 var
   FPCR: DWord;
   FPCR: DWord;
 begin
 begin
+  Result:=GetRoundMode;
   FPCR:=GetFPCR and not FPU68K_ROUND_MASK;
   FPCR:=GetFPCR and not FPU68K_ROUND_MASK;
   SetFPCR(FPCR or FPCToFPURoundingMode[RoundMode]);
   SetFPCR(FPCR or FPCToFPURoundingMode[RoundMode]);
   softfloat_rounding_mode:=RoundMode;
   softfloat_rounding_mode:=RoundMode;
-  Result:=RoundMode;
 end;
 end;
 
 
 function GetPrecisionMode: TFPUPrecisionMode;
 function GetPrecisionMode: TFPUPrecisionMode;

+ 1 - 0
rtl/mips/mathu.inc

@@ -62,6 +62,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
   begin
     fsr:=get_fsr;
     fsr:=get_fsr;
     result:=fsr2roundmode[fsr and fpu_rounding_mask];
     result:=fsr2roundmode[fsr and fpu_rounding_mask];
+    softfloat_rounding_mode:=RoundMode;
     set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
     set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
   end;
   end;
 
 

+ 1 - 1
rtl/powerpc/mathu.inc

@@ -101,12 +101,12 @@ begin
         mode := FP_RND_RM;
         mode := FP_RND_RM;
       end;
       end;
   end;
   end;
+  result := GetRoundMode;
 {$ifndef aix}
 {$ifndef aix}
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
 {$else not aix}
 {$else not aix}
   fp_swap_rnd(mode);
   fp_swap_rnd(mode);
 {$endif not aix}
 {$endif not aix}
-  result := RoundMode;
 end;
 end;
 
 
 
 

+ 1 - 1
rtl/powerpc64/mathu.inc

@@ -109,12 +109,12 @@ begin
         mode := FP_RND_RM;
         mode := FP_RND_RM;
       end;
       end;
   end;
   end;
+  result := GetRoundMode;
 {$ifndef aix}
 {$ifndef aix}
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
   setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
 {$else not aix}
 {$else not aix}
   fp_swap_rnd(mode);
   fp_swap_rnd(mode);
 {$endif not aix}
 {$endif not aix}
-  result := RoundMode;
 end;
 end;
 
 
 
 

+ 1 - 1
rtl/riscv64/mathu.inc

@@ -50,7 +50,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
     rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
   begin
   begin
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
-    SetRoundMode:=RoundMode;
+    SetRoundMode:=GetRoundMode;
     setrm(rm2bits[RoundMode]);
     setrm(rm2bits[RoundMode]);
   end;
   end;
 
 

+ 1 - 0
rtl/sparc/mathu.inc

@@ -32,6 +32,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     cw: dword;
     cw: dword;
   begin
   begin
     cw:=get_fsr;
     cw:=get_fsr;
+    softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
     result:=TFPURoundingMode(cw shr 30);
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
   end;

+ 1 - 0
rtl/sparc64/mathu.inc

@@ -31,6 +31,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
     cw: dword;
     cw: dword;
   begin
   begin
     cw:=get_fsr;
     cw:=get_fsr;
+    softfloat_rounding_mode:=RoundMode;
     result:=TFPURoundingMode(cw shr 30);
     result:=TFPURoundingMode(cw shr 30);
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
     set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
   end;
   end;

+ 8 - 0
rtl/win/syswin.inc

@@ -609,6 +609,14 @@ procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:Unico
         dwFlags:=MB_PRECOMPOSED;
         dwFlags:=MB_PRECOMPOSED;
       end;
       end;
     destlen:=MultiByteToWideChar(cp, dwFlags, source, len, nil, 0);
     destlen:=MultiByteToWideChar(cp, dwFlags, source, len, nil, 0);
+    { destlen=0 means that Windows cannot convert, so call the default
+      handler. This is similiar to what unix does and is a good fallback
+      if rawbyte strings are passed }
+    if destlen=0 then
+      begin
+        DefaultAnsi2UnicodeMove(source,DefaultSystemCodePage,dest,len);
+        exit;
+      end;
     // this will null-terminate
     // this will null-terminate
     setlength(dest, destlen);
     setlength(dest, destlen);
     if destlen>0 then
     if destlen>0 then

+ 1 - 0
rtl/x86_64/mathu.inc

@@ -201,6 +201,7 @@ var
 begin
 begin
   CtlWord:=Get8087CW;
   CtlWord:=Get8087CW;
   SSECSR:=GetMXCSR;
   SSECSR:=GetMXCSR;
+  softfloat_rounding_mode:=RoundMode;
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
   SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
   SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 {$ifdef FPC_HAS_TYPE_EXTENDED}

+ 1 - 0
rtl/xtensa/mathu.inc

@@ -20,6 +20,7 @@ function GetRoundMode: TFPURoundingMode;
 
 
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
 function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
   begin
   begin
+    SetRoundMode:=softfloat_rounding_mode;
     softfloat_rounding_mode:=RoundMode;
     softfloat_rounding_mode:=RoundMode;
   end;
   end;
 
 

+ 25 - 0
tests/test/tgenfunc24.pp

@@ -0,0 +1,25 @@
+{ %FAIL }
+
+program tgenfunc24;
+
+{$mode delphi}
+
+type
+  TTest = class
+  public type
+    Test = class
+    end;
+
+  public
+    procedure Test<T>;
+  end;
+
+procedure TTest.Test<T>;
+begin
+
+end;
+
+begin
+
+end.
+

+ 24 - 0
tests/test/tgenfunc25.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tgenfunc25;
+
+{$mode delphi}
+
+type
+  TTest = class
+  public
+    procedure Test<T>;
+  public type
+    Test = class
+    end;
+  end;
+
+procedure TTest.Test<T>;
+begin
+
+end;
+
+begin
+
+end.
+

+ 24 - 0
tests/test/tgenfunc26.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+unit tgenfunc26;
+
+{$mode objfpc}{$H+}
+
+interface
+
+generic procedure Test<T>;
+
+type
+  Test = record
+
+  end;
+
+implementation
+
+generic procedure Test<T>;
+begin
+
+end;
+
+end.
+

+ 24 - 0
tests/test/tgenfunc27.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+unit tgenfunc27;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  Test = record
+
+  end;
+
+generic procedure Test<T>;
+
+implementation
+
+generic procedure Test<T>;
+begin
+
+end;
+
+end.
+

+ 152 - 4
tests/test/units/math/trndcurr.pp

@@ -1,13 +1,34 @@
 uses
 uses
   Math;
   Math;
 
 
+
+const
+  failure_count : longint = 0;
+  first_error : longint = 0;
+
 {$ifndef SKIP_CURRENCY_TEST}
 {$ifndef SKIP_CURRENCY_TEST}
 procedure testround(const c, expected: currency; error: longint);
 procedure testround(const c, expected: currency; error: longint);
 begin
 begin
   if round(c)<>expected then
   if round(c)<>expected then
     begin
     begin
       writeln('round(',c,') = ',round(c),' instead of ', expected);
       writeln('round(',c,') = ',round(c),' instead of ', expected);
-      halt(error);
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=error;
+    end;
+end;
+{$endif}
+
+
+{$ifndef SKIP_SINGLE_TEST}
+procedure testroundsingle(const c, expected: single; error: longint);
+begin
+  if round(c)<>expected then
+    begin
+      writeln('round(',c,') = ',round(c),' instead of ', expected);
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=error;
     end;
     end;
 end;
 end;
 
 
@@ -16,6 +37,13 @@ end;
 
 
 begin
 begin
 {$ifndef SKIP_CURRENCY_TEST}
 {$ifndef SKIP_CURRENCY_TEST}
+  if GetRoundMode <> rmNearest then
+    begin
+      writeln('Starting rounding mode is not rmNearest');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=200;
+    end;
   writeln('Rounding mode: rmNearest (even)');
   writeln('Rounding mode: rmNearest (even)');
   testround(0.5,0.0,1);
   testround(0.5,0.0,1);
   testround(1.5,2.0,2);
   testround(1.5,2.0,2);
@@ -31,7 +59,15 @@ begin
   testround(-1.4,-1.0,154);
   testround(-1.4,-1.0,154);
 
 
   writeln('Rounding mode: rmUp');
   writeln('Rounding mode: rmUp');
-  SetRoundMode(rmUp);
+  if SetRoundMode(rmUp)<>rmNearest then
+    writeln('Warning: previous mode was not rmNearest');
+  if GetRoundMode <> rmUp then
+    begin
+      writeln('Failed to set rounding mode to rmUp');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=201;
+    end;
   testround(0.5,1.0,5);
   testround(0.5,1.0,5);
   testround(1.5,2.0,6);
   testround(1.5,2.0,6);
   testround(-0.5,0.0,7);
   testround(-0.5,0.0,7);
@@ -46,7 +82,15 @@ begin
   testround(-1.4,-1.0,158);
   testround(-1.4,-1.0,158);
 
 
   writeln('Rounding mode: rmDown');
   writeln('Rounding mode: rmDown');
-  SetRoundMode(rmDown);
+  if SetRoundMode(rmDown)<>rmUp then
+    writeln('Warning: previous mode was not rmUp');
+  if GetRoundMode <> rmDown then
+    begin
+      writeln('Failed to set rounding mode to rmDown');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=202;
+    end;
   testround(0.5,0.0,9);
   testround(0.5,0.0,9);
   testround(1.5,1.0,10);
   testround(1.5,1.0,10);
   testround(-0.5,-1.0,11);
   testround(-0.5,-1.0,11);
@@ -61,7 +105,15 @@ begin
   testround(-1.4,-2.0,162);
   testround(-1.4,-2.0,162);
 
 
   writeln('Rounding mode: rmTruncate');
   writeln('Rounding mode: rmTruncate');
-  SetRoundMode(rmTruncate);
+  if SetRoundMode(rmTruncate)<>rmDown then
+    writeln('Warning: previous mode was not rmDown');
+  if GetRoundMode <> rmTruncate then
+    begin
+      writeln('Failed to set rounding mode to rmTruncate');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=203;
+    end;
   testround(0.5,0.0,13);
   testround(0.5,0.0,13);
   testround(1.5,1.0,14);
   testround(1.5,1.0,14);
   testround(-0.5,0.0,15);
   testround(-0.5,0.0,15);
@@ -75,4 +127,100 @@ begin
   testround(-0.4,0.0,165);
   testround(-0.4,0.0,165);
   testround(-1.4,-1.0,166);
   testround(-1.4,-1.0,166);
 {$endif}
 {$endif}
+{$ifndef SKIP_SINGLE_TEST}
+  SetRoundMode(rmNearest);
+  if GetRoundMode <> rmNearest then
+    begin
+      writeln('Starting rounding mode is not rmNearest');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=200;
+    end;
+  writeln('Rounding mode: rmNearest (even)');
+  testroundsingle(0.5,0.0,1);
+  testroundsingle(1.5,2.0,2);
+  testroundsingle(-0.5,0.0,3);
+  testroundsingle(-1.5,-2.0,4);
+  testroundsingle(0.6,1.0,101);
+  testroundsingle(1.6,2.0,102);
+  testroundsingle(-0.6,-1.0,103);
+  testroundsingle(-1.6,-2.0,104);
+  testroundsingle(0.4,0.0,151);
+  testroundsingle(1.4,1.0,152);
+  testroundsingle(-0.4,-0.0,153);
+  testroundsingle(-1.4,-1.0,154);
+
+  writeln('Rounding mode: rmUp');
+  if SetRoundMode(rmUp)<>rmNearest then
+    writeln('Warning: previous mode was not rmNearest');
+  if GetRoundMode <> rmUp then
+    begin
+      writeln('Failed to set rounding mode to rmUp');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=201;
+    end;
+  testroundsingle(0.5,1.0,5);
+  testroundsingle(1.5,2.0,6);
+  testroundsingle(-0.5,0.0,7);
+  testroundsingle(-1.5,-1.0,8);
+  testroundsingle(0.6,1.0,105);
+  testroundsingle(1.6,2.0,106);
+  testroundsingle(-0.6,0.0,107);
+  testroundsingle(-1.6,-1.0,108);
+  testroundsingle(0.4,1.0,155);
+  testroundsingle(1.4,2.0,156);
+  testroundsingle(-0.4,0.0,157);
+  testroundsingle(-1.4,-1.0,158);
+
+  writeln('Rounding mode: rmDown');
+  if SetRoundMode(rmDown)<>rmUp then
+    writeln('Warning: previous mode was not rmUp');
+  if GetRoundMode <> rmDown then
+    begin
+      writeln('Failed to set rounding mode to rmDown');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=202;
+    end;
+  testroundsingle(0.5,0.0,9);
+  testroundsingle(1.5,1.0,10);
+  testroundsingle(-0.5,-1.0,11);
+  testroundsingle(-1.5,-2.0,12);
+  testroundsingle(0.6,0.0,109);
+  testroundsingle(1.6,1.0,110);
+  testroundsingle(-0.6,-1.0,111);
+  testroundsingle(-1.6,-2.0,112);
+  testroundsingle(0.4,0.0,159);
+  testroundsingle(1.4,1.0,160);
+  testroundsingle(-0.4,-1.0,161);
+  testroundsingle(-1.4,-2.0,162);
+
+  writeln('Rounding mode: rmTruncate');
+  if SetRoundMode(rmTruncate)<>rmDown then
+    writeln('Warning: previous mode was not rmDown');
+  if GetRoundMode <> rmTruncate then
+    begin
+      writeln('Failed to set rounding mode to rmTruncate');
+      inc(failure_count);
+      if first_error=0 then
+        first_error:=203;
+    end;
+  testroundsingle(0.5,0.0,13);
+  testroundsingle(1.5,1.0,14);
+  testroundsingle(-0.5,0.0,15);
+  testroundsingle(-1.5,-1.0,16);
+  testroundsingle(0.6,0.0,113);
+  testroundsingle(1.6,1.0,114);
+  testroundsingle(-0.6,0.0,115);
+  testroundsingle(-1.6,-1.0,116);
+  testroundsingle(0.4,0.0,163);
+  testroundsingle(1.4,1.0,164);
+  testroundsingle(-0.4,0.0,165);
+  testroundsingle(-1.4,-1.0,166);
+{$endif}
+  if failure_count=0 then
+    writeln('SetRoundMode test finished OK')
+  else
+    halt(first_error);
 end.
 end.

+ 8 - 0
tests/webtbf/tw38289a.pp

@@ -0,0 +1,8 @@
+{ %FAIL }
+
+library tw38289a;
+procedure Test; begin end;
+exports
+  Test index 3 'abc';
+  //------------^^^
+end.

+ 8 - 0
tests/webtbf/tw38289b.pp

@@ -0,0 +1,8 @@
+{ %FAIL }
+
+library tw38289b;
+procedure Test; begin end;
+exports
+  Test index 'abc' 3;
+  //------------^^^
+end.

+ 30 - 1
tests/webtbs/tw38267b.pp

@@ -1,6 +1,6 @@
 { %opt=-O3 -Sg }
 { %opt=-O3 -Sg }
 {$mode objfpc} {$longstrings+}
 {$mode objfpc} {$longstrings+}
-label start1, end1, start2, end2, start3, end3;
+label start1, end1, start2, end2, start3, end3, start4, end4;
 
 
 var
 var
 	s: string;
 	s: string;
@@ -88,5 +88,34 @@ end3:
     if PtrUint(CodePointer(@end3) - CodePointer(@start3))>300 then
     if PtrUint(CodePointer(@end3) - CodePointer(@start3))>300 then
       halt(3);
       halt(3);
     writeln;
     writeln;
+
+	writeln('31 literals concatenated with 1 dynamic string, they could fold but didn''t at all:');
+start4:
+	s := 'Once like a Great House' + (LineEnding +
+		('founded on sand,' + (LineEnding +
+		('Stood our Temple' + (LineEnding +
+		('whose pillars on troubles were based.' + (LineEnding +
+		('Now mischievous spirits, bound,' + (LineEnding +
+		('in dim corners stand,' + (LineEnding +
+		('Rotted columns, but' + (LineEnding +
+		('with iron-bound bands embraced' + (LineEnding +
+		('Cracked, crumbling marble,' + (LineEnding +
+		('tempered on every hand,' + (LineEnding +
+		('By strong steel' + (LineEnding +
+		('forged in fire and faith.' + (LineEnding +
+		('Shackled, these wayward servants' + (LineEnding +
+		('serve the land,' + (LineEnding +
+		('The Temple secured' + (LineEnding +
+		('by the Builder’s grace.' +
+		Copy('', 1, 0)))))))))))))))))))))))))))))));
+end4:
+    writeln(Copy(s, 1, 0), PtrUint(CodePointer(@end4) - CodePointer(@start4)), ' b of code');
+    { more than 100 bytes of code might point out that the constants are not folded,
+      example x86_64-linux: not folded: 1384 bytes; folded: 108 bytes
+    }
+    if PtrUint(CodePointer(@end4) - CodePointer(@start4))>300 then
+      halt(4);
+
+
     writeln('ok');
     writeln('ok');
 end.
 end.

+ 19 - 0
tests/webtbs/tw38295.pp

@@ -0,0 +1,19 @@
+{ %cpu=i386 }
+{ %opt=-CfAVX -CpCOREAVX2 -OoFASTMATH }
+uses
+  cpu;
+var
+    a, b: uint32; // or (u)int64; int32 works
+    r: single; // or double, or even extended
+begin
+  if FMASupport then
+    begin
+      a := 1;
+      b := 3;
+      r := a + b / 10;
+      writeln(r:0:3);
+      if r>2.0 then
+         halt(1);
+      writeln('ok');
+    end;
+end.

+ 15 - 0
tests/webtbs/tw38299.pp

@@ -0,0 +1,15 @@
+{ %opt=-O2 -Fcutf8 }
+program bug;
+const
+  cAnsiLineFeed = AnsiChar(#10);
+  cAnsiCarriageReturn = AnsiChar(#13);
+var
+  test: RawByteString;
+begin
+  test := '123';
+  test := test + UTF8Encode('456') + '789' + cAnsiCarriageReturn + cAnsiLineFeed;
+  writeln(test);
+  if test<>'123456789'#13#10 then
+    halt(1);
+  writeln('ok');
+end.

+ 13 - 1
utils/fpdoc/dglobals.pp

@@ -139,7 +139,7 @@ resourcestring
   SHTMLIndexColcount = 'Use N columns in the identifier index pages';
   SHTMLIndexColcount = 'Use N columns in the identifier index pages';
   SHTMLImageUrl = 'Prefix image URLs with url';
   SHTMLImageUrl = 'Prefix image URLs with url';
   SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
   SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
-    
+
   // CHM usage
   // CHM usage
   SCHMUsageTOC     = 'Use [File] as the table of contents. Usually a .hhc file.';
   SCHMUsageTOC     = 'Use [File] as the table of contents. Usually a .hhc file.';
   SCHMUsageIndex   = 'Use [File] as the index. Usually a .hhk file.';
   SCHMUsageIndex   = 'Use [File] as the index. Usually a .hhk file.';
@@ -151,6 +151,18 @@ resourcestring
   SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
   SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
   SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
   SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
 
 
+  // MarkDown usage
+  SMDUsageFooter = 'Append markdown (@filename reads from file) as footer to every markdown page';
+  SMDUsageHeader = 'Prepend markdown (@filename reads from file) as header to every markdown page';
+  SMDIndexColcount = 'Use N columns in the identifier index pages';
+  SMDImageUrl = 'Prefix image URLs with url';
+  SMDTheme = 'Use name as theme name';
+  SMDNavigation = 'Use scheme for navigation tree, here scheme is one of:';
+  SMDNavSubtree = '    UnitSubTree : put all units in a sub tree of a Units node';
+  SMDNavTree =    '    UnitTree : put every units as a node on the same level as packages node';
+
+
+
   SXMLUsageSource  = 'Include source file and line info in generated XML';
   SXMLUsageSource  = 'Include source file and line info in generated XML';
 
 
   // Linear usage
   // Linear usage

+ 1060 - 0
utils/fpdoc/dw_basehtml.pp

@@ -0,0 +1,1060 @@
+{
+    FPDoc  -  Free Pascal Documentation Tool
+    Copyright (C) 2021 by Michael Van Canneyt
+
+    * Basic HTML output generator. No assumptions about document/documentation structure
+
+    See the file COPYING, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+unit dw_basehtml;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses Classes, DOM, DOM_HTML, dGlobals, PasTree, dWriter;
+
+
+type
+
+  { THTMLWriter }
+
+  { TBaseHTMLWriter }
+
+  TBaseHTMLWriter = class(TMultiFileDocWriter)
+  Private
+    FImageFileList: TStrings;
+    FContentElement : THTMLELement;
+    FInsideHeadRow: Boolean;
+    FOutputNodeStack: TFPList;
+    FBaseImageURL : String;
+    FDoc: THTMLDocument;
+    FCurOutputNode: TDOMNode;
+    FDoPasHighlighting : Boolean;
+    FHighlighterFlags: Byte;
+  Protected
+
+    Procedure SetContentElement(aElement : THTMLELement); virtual;
+    // Description node conversion
+    Procedure DescrEmitNotesHeader(AContext : TPasElement); override;
+    Procedure DescrEmitNotesFooter(AContext : TPasElement); override;
+    procedure DescrWriteText(const AText: DOMString); override;
+    procedure DescrBeginBold; override;
+    procedure DescrEndBold; override;
+    procedure DescrBeginItalic; override;
+    procedure DescrEndItalic; override;
+    procedure DescrBeginEmph; override;
+    procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
+    procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
+    procedure DescrWriteFileEl(const AText: DOMString); override;
+    procedure DescrWriteKeywordEl(const AText: DOMString); override;
+    procedure DescrWriteVarEl(const AText: DOMString); override;
+    procedure DescrBeginLink(const AId: DOMString); override;
+    procedure DescrEndLink; override;
+    procedure DescrBeginURL(const AURL: DOMString); override;
+    procedure DescrEndURL; override;
+    procedure DescrWriteLinebreak; override;
+    procedure DescrBeginParagraph; override;
+    procedure DescrEndParagraph; override;
+    procedure DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String); override;
+    procedure DescrWriteCodeLine(const ALine: String); override;
+    procedure DescrEndCode; override;
+    procedure DescrBeginOrderedList; override;
+    procedure DescrEndOrderedList; override;
+    procedure DescrBeginUnorderedList; override;
+    procedure DescrEndUnorderedList; override;
+    procedure DescrBeginDefinitionList; override;
+    procedure DescrEndDefinitionList; override;
+    procedure DescrBeginListItem; override;
+    procedure DescrEndListItem; override;
+    procedure DescrBeginDefinitionTerm; override;
+    procedure DescrEndDefinitionTerm; override;
+    procedure DescrBeginDefinitionEntry; override;
+    procedure DescrEndDefinitionEntry; override;
+    procedure DescrBeginSectionTitle; override;
+    procedure DescrBeginSectionBody; override;
+    procedure DescrEndSection; override;
+    procedure DescrBeginRemark; override;
+    procedure DescrEndRemark; override;
+    procedure DescrBeginTable(ColCount: Integer; HasBorder: Boolean); override;
+    procedure DescrEndTable; override;
+    procedure DescrBeginTableCaption; override;
+    procedure DescrEndTableCaption; override;
+    procedure DescrBeginTableHeadRow; override;
+    procedure DescrEndTableHeadRow; override;
+    procedure DescrBeginTableRow; override;
+    procedure DescrEndTableRow; override;
+    procedure DescrBeginTableCell; override;
+    procedure DescrEndTableCell; override;
+
+    // Basic HTML handling
+    Procedure SetHTMLDocument(aDoc : THTMLDocument);
+    procedure PushOutputNode(ANode: TDOMNode);
+    procedure PopOutputNode;
+    procedure AppendText(Parent: TDOMNode; const AText: String);
+    procedure AppendText(Parent: TDOMNode; const AText: DOMString);
+    procedure AppendNbSp(Parent: TDOMNode; ACount: Integer);
+    procedure AppendSym(Parent: TDOMNode; const AText: DOMString);
+    procedure AppendKw(Parent: TDOMNode; const AText: String);
+    procedure AppendKw(Parent: TDOMNode; const AText: DOMString);
+    function  AppendPasSHFragment(Parent: TDOMNode; const AText: String; AShFlags: Byte): Byte;
+    procedure AppendFragment(aParentNode: TDOMElement; aStream: TStream);
+    // FPDoc specifics
+    procedure AppendSourceRef(aParent: TDOMElement; AElement: TPasElement);
+    Procedure AppendSeeAlsoSection(AElement: TPasElement; DocNode: TDocNode); virtual;
+    Procedure AppendExampleSection(AElement : TPasElement;DocNode : TDocNode); virtual;
+    Procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
+    procedure AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode: TDocNode);
+    procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
+    procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; AutoInsertBlock: Boolean);
+    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString);
+    procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: String);
+    function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
+
+    // Helper functions for creating DOM elements
+
+    function CreateEl(Parent: TDOMNode; const AName: DOMString): THTMLElement;
+    function CreatePara(Parent: TDOMNode): THTMLElement;
+    function CreateH1(Parent: TDOMNode): THTMLElement;
+    function CreateH2(Parent: TDOMNode): THTMLElement;
+    function CreateH3(Parent: TDOMNode): THTMLElement;
+    function CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
+    function CreateContentTable(Parent: TDOMNode): THTMLElement;
+    function CreateTR(Parent: TDOMNode): THTMLElement;
+    function CreateTD(Parent: TDOMNode): THTMLElement;
+    function CreateTD_vtop(Parent: TDOMNode): THTMLElement;
+    function CreateLink(Parent: TDOMNode; const AHRef: String): THTMLElement;
+    function CreateLink(Parent: TDOMNode; const AHRef: DOMString): THTMLElement;
+    function CreateAnchor(Parent: TDOMNode; const AName: DOMString): THTMLElement;
+    function CreateCode(Parent: TDOMNode): THTMLElement;
+    function CreateWarning(Parent: TDOMNode): THTMLElement;
+
+
+    // Some info
+    Property ContentElement : THTMLELement Read FContentElement Write SetContentElement;
+    Property OutputNodeStack: TFPList Read FOutputNodeStack;
+    Property CurOutputNode : TDomNode Read FCurOutputNode;
+    Property ImageFileList : TStrings Read FImageFileList;
+    Property Doc: THTMLDocument Read FDoc;
+    Property InsideHeadRow: Boolean Read FInsideHeadRow;
+    Property DoPasHighlighting : Boolean Read FDoPasHighlighting;
+    Property HighlighterFlags : Byte read FHighlighterFlags;
+
+  Public
+    constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
+    Destructor Destroy; override;
+    Property BaseImageURL : String Read FBaseImageURL Write FBaseImageURL;
+  end;
+
+Function FixHTMLpath(S : String) : STring;
+
+implementation
+
+uses xmlread, sysutils, sh_pas;
+
+Function FixHTMLpath(S : String) : STring;
+
+begin
+  Result:=StringReplace(S,'\','/',[rfReplaceAll]);
+end;
+
+constructor TBaseHTMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
+
+begin
+  Inherited;
+  FOutputNodeStack := TFPList.Create;
+  FImageFileList:=TStringList.Create;
+end;
+
+destructor TBaseHTMLWriter.Destroy;
+begin
+  FreeAndNil(FOutputNodeStack);
+  FreeAndNil(FImageFileList);
+  inherited Destroy;
+end;
+
+Procedure TBaseHTMLWriter.SetContentElement(aElement : THTMLELement);
+
+begin
+  FContentElement:=aElement;
+end;
+
+function TBaseHTMLWriter.CreateEl(Parent: TDOMNode;
+  const AName: DOMString): THTMLElement;
+begin
+  Result := Doc.CreateElement(AName);
+  Parent.AppendChild(Result);
+end;
+
+function TBaseHTMLWriter.CreatePara(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'p');
+end;
+
+function TBaseHTMLWriter.CreateH1(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'h1');
+end;
+
+function TBaseHTMLWriter.CreateH2(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'h2');
+end;
+
+function TBaseHTMLWriter.CreateH3(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'h3');
+end;
+
+function TBaseHTMLWriter.CreateTable(Parent: TDOMNode; const AClass: DOMString = ''): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'table');
+  Result['cellspacing'] := '0';
+  Result['cellpadding'] := '0';
+  if AClass <> '' then
+    Result['class'] := AClass;
+end;
+
+function TBaseHTMLWriter.CreateContentTable(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'table');
+end;
+
+function TBaseHTMLWriter.CreateTR(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'tr');
+end;
+
+function TBaseHTMLWriter.CreateTD(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'td');
+end;
+
+function TBaseHTMLWriter.CreateTD_vtop(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'td');
+  Result['valign'] := 'top';
+end;
+
+function TBaseHTMLWriter.CreateLink(Parent: TDOMNode; const AHRef: String): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'a');
+  Result['href'] := UTF8Decode(FixHtmlPath(AHRef));
+end;
+
+function TBaseHTMLWriter.CreateLink(Parent: TDOMNode;
+  const AHRef: DOMString): THTMLElement;
+begin
+  Result:=CreateLink(Parent,UTF8Encode(aHREf));
+end;
+
+function TBaseHTMLWriter.CreateAnchor(Parent: TDOMNode;
+  const AName: DOMString): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'a');
+  Result['name'] := AName;
+end;
+
+function TBaseHTMLWriter.CreateCode(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(CreateEl(Parent, 'tt'), 'span');
+  Result['class'] := 'code';
+end;
+
+function TBaseHTMLWriter.CreateWarning(Parent: TDOMNode): THTMLElement;
+begin
+  Result := CreateEl(Parent, 'span');
+  Result['class'] := 'warning';
+end;
+
+procedure TBaseHTMLWriter.DescrEmitNotesHeader(AContext: TPasElement);
+begin
+  AppendText(CreateH2(ContentElement), SDocNotes);
+  PushOutputNode(ContentElement);
+end;
+
+procedure TBaseHTMLWriter.DescrEmitNotesFooter(AContext: TPasElement);
+begin
+  PopOutPutNode;
+end;
+
+procedure TBaseHTMLWriter.PushOutputNode(ANode: TDOMNode);
+begin
+  OutputNodeStack.Add(CurOutputNode);
+  FCurOutputNode := ANode;
+end;
+
+procedure TBaseHTMLWriter.PopOutputNode;
+begin
+  FCurOutputNode := TDOMNode(OutputNodeStack[OutputNodeStack.Count - 1]);
+  OutputNodeStack.Delete(OutputNodeStack.Count - 1);
+end;
+
+procedure TBaseHTMLWriter.DescrWriteText(const AText: DOMString);
+begin
+  AppendText(CurOutputNode, AText);
+end;
+
+procedure TBaseHTMLWriter.DescrBeginBold;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'b'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndBold;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginItalic;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'i'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndItalic;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginEmph;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'em'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndEmph;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginUnderline;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'u'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndUnderline;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
+
+Var
+  Pel,Cel: TDOMNode;
+  El :TDomElement;
+  D : String;
+  L : Integer;
+
+begin
+  // Determine parent node.
+  If (ACaption='') then
+    Pel:=CurOutputNode
+  else
+    begin
+    Cel:=CreateTable(CurOutputNode, 'imagetable');
+    Pel:=CreateTD(CreateTR(Cel));
+    Cel:=CreateTD(CreateTR(Cel));
+    El := CreateEl(Cel, 'span');
+    El['class'] := 'imagecaption';
+    Cel := El;
+    If (ALinkName<>'') then
+      Cel:=CreateAnchor(Cel,ALinkName);
+    AppendText(Cel,ACaption);
+    end;
+
+  // Determine URL for image.
+  If (Module=Nil) then
+    D:=Allocator.GetRelativePathToTop(Package)
+  else
+    D:=Allocator.GetRelativePathToTop(Module);
+  L:=Length(D);
+  If (L>0) and (D[L]<>'/') then
+    D:=D+'/';
+
+  // Create image node.
+  El:=CreateEl(Pel,'img');
+  EL['src']:=UTF8Decode(D + BaseImageURL) + AFileName;
+  El['alt']:=ACaption;
+
+  //cache image filename, so it can be used later (CHM)
+  ImageFileList.Add(UTF8Encode(UTF8Decode(BaseImageURL) + AFileName));
+end;
+
+procedure TBaseHTMLWriter.DescrWriteFileEl(const AText: DOMString);
+var
+  NewEl: TDOMElement;
+begin
+  NewEl := CreateEl(CurOutputNode, 'span');
+  NewEl['class'] := 'file';
+  AppendText(NewEl, AText);
+end;
+
+procedure TBaseHTMLWriter.DescrWriteKeywordEl(const AText: DOMString);
+var
+  NewEl: TDOMElement;
+begin
+  NewEl := CreateEl(CurOutputNode, 'span');
+  NewEl['class'] := 'kw';
+  AppendText(NewEl, AText);
+end;
+
+procedure TBaseHTMLWriter.DescrWriteVarEl(const AText: DOMString);
+begin
+  AppendText(CreateEl(CurOutputNode, 'var'), AText);
+end;
+
+procedure TBaseHTMLWriter.DescrBeginLink(const AId: DOMString);
+var
+  a,s,n : String;
+
+begin
+  a:=UTF8Encode(AId);
+  s := UTF8Encode(ResolveLinkID(a));
+  if Length(s) = 0 then
+  begin
+    if assigned(module) then
+      s:=module.name
+    else
+      s:='?';
+    if a='' then a:='<empty>';
+    if Assigned(CurrentContext) then
+      N:=CurrentContext.Name
+    else
+      N:='?';
+    DoLog(SErrUnknownLinkID, [s,n,a]);
+    PushOutputNode(CreateEl(CurOutputNode, 'b'));
+  end else
+    PushOutputNode(CreateLink(CurOutputNode, s));
+end;
+
+procedure TBaseHTMLWriter.DescrEndLink;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginURL(const AURL: DOMString);
+begin
+  PushOutputNode(CreateLink(CurOutputNode, AURL));
+end;
+
+procedure TBaseHTMLWriter.DescrEndURL;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrWriteLinebreak;
+begin
+  CreateEl(CurOutputNode, 'br');
+end;
+
+procedure TBaseHTMLWriter.DescrBeginParagraph;
+begin
+  PushOutputNode(CreatePara(CurOutputNode));
+end;
+
+procedure TBaseHTMLWriter.DescrEndParagraph;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginCode(HasBorder: Boolean; const AHighlighterName: String);
+begin
+  FDoPasHighlighting := (AHighlighterName = '') or (AHighlighterName = 'Pascal');
+  FHighlighterFlags := 0;
+  PushOutputNode(CreateEl(CurOutputNode, 'pre'));
+end;
+
+procedure TBaseHTMLWriter.DescrWriteCodeLine(const ALine: String);
+begin
+  if DoPasHighlighting then
+  begin
+    FHighlighterFlags := AppendPasSHFragment(CurOutputNode, ALine,FHighlighterFlags);
+    AppendText(CurOutputNode, #10);
+  end else
+    AppendText(CurOutputNode, ALine + #10);
+end;
+
+procedure TBaseHTMLWriter.DescrEndCode;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginOrderedList;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'ol'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndOrderedList;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginUnorderedList;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'ul'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndUnorderedList;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginDefinitionList;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'dl'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndDefinitionList;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginListItem;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'li'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndListItem;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginDefinitionTerm;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'dt'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndDefinitionTerm;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginDefinitionEntry;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'dd'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndDefinitionEntry;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginSectionTitle;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'h3'));
+end;
+
+procedure TBaseHTMLWriter.DescrBeginSectionBody;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrEndSection;
+begin
+end;
+
+procedure TBaseHTMLWriter.DescrBeginRemark;
+var
+  NewEl, TDEl: TDOMElement;
+begin
+  NewEl := CreateEl(CurOutputNode, 'table');
+  NewEl['width'] := '100%';
+  NewEl['border'] := '0';
+  NewEl['CellSpacing'] := '0';
+  NewEl['class'] := 'remark';
+  NewEl := CreateTR(NewEl);
+  TDEl := CreateTD(NewEl);
+  TDEl['valign'] := 'top';
+  TDEl['class'] := 'pre';
+  AppendText(CreateEl(TDEl, 'b'), SDocRemark);
+  PushOutputNode(CreateTD(NewEl));
+end;
+
+procedure TBaseHTMLWriter.DescrEndRemark;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginTable(ColCount: Integer; HasBorder: Boolean);
+var
+  Table: TDOMElement;
+begin
+  Table := CreateEl(CurOutputNode, 'table');
+  Table['border'] := UTF8Decode(IntToStr(Ord(HasBorder)));
+  PushOutputNode(Table);
+end;
+
+procedure TBaseHTMLWriter.DescrEndTable;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginTableCaption;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'caption'));
+end;
+
+procedure TBaseHTMLWriter.DescrEndTableCaption;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginTableHeadRow;
+begin
+  PushOutputNode(CreateTr(CurOutputNode));
+  FInsideHeadRow := True;
+end;
+
+procedure TBaseHTMLWriter.DescrEndTableHeadRow;
+begin
+  FInsideHeadRow := False;
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginTableRow;
+begin
+  PushOutputNode(CreateTR(CurOutputNode));
+end;
+
+procedure TBaseHTMLWriter.DescrEndTableRow;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.DescrBeginTableCell;
+begin
+  if InsideHeadRow then
+    PushOutputNode(CreateEl(CurOutputNode, 'th'))
+  else
+    PushOutputNode(CreateTD(CurOutputNode));
+end;
+
+procedure TBaseHTMLWriter.DescrEndTableCell;
+begin
+  PopOutputNode;
+end;
+
+procedure TBaseHTMLWriter.SetHTMLDocument(aDoc: THTMLDocument);
+begin
+  FDoc:=aDoc;
+  FOutputNodeStack.Clear;
+  FCurOutputNode:=Nil;
+end;
+
+procedure TBaseHTMLWriter.AppendText(Parent: TDOMNode; const AText: String);
+begin
+  AppendText(Parent,UTF8Decode(aText));
+end;
+
+
+procedure TBaseHTMLWriter.AppendText(Parent: TDOMNode; const AText: DOMString);
+begin
+  Parent.AppendChild(Doc.CreateTextNode(AText));
+end;
+
+procedure TBaseHTMLWriter.AppendNbSp(Parent: TDOMNode; ACount: Integer);
+begin
+  while ACount > 0 do
+  begin
+    Parent.AppendChild(Doc.CreateEntityReference('nbsp'));
+    Dec(ACount);
+  end;
+end;
+
+procedure TBaseHTMLWriter.AppendSym(Parent: TDOMNode; const AText: DOMString);
+var
+  El: TDOMElement;
+begin
+  El := CreateEl(Parent, 'span');
+  El['class'] := 'sym';
+  AppendText(El, AText);
+end;
+
+procedure TBaseHTMLWriter.AppendKw(Parent: TDOMNode; const AText: String);
+begin
+  AppendKW(Parent,UTF8Decode(aText));
+end;
+
+procedure TBaseHTMLWriter.AppendKw(Parent: TDOMNode; const AText: DOMString);
+var
+  El: TDOMElement;
+begin
+  El := CreateEl(Parent, 'span');
+  El['class'] := 'kw';
+  AppendText(El, AText);
+end;
+
+function TBaseHTMLWriter.AppendPasSHFragment(Parent: TDOMNode;
+  const AText: String; AShFlags: Byte): Byte;
+
+
+var
+  Line, Last, p: PChar;
+  El: TDOMElement;
+
+  Procedure MaybeOutput;
+
+  Var
+    CurParent: TDomNode;
+
+  begin
+    If (Last<>Nil) then
+      begin
+      If (el<>Nil) then
+        CurParent:=El
+      else
+        CurParent:=Parent;
+      AppendText(CurParent,Last);
+      El:=Nil;
+      Last:=Nil;
+      end;
+  end;
+
+  Function NewEl(Const ElType,Attr,AttrVal : DOMString) : TDomElement;
+
+  begin
+    Result:=CreateEl(Parent,ElType);
+    Result[Attr]:=AttrVal;
+  end;
+
+  Function NewSpan(Const AttrVal : DOMString) : TDomElement;
+
+  begin
+    Result:=CreateEl(Parent,'span');
+    Result['class']:=AttrVal;
+  end;
+
+begin
+  GetMem(Line, Length(AText) * 3 + 4);
+  Try
+  DoPascalHighlighting(AShFlags, PChar(AText), Line);
+  Result := AShFlags;
+  Last := Nil;
+  p := Line;
+  el:=nil;
+  while p[0] <> #0 do
+  begin
+    if p[0] = LF_ESCAPE then
+      begin
+      p[0] := #0;
+      MaybeOutput;
+      case Ord(p[1]) of
+        shDefault:    El:=Nil;
+        shInvalid:    El:=newel('font','color','red');
+        shSymbol :    El:=newspan('sym');
+        shKeyword:    El:=newspan('kw');
+        shComment:    El:=newspan('cmt');
+        shDirective:  El:=newspan('dir');
+        shNumbers:    El:=newspan('num');
+        shCharacters: El:=newspan('chr');
+        shStrings:    El:=newspan('str');
+        shAssembler:  El:=newspan('asm');
+      end;
+      Inc(P);
+      end
+    else If (Last=Nil) then
+      Last:=P;
+    Inc(p);
+  end;
+  MaybeOutput;
+  Finally
+    FreeMem(Line);
+  end;
+end;
+
+
+procedure TBaseHTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement;
+  DocNode: TDocNode ) ;
+
+var
+  Node: TDOMNode;
+  TableEl, El, TREl, ParaEl, NewEl, DescrEl: TDOMElement;
+  l,s,n: DOMString;
+  IsFirstSeeAlso : Boolean;
+
+begin
+  if Not (Assigned(DocNode) and Assigned(DocNode.SeeAlso)) then
+    Exit;
+  IsFirstSeeAlso := True;
+  Node:=DocNode.SeeAlso.FirstChild;
+  While Assigned(Node) do
+    begin
+    if (Node.NodeType=ELEMENT_NODE) and (Node.NodeName='link') then
+      begin
+       if IsFirstSeeAlso then
+         begin
+         IsFirstSeeAlso := False;
+         AppendText(CreateH2(ContentElement), SDocSeeAlso);
+         TableEl := CreateTable(ContentElement);
+         end;
+       El:=TDOMElement(Node);
+       TREl:=CreateTR(TableEl);
+       ParaEl:=CreatePara(CreateTD_vtop(TREl));
+       l:=El['id'];
+       s:= ResolveLinkID(UTF8ENcode(l));
+       if Length(s)=0 then
+         begin
+         if assigned(module) then
+           s:=UTF8Decode(module.name)
+         else
+           s:='?';
+         if l='' then l:='<empty>';
+         if Assigned(AElement) then
+           N:=UTF8Decode(AElement.Name)
+         else
+           N:='?';
+         DoLog(SErrUnknownLinkID, [s,N,l]);
+         NewEl := CreateEl(ParaEl,'b')
+         end
+       else
+         NewEl := CreateLink(ParaEl,s);
+        if Not IsDescrNodeEmpty(El) then
+          begin
+          PushOutputNode(NewEl);
+          Try
+            ConvertBaseShortList(AElement, El, True)
+          Finally
+            PopOutputNode;
+          end;
+          end
+        else
+          AppendText(NewEl,El['id']);
+       l:=El['id'];
+       DescrEl := Engine.FindShortDescr(AElement.GetModule,UTF8Encode(L));
+       if Assigned(DescrEl) then
+         begin
+         AppendNbSp(CreatePara(CreateTD(TREl)), 2);
+         ParaEl := CreatePara(CreateTD(TREl));
+         ParaEl['class'] := 'cmt';
+         PushOutputNode(ParaEl);
+         try
+           ConvertShort(AElement, DescrEl);
+         finally
+           PopOutputNode;
+         end;
+         end;
+       end; // Link node
+     Node := Node.NextSibling;
+     end; // While
+end;
+
+procedure TBaseHTMLWriter.AppendExampleSection ( AElement: TPasElement; DocNode: TDocNode ) ;
+
+var
+  Node: TDOMNode;
+  fn,s: String;
+  f: Text;
+
+begin
+  if not (Assigned(DocNode) and Assigned(DocNode.FirstExample)) then
+    Exit;
+  Node := DocNode.FirstExample;
+  while Assigned(Node) do
+    begin
+    if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'example') then
+      begin
+      fn:=Engine.GetExampleFilename(TDOMElement(Node));
+      If (fn<>'') then
+        begin
+        AppendText(CreateH2(ContentElement), SDocExample);
+        try
+          Assign(f, FN);
+          Reset(f);
+          try
+            PushOutputNode(ContentElement);
+            DescrBeginCode(False, UTF8Encode(TDOMElement(Node)['highlighter']));
+            while not EOF(f) do
+              begin
+              ReadLn(f, s);
+              DescrWriteCodeLine(s);
+              end;
+            DescrEndCode;
+            PopOutputNode;
+          finally
+            Close(f);
+          end;
+        except
+          on e: Exception do
+            begin
+            e.Message := '[example] ' + e.Message;
+            raise;
+            end;
+        end;
+        end;
+      end;
+    Node := Node.NextSibling;
+    end;
+end;
+
+procedure TBaseHTMLWriter.AppendFragment(aParentNode : TDOMElement; aStream : TStream);
+
+begin
+  if (aStream<>Nil) then
+    begin
+    aStream.Position:=0;
+    ReadXMLFragment(aParentNode,aStream);
+    end;
+end;
+
+procedure TBaseHTMLWriter.AppendShortDescr ( AContext: TPasElement;
+  Parent: TDOMNode; DocNode: TDocNode ) ;
+
+Var
+  N : TDocNode;
+
+begin
+  if Assigned(DocNode) then
+    begin
+    If (DocNode.Link<>'') then
+      begin
+      N:=Engine.FindLinkedNode(DocNode);
+      If (N<>Nil) then
+        DocNode:=N;
+      end;
+    If Assigned(DocNode.ShortDescr) then
+      begin
+      PushOutputNode(Parent);
+      try
+        if not ConvertShort(AContext,TDomElement(DocNode.ShortDescr)) then
+          Warning(AContext, SErrInvalidShortDescr)
+      finally
+        PopOutputNode;
+      end;
+      end;
+    end;
+end;
+
+procedure TBaseHTMLWriter.AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
+
+begin
+  AppendShortDescr(Element,Parent,Engine.FindDocNode(Element));
+end;
+
+procedure TBaseHTMLWriter.AppendShortDescrCell(Parent: TDOMNode;  Element: TPasElement);
+
+var
+  ParaEl: TDOMElement;
+
+begin
+  if Assigned(Engine.FindShortDescr(Element)) then
+  begin
+    AppendNbSp(CreatePara(CreateTD(Parent)), 2);
+    ParaEl := CreatePara(CreateTD(Parent));
+    ParaEl['class'] := 'cmt';
+    AppendShortDescr(ParaEl, Element);
+  end;
+end;
+
+procedure TBaseHTMLWriter.AppendDescr(AContext: TPasElement; Parent: TDOMNode;
+  DescrNode: TDOMElement; AutoInsertBlock: Boolean);
+begin
+  if Assigned(DescrNode) then
+  begin
+    PushOutputNode(Parent);
+    try
+      ConvertDescr(AContext, DescrNode, AutoInsertBlock);
+    finally
+      PopOutputNode;
+    end;
+  end;
+end;
+
+procedure TBaseHTMLWriter.AppendDescrSection(AContext: TPasElement; Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: String);
+begin
+  AppendDescrSection(aContext,Parent,DescrNode,UTF8Decode(aTitle));
+end;
+
+procedure TBaseHTMLWriter.AppendDescrSection(AContext: TPasElement;
+  Parent: TDOMNode; DescrNode: TDOMElement; const ATitle: DOMString);
+begin
+  if not IsDescrNodeEmpty(DescrNode) then
+  begin
+    If (ATitle<>'') then // Can be empty for topic.
+      AppendText(CreateH2(Parent), ATitle);
+    AppendDescr(AContext, Parent, DescrNode, True);
+  end;
+end;
+
+function TBaseHTMLWriter.AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
+var
+  s: DOMString;
+  UnitList: TFPList;
+  i: Integer;
+  ThisPackage: TLinkNode;
+begin
+  if Not Assigned(Element) then
+    begin
+    Result := nil;
+    AppendText(CreateWarning(Parent), '<NIL>');
+    end;
+  if Element.InheritsFrom(TPasUnresolvedTypeRef) then
+    begin
+    s := ResolveLinkID(Element.Name);
+    if Length(s) = 0 then
+      begin
+      { Try all packages }
+      ThisPackage := Engine.RootLinkNode.FirstChild;
+      while Assigned(ThisPackage) do
+        begin
+        s := ResolveLinkID(ThisPackage.Name + '.' + Element.Name);
+        if Length(s) > 0 then
+          break;
+        ThisPackage := ThisPackage.NextSibling;
+        end;
+      if Length(s) = 0 then
+        begin
+        { Okay, then we have to try all imported units of the current module }
+        UnitList := Module.InterfaceSection.UsesList;
+        for i := UnitList.Count - 1 downto 0 do
+          begin
+          { Try all packages }
+          ThisPackage := Engine.RootLinkNode.FirstChild;
+          while Assigned(ThisPackage) do
+            begin
+            s := ResolveLinkID(ThisPackage.Name + '.' +
+              TPasType(UnitList[i]).Name + '.' + Element.Name);
+            if Length(s) > 0 then
+              break;
+            ThisPackage := ThisPackage.NextSibling;
+            end;
+          if length(s)=0 then
+            s := ResolveLinkID('#rtl.System.' + Element.Name);
+          if Length(s) > 0 then
+            break;
+          end;
+        end;
+      end;
+    end
+  else if Element is TPasEnumValue then
+    s := ResolveLinkID(Element.Parent.PathName)
+  else
+    s := ResolveLinkID(Element.PathName);
+
+  if Length(s) > 0 then
+    begin
+    Result := CreateLink(Parent, s);
+    AppendText(Result, Element.Name);
+    end
+  else
+    begin
+    Result := nil;
+    AppendText(Parent, Element.Name); // unresolved items
+    end;
+end;
+
+procedure TBaseHTMLWriter.AppendSourceRef(aParent : TDOMElement; AElement: TPasElement);
+
+begin
+  AppendText(CreatePara(aParent), Format(SDocSourcePosition,
+    [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
+end;
+
+
+end.
+

+ 20 - 7
utils/fpdoc/dw_basemd.pp

@@ -1,3 +1,16 @@
+{
+    FPDoc  -  Free Pascal Documentation Tool
+    Copyright (C) 2021 by Michael Van Canneyt
+
+    * Basic Markdown output generator. No assumptions about document/documentation structure
+
+    See the file COPYING, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
 unit dw_basemd;
 unit dw_basemd;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
@@ -32,7 +45,6 @@ Type
     FFileRendering: TRender;
     FFileRendering: TRender;
     FIndentSize: Byte;
     FIndentSize: Byte;
     FKeywordRendering: TRender;
     FKeywordRendering: TRender;
-    FModule: TPasModule;
     FPrefix : string;
     FPrefix : string;
     FMetadata,
     FMetadata,
     FMarkDown: TStrings;
     FMarkDown: TStrings;
@@ -486,7 +498,7 @@ end;
 procedure TBaseMarkdownWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 procedure TBaseMarkdownWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 
 
 Var
 Var
-  D,FN : String;
+  aLink,D,FN : String;
   L : integer;
   L : integer;
 begin
 begin
   // Determine URL for image.
   // Determine URL for image.
@@ -498,15 +510,16 @@ begin
   If (L>0) and (D[L]<>'/') then
   If (L>0) and (D[L]<>'/') then
     D:=D+'/';
     D:=D+'/';
 
 
-  FN:=UTF8Decode(D + BaseImageURL) + AFileName;
+  FN:=D + BaseImageURL+ Utf8Encode(AFileName);
   EnsureEmptyLine;
   EnsureEmptyLine;
-  AppendToLine('!['+aCaption+']('+FN+')',False);
+  aLink:='!['+UTF8Encode(aCaption)+']('+FN+')';
+  AppendToLine(aLink,False);
 end;
 end;
 
 
 procedure TBaseMarkdownWriter.DescrWriteFileEl(const AText: DOMString);
 procedure TBaseMarkdownWriter.DescrWriteFileEl(const AText: DOMString);
 
 
 begin
 begin
-  AppendRendered(aText,FileRendering);
+  AppendRendered(UTF8Encode(aText),FileRendering);
 end;
 end;
 
 
 procedure TBaseMarkdownWriter.DescrWriteKeywordEl(const AText: DOMString);
 procedure TBaseMarkdownWriter.DescrWriteKeywordEl(const AText: DOMString);
@@ -516,7 +529,7 @@ end;
 
 
 procedure TBaseMarkdownWriter.DescrWriteVarEl(const AText: DOMString);
 procedure TBaseMarkdownWriter.DescrWriteVarEl(const AText: DOMString);
 begin
 begin
-  AppendRendered(aText,VarRendering);
+  AppendRendered(UTF8Encode(aText),VarRendering);
 end;
 end;
 
 
 procedure TBaseMarkdownWriter.DescrBeginLink(const AId: DOMString);
 procedure TBaseMarkdownWriter.DescrBeginLink(const AId: DOMString);
@@ -556,7 +569,7 @@ end;
 
 
 procedure TBaseMarkdownWriter.DescrBeginURL(const AURL: DOMString);
 procedure TBaseMarkdownWriter.DescrBeginURL(const AURL: DOMString);
 begin
 begin
-  FLink:=aURL;
+  FLink:=UTF8Encode(aURL);
   AppendToLine('[');
   AppendToLine('[');
 end;
 end;
 
 

+ 15 - 8
utils/fpdoc/dw_chm.pp

@@ -2,7 +2,7 @@ unit dw_chm;
 
 
 interface
 interface
 
 
-uses Classes, DOM, DOM_HTML,
+uses Classes, DOM,
     dGlobals, PasTree, dwriter, dw_html, chmwriter, chmtypes, chmsitemap;
     dGlobals, PasTree, dwriter, dw_html, chmwriter, chmtypes, chmsitemap;
 
 
 type
 type
@@ -63,7 +63,7 @@ type
 
 
 implementation
 implementation
 
 
-uses SysUtils, HTMWrite;
+uses SysUtils, HTMWrite, dw_basehtml;
 
 
 { TCHmFileNameAllocator }
 { TCHmFileNameAllocator }
 
 
@@ -152,11 +152,18 @@ end;
 
 
 procedure TFpDocChmWriter.FileAdded ( AStream: TStream;
 procedure TFpDocChmWriter.FileAdded ( AStream: TStream;
   const AEntry: TFileEntryRec ) ;
   const AEntry: TFileEntryRec ) ;
+var FTsave : boolean;  
 begin
 begin
   // Exclude Full text index for files starting from the dot
   // Exclude Full text index for files starting from the dot
   if Pos('.', AEntry.Name) <> 1 then
   if Pos('.', AEntry.Name) <> 1 then
-    inherited FileAdded(AStream, AEntry);
-
+    inherited FileAdded(AStream, AEntry)
+  else
+    begin
+      FTsave:=FullTextSearch;
+      FullTextSearch:=False;
+      inherited FileAdded(AStream, AEntry);
+      FullTextSearch:=FTsave;
+    end;
 end;
 end;
 
 
 { TCHMHTMLWriter }
 { TCHMHTMLWriter }
@@ -179,12 +186,12 @@ begin
     DoLog('Note: --index-page not assigned. Using default "index.html"');
     DoLog('Note: --index-page not assigned. Using default "index.html"');
   end;
   end;
   
   
-  if FCSSFile <> '' then
+  if CSSFile <> '' then
   begin
   begin
-    if not FileExists(FCSSFile) Then
-      Raise Exception.CreateFmt('Can''t find CSS file "%S"',[FCSSFILE]);
+    if not FileExists(CSSFile) Then
+      Raise Exception.CreateFmt('Can''t find CSS file "%S"',[CSSFILE]);
     TempStream := TMemoryStream.Create;
     TempStream := TMemoryStream.Create;
-    TempStream.LoadFromFile(FCSSFile);
+    TempStream.LoadFromFile(CSSFile);
     TempStream.Position := 0;
     TempStream.Position := 0;
     FChm.AddStreamToArchive('fpdoc.css', '/', TempStream, True);
     FChm.AddStreamToArchive('fpdoc.css', '/', TempStream, True);
     TempStream.Free;
     TempStream.Free;

Fișier diff suprimat deoarece este prea mare
+ 70 - 962
utils/fpdoc/dw_html.pp


+ 12 - 7
utils/fpdoc/dw_markdown.pp

@@ -1,9 +1,8 @@
 {
 {
     FPDoc  -  Free Pascal Documentation Tool
     FPDoc  -  Free Pascal Documentation Tool
-    Copyright (C) 2000 - 2005 by
-      Areca Systems GmbH / Sebastian Guenther, [email protected]
+    Copyright (C) 2021 by Michael Van Canneyt
 
 
-    * HTML/XHTML output generator
+    * Markdown generator, multi-file
 
 
     See the file COPYING, included in this distribution,
     See the file COPYING, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -1909,13 +1908,19 @@ end;
 class procedure TMarkdownWriter.Usage(List: TStrings);
 class procedure TMarkdownWriter.Usage(List: TStrings);
 begin
 begin
   List.add('--header=file');
   List.add('--header=file');
-  List.Add(SHTMLUsageHeader);
+  List.Add(SMDUsageHeader);
   List.add('--footer=file');
   List.add('--footer=file');
-  List.Add(SHTMLUsageFooter);
+  List.Add(SMDUsageFooter);
   List.Add('--index-colcount=N');
   List.Add('--index-colcount=N');
-  List.Add(SHTMLIndexColcount);
+  List.Add(SMDIndexColcount);
   List.Add('--image-url=url');
   List.Add('--image-url=url');
-  List.Add(SHTMLImageUrl);
+  List.Add(SMDImageUrl);
+  List.Add('--theme=name');
+  List.Add(SMDTheme);
+  List.Add('--navigation=scheme');
+  List.Add(SMDNavigation);
+  List.Add(SMDNavSubtree);
+  List.Add(SMDNavTree);
 end;
 end;
 
 
 class procedure TMarkdownWriter.SplitImport(var AFilename, ALinkPrefix: String);
 class procedure TMarkdownWriter.SplitImport(var AFilename, ALinkPrefix: String);

+ 19 - 0
utils/fpdoc/dwriter.pp

@@ -186,10 +186,12 @@ type
     procedure DescrEndTableRow; virtual; abstract;
     procedure DescrEndTableRow; virtual; abstract;
     procedure DescrBeginTableCell; virtual; abstract;
     procedure DescrBeginTableCell; virtual; abstract;
     procedure DescrEndTableCell; virtual; abstract;
     procedure DescrEndTableCell; virtual; abstract;
+
     Property CurrentContext : TPasElement Read FContext ;
     Property CurrentContext : TPasElement Read FContext ;
   public
   public
     Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual;
     Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual;
     destructor Destroy;  override;
     destructor Destroy;  override;
+    procedure AddModuleIdentifiers(AModule: TPasModule; L: TStrings);
     property Engine : TFPDocEngine read FEngine;
     property Engine : TFPDocEngine read FEngine;
     Property Package : TPasPackage read FPackage;
     Property Package : TPasPackage read FPackage;
     Property Topics : TList Read FTopics;
     Property Topics : TList Read FTopics;
@@ -526,6 +528,7 @@ begin
          and (AModule.InterfaceSection.Classes.Count>0);
          and (AModule.InterfaceSection.Classes.Count>0);
 end;
 end;
 
 
+
 procedure TMultiFileDocWriter.AddPages(AElement: TPasElement; ASubpageIndex: Integer;
 procedure TMultiFileDocWriter.AddPages(AElement: TPasElement; ASubpageIndex: Integer;
   AList: TFPList);
   AList: TFPList);
 var
 var
@@ -1028,6 +1031,22 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
+procedure TFPDocWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
+
+begin
+  if assigned(AModule.InterfaceSection) Then
+   begin
+      AddElementsFromList(L,AModule.InterfaceSection.Consts);
+      AddElementsFromList(L,AModule.InterfaceSection.Types);
+      AddElementsFromList(L,AModule.InterfaceSection.Functions);
+      AddElementsFromList(L,AModule.InterfaceSection.Classes);
+      AddElementsFromList(L,AModule.InterfaceSection.Variables);
+      AddElementsFromList(L,AModule.InterfaceSection.ResStrings);
+   end;
+end;
+
+
+
 function TFPDocWriter.InterpretOption(const Cmd, Arg: String): Boolean;
 function TFPDocWriter.InterpretOption(const Cmd, Arg: String): Boolean;
 begin
 begin
   Result:=False;
   Result:=False;

+ 5 - 1
utils/fpdoc/fpdoc.lpi

@@ -46,7 +46,7 @@
         <PackageName Value="FCL"/>
         <PackageName Value="FCL"/>
       </Item1>
       </Item1>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="19">
+    <Units Count="20">
       <Unit0>
       <Unit0>
         <Filename Value="fpdoc.pp"/>
         <Filename Value="fpdoc.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -130,6 +130,10 @@
         <Filename Value="dw_basemd.pp"/>
         <Filename Value="dw_basemd.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit18>
       </Unit18>
+      <Unit19>
+        <Filename Value="dw_basehtml.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit19>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 1 - 1
utils/fpdoc/fpdoc.pp

@@ -37,7 +37,7 @@ uses
   dw_man,    // Man page writer
   dw_man,    // Man page writer
   dw_linrtf, // linear RTF writer
   dw_linrtf, // linear RTF writer
   dw_txt,    // TXT writer
   dw_txt,    // TXT writer
-  fpdocproj, mkfpdoc, dw_basemd;
+  fpdocproj, mkfpdoc, dw_basemd, dw_basehtml;
 
 
 
 
 Type
 Type

+ 1 - 1
utils/fpdoc/fpdocclasstree.pp

@@ -5,7 +5,7 @@ unit fpdocclasstree;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
+  Classes, SysUtils, dGlobals, pastree, contnrs{$IFDEF TREE_TEST}, DOM ,XMLWrite{$ENDIF};
 
 
 Type
 Type
 
 

Unele fișiere nu au fost afișate deoarece prea multe fișiere au fost modificate în acest diff