* synchronized with trunk

git-svn-id: branches/wasm@48022 -

.gitattributes

@@ -15229,6 +15229,10 @@ tests/test/tgenfunc20.pp svneol=native#text/pascal
 tests/test/tgenfunc21.pp svneol=native#text/pascal
 tests/test/tgenfunc22.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/tgenfunc4.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/tw3790.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/tw3931b.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/tw3827.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/tw3840.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/css.inc 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_chm.pp svneol=native#text/plain
 utils/fpdoc/dw_dxml.pp svneol=native#text/plain

compiler/dbgstabs.pas

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

compiler/nadd.pas

@@ -536,12 +536,28 @@ implementation
 
       function SwapLeftWithRightRight : tnode;
         var
-          hp: tnode;
+          hp,hp2 : tnode;
         begin
-          hp:=left;
+          { keep the order of val+const else string operations might cause an error }
-          left:=taddnode(right).right;
+          hp:=taddnode(right).right;
-          taddnode(right).right:=hp;
+
-          right:=right.simplify(false);
+          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;
         end;
 
@@ -1207,23 +1223,7 @@ implementation
              exit;
           end;
 
-        { try to fold
+        { set constant evaluation }
-                    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 }
         if (right.nodetype=setconstn) and
            not assigned(tsetconstnode(right).left) and
            (left.nodetype=setconstn) and
@@ -1381,9 +1381,44 @@ implementation
             exit;
           end;
 
-        { slow simplifications }
+        { slow simplifications and/or more sophisticated transformations which might make debugging harder }
         if cs_opt_level2 in current_settings.optimizerswitches then
           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
               equal if some previous optimizations were done so don't check
               this simplification always

compiler/pdecsub.pas

@@ -1066,7 +1066,8 @@ implementation
                            end
                          else if (srsym.typ=typesym) 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
                              { this is a generic dummy symbol that has not yet
                                been used; so we rename the dummy symbol and continue
@@ -1162,13 +1163,26 @@ implementation
               end;
             if not assigned(dummysym) then
               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
                   astruct.symtable.insert(dummysym)
                 else
                   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;
-            include(dummysym.symoptions,sp_generic_dummy);
             { start token recorder for the declaration }
             pd.init_genericdecl;
             current_scanner.startrecordtokens(pd.genericdecltokenbuf);

compiler/pexports.pas

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

compiler/pexpr.pas

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

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

compiler/symtable.pas

@@ -3374,6 +3374,8 @@ implementation
                     exit;
                   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
         else
           result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
@@ -4254,6 +4256,14 @@ implementation
                         result:=true;
                         exit;
                       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;
                 typesym,
                 fieldvarsym,

compiler/x86/nx86inl.pas

@@ -1223,7 +1223,9 @@ implementation
              { only one memory operand is allowed }
              gotmem:=false;
              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
                  if not(paraarray[i].location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then
                    begin

packages/fcl-passrc/src/pasresolveeval.pas

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

packages/fcl-passrc/src/pasresolver.pp

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

packages/fcl-passrc/src/pastree.pp

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

packages/fcl-passrc/src/pparser.pp

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

packages/fcl-passrc/tests/tcresolver.pas

@@ -986,6 +986,7 @@ type
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_Initialization_Finalization;
+    Procedure TestLibrary_ExportFuncOverloadFail; // ToDo
     // ToDo Procedure TestLibrary_UnitExports;
   end;
 
@@ -18833,6 +18834,25 @@ begin
   ParseLibrary;
 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
   RegisterTests([TTestResolver]);
 

packages/pastojs/src/pas2jsfiler.pp

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

packages/pastojs/tests/tcfiler.pas

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

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;
 
 {$mode objfpc}

rtl/aarch64/mathu.inc

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

rtl/arm/mathu.inc

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

rtl/i386/mathu.inc

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

rtl/i8086/mathu.inc

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

rtl/m68k/mathu.inc

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

rtl/mips/mathu.inc

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

rtl/powerpc/mathu.inc

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

rtl/powerpc64/mathu.inc

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

rtl/riscv64/mathu.inc

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

rtl/sparc/mathu.inc

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

rtl/sparc64/mathu.inc

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

rtl/win/syswin.inc

@@ -609,6 +609,14 @@ procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:Unico
         dwFlags:=MB_PRECOMPOSED;
       end;
     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
     setlength(dest, destlen);
     if destlen>0 then

rtl/x86_64/mathu.inc

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

rtl/xtensa/mathu.inc

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

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.
+

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.
+

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.
+

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.
+

tests/test/units/math/trndcurr.pp

@@ -1,13 +1,34 @@
 uses
   Math;
 
+
+const
+  failure_count : longint = 0;
+  first_error : longint = 0;
+
 {$ifndef SKIP_CURRENCY_TEST}
 procedure testround(const c, expected: currency; error: longint);
 begin
   if round(c)<>expected then
     begin
       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;
 
@@ -16,6 +37,13 @@ end;
 
 begin
 {$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)');
   testround(0.5,0.0,1);
   testround(1.5,2.0,2);
@@ -31,7 +59,15 @@ begin
   testround(-1.4,-1.0,154);
 
   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(1.5,2.0,6);
   testround(-0.5,0.0,7);
@@ -46,7 +82,15 @@ begin
   testround(-1.4,-1.0,158);
 
   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(1.5,1.0,10);
   testround(-0.5,-1.0,11);
@@ -61,7 +105,15 @@ begin
   testround(-1.4,-2.0,162);
 
   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(1.5,1.0,14);
   testround(-0.5,0.0,15);
@@ -75,4 +127,100 @@ begin
   testround(-0.4,0.0,165);
   testround(-1.4,-1.0,166);
 {$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.

tests/webtbf/tw38289a.pp

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

tests/webtbf/tw38289b.pp

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

tests/webtbs/tw38267b.pp

@@ -1,6 +1,6 @@
 { %opt=-O3 -Sg }
 {$mode objfpc} {$longstrings+}
-label start1, end1, start2, end2, start3, end3;
+label start1, end1, start2, end2, start3, end3, start4, end4;
 
 var
 	s: string;
@@ -88,5 +88,34 @@ end3:
     if PtrUint(CodePointer(@end3) - CodePointer(@start3))>300 then
       halt(3);
     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');
 end.

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.

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.

utils/fpdoc/dglobals.pp

@@ -139,7 +139,7 @@ resourcestring
   SHTMLIndexColcount = 'Use N columns in the identifier index pages';
   SHTMLImageUrl = 'Prefix image URLs with url';
   SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
-    
+
   // CHM usage
   SCHMUsageTOC     = 'Use [File] as the table of contents. Usually a .hhc 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*';
   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';
 
   // Linear usage

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;
 
 {$mode objfpc}{$H+}
@@ -32,7 +45,6 @@ Type
     FFileRendering: TRender;
     FIndentSize: Byte;
     FKeywordRendering: TRender;
-    FModule: TPasModule;
     FPrefix : string;
     FMetadata,
     FMarkDown: TStrings;
@@ -486,7 +498,7 @@ end;
 procedure TBaseMarkdownWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 
 Var
-  D,FN : String;
+  aLink,D,FN : String;
   L : integer;
 begin
   // Determine URL for image.
@@ -498,15 +510,16 @@ begin
   If (L>0) and (D[L]<>'/') then
     D:=D+'/';
 
-  FN:=UTF8Decode(D + BaseImageURL) + AFileName;
+  FN:=D + BaseImageURL+ Utf8Encode(AFileName);
   EnsureEmptyLine;
-  AppendToLine('!['+aCaption+']('+FN+')',False);
+  aLink:='!['+UTF8Encode(aCaption)+']('+FN+')';
+  AppendToLine(aLink,False);
 end;
 
 procedure TBaseMarkdownWriter.DescrWriteFileEl(const AText: DOMString);
 
 begin
-  AppendRendered(aText,FileRendering);
+  AppendRendered(UTF8Encode(aText),FileRendering);
 end;
 
 procedure TBaseMarkdownWriter.DescrWriteKeywordEl(const AText: DOMString);
@@ -516,7 +529,7 @@ end;
 
 procedure TBaseMarkdownWriter.DescrWriteVarEl(const AText: DOMString);
 begin
-  AppendRendered(aText,VarRendering);
+  AppendRendered(UTF8Encode(aText),VarRendering);
 end;
 
 procedure TBaseMarkdownWriter.DescrBeginLink(const AId: DOMString);
@@ -556,7 +569,7 @@ end;
 
 procedure TBaseMarkdownWriter.DescrBeginURL(const AURL: DOMString);
 begin
-  FLink:=aURL;
+  FLink:=UTF8Encode(aURL);
   AppendToLine('[');
 end;
 

utils/fpdoc/dw_chm.pp

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

utils/fpdoc/dw_markdown.pp

@@ -1,9 +1,8 @@
 {
     FPDoc  -  Free Pascal Documentation Tool
-    Copyright (C) 2000 - 2005 by
+    Copyright (C) 2021 by Michael Van Canneyt
-      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
 
-    * HTML/XHTML output generator
+    * Markdown generator, multi-file
 
     See the file COPYING, included in this distribution,
     for details about the copyright.
@@ -1909,13 +1908,19 @@ end;
 class procedure TMarkdownWriter.Usage(List: TStrings);
 begin
   List.add('--header=file');
-  List.Add(SHTMLUsageHeader);
+  List.Add(SMDUsageHeader);
   List.add('--footer=file');
-  List.Add(SHTMLUsageFooter);
+  List.Add(SMDUsageFooter);
   List.Add('--index-colcount=N');
-  List.Add(SHTMLIndexColcount);
+  List.Add(SMDIndexColcount);
   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;
 
 class procedure TMarkdownWriter.SplitImport(var AFilename, ALinkPrefix: String);

utils/fpdoc/dwriter.pp

@@ -186,10 +186,12 @@ type
     procedure DescrEndTableRow; virtual; abstract;
     procedure DescrBeginTableCell; virtual; abstract;
     procedure DescrEndTableCell; virtual; abstract;
+
     Property CurrentContext : TPasElement Read FContext ;
   public
     Constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); virtual;
     destructor Destroy;  override;
+    procedure AddModuleIdentifiers(AModule: TPasModule; L: TStrings);
     property Engine : TFPDocEngine read FEngine;
     Property Package : TPasPackage read FPackage;
     Property Topics : TList Read FTopics;
@@ -526,6 +528,7 @@ begin
          and (AModule.InterfaceSection.Classes.Count>0);
 end;
 
+
 procedure TMultiFileDocWriter.AddPages(AElement: TPasElement; ASubpageIndex: Integer;
   AList: TFPList);
 var
@@ -1028,6 +1031,22 @@ begin
   Inherited;
 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;
 begin
   Result:=False;

utils/fpdoc/fpdoc.lpi

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

utils/fpdoc/fpdoc.pp

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

utils/fpdoc/fpdocclasstree.pp

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