* synchronised with trunk till r41725

git-svn-id: branches/debug_eh@41726 -

.gitattributes

@@ -2112,6 +2112,8 @@ packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3loadlib.lpr svneol=native#text/plain
 packages/fcl-db/examples/sqlparser.pp svneol=native#text/plain
+packages/fcl-db/examples/sqlshell.lpi svneol=native#text/plain
+packages/fcl-db/examples/sqlshell.pas svneol=native#text/plain
 packages/fcl-db/examples/tsamytable.pp svneol=native#text/plain
 packages/fcl-db/examples/typesafetable.sql svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
@@ -2658,6 +2660,7 @@ packages/fcl-passrc/tests/testpassrc.lpi svneol=native#text/plain
 packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
 packages/fcl-pdf/Makefile svneol=native#text/plain
 packages/fcl-pdf/Makefile.fpc svneol=native#text/plain
+packages/fcl-pdf/examples/diamond.png -text svneol=unset#image/png
 packages/fcl-pdf/examples/poppy.jpg -text
 packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
 packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
@@ -3323,6 +3326,8 @@ packages/fcl-web/examples/jsonrpc/extdirect/extdirect.in svneol=native#text/plai
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.lfm svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.pp svneol=native#text/plain
 packages/fcl-web/examples/restbridge/README.txt svneol=native#text/plain
+packages/fcl-web/examples/restbridge/cmdclient/cmdclient.lpi svneol=native#text/plain
+packages/fcl-web/examples/restbridge/cmdclient/cmdclient.pas svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas svneol=native#text/plain
 packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr svneol=native#text/plain
@@ -3331,7 +3336,9 @@ packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.res -text
 packages/fcl-web/examples/restbridge/demorestbridge.lpi svneol=native#text/plain
 packages/fcl-web/examples/restbridge/demorestbridge.pp svneol=native#text/plain
 packages/fcl-web/examples/restbridge/expenses-data.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-fb.sql svneol=native#text/plain
 packages/fcl-web/examples/restbridge/expenses-pq.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-sqlite.sql svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpi svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/routing/README svneol=native#text/plain
@@ -3465,6 +3472,7 @@ packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/webjsonrpc.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestado.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestauth.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestauthini.pp svneol=native#text/plain
 packages/fcl-web/src/restbridge/sqldbrestbridge.pp svneol=native#text/plain
@@ -3502,6 +3510,8 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
 packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
+packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
 packages/fcl-xml/examples/test.html svneol=native#text/html
 packages/fcl-xml/examples/testhtml.pp svneol=native#text/plain
 packages/fcl-xml/fpmake.pp svneol=native#text/plain
@@ -10246,7 +10256,11 @@ rtl/openbsd/errnostr.inc svneol=native#text/plain
 rtl/openbsd/i386/bsyscall.inc svneol=native#text/plain
 rtl/openbsd/i386/cprt0.as svneol=native#text/plain
 rtl/openbsd/i386/dllprt0.as svneol=native#text/plain
+rtl/openbsd/i386/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/i386/prt0.as svneol=native#text/plain
+rtl/openbsd/i386/si_c.inc svneol=native#text/plain
+rtl/openbsd/i386/si_dll.inc svneol=native#text/plain
+rtl/openbsd/i386/si_prc.inc svneol=native#text/plain
 rtl/openbsd/i386/sighnd.inc svneol=native#text/plain
 rtl/openbsd/osdefs.inc svneol=native#text/plain
 rtl/openbsd/pmutext.inc svneol=native#text/plain
@@ -10254,6 +10268,11 @@ rtl/openbsd/pthread.inc svneol=native#text/plain
 rtl/openbsd/ptypes.inc svneol=native#text/plain
 rtl/openbsd/rtldefs.inc svneol=native#text/plain
 rtl/openbsd/setsysnr.inc svneol=native#text/plain
+rtl/openbsd/si_c.pp svneol=native#text/plain
+rtl/openbsd/si_dll.pp svneol=native#text/plain
+rtl/openbsd/si_impl.inc svneol=native#text/plain
+rtl/openbsd/si_intf.inc svneol=native#text/plain
+rtl/openbsd/si_prc.pp svneol=native#text/plain
 rtl/openbsd/signal.inc svneol=native#text/plain
 rtl/openbsd/syscalls.inc svneol=native#text/plain
 rtl/openbsd/sysconst.inc svneol=native#text/plain
@@ -10273,7 +10292,11 @@ rtl/openbsd/x86_64/cprt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/crt0.s svneol=native#text/plain
 rtl/openbsd/x86_64/dllprt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/gprt0.as svneol=native#text/plain
+rtl/openbsd/x86_64/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/x86_64/prt0.as svneol=native#text/plain
+rtl/openbsd/x86_64/si_c.inc svneol=native#text/plain
+rtl/openbsd/x86_64/si_dll.inc svneol=native#text/plain
+rtl/openbsd/x86_64/si_prc.inc svneol=native#text/plain
 rtl/openbsd/x86_64/sighnd.inc svneol=native#text/plain
 rtl/os2/Makefile svneol=native#text/plain
 rtl/os2/Makefile.fpc svneol=native#text/plain
@@ -11804,6 +11827,7 @@ tests/tbs/tb0651.pp svneol=native#text/pascal
 tests/tbs/tb0652.pp svneol=native#text/pascal
 tests/tbs/tb0653.pp svneol=native#text/plain
 tests/tbs/tb0654.pp svneol=native#text/plain
+tests/tbs/tb0655.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -16533,6 +16557,7 @@ tests/webtbs/tw3478.pp svneol=native#text/plain
 tests/webtbs/tw3479.pp svneol=native#text/plain
 tests/webtbs/tw34818.pp svneol=native#text/pascal
 tests/webtbs/tw34848.pp svneol=native#text/pascal
+tests/webtbs/tw34858.pp svneol=native#text/plain
 tests/webtbs/tw3489.pp svneol=native#text/plain
 tests/webtbs/tw34893.pp -text svneol=native#text/pascal
 tests/webtbs/tw3490.pp svneol=native#text/plain
@@ -16548,7 +16573,10 @@ tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw35139.pp svneol=native#text/plain
 tests/webtbs/tw35139a.pp svneol=native#text/plain
 tests/webtbs/tw35149.pp svneol=native#text/plain
+tests/webtbs/tw35187.pp svneol=native#text/pascal
+tests/webtbs/tw35224.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
+tests/webtbs/tw35233.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain
 tests/webtbs/tw3533.pp svneol=native#text/plain

Makefile

@@ -1813,6 +1813,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

compiler/Makefile

@@ -3720,6 +3720,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

compiler/aarch64/racpugas.pas

@@ -485,8 +485,8 @@ Unit racpugas;
                       useszr:=false;
                       for i:=low(instr.operands) to pred(opnr) do
                         begin
-                          if (instr.operands[1].opr.typ=OPR_REGISTER) then
-                            case getsupreg(instr.operands[1].opr.reg) of
+                          if (instr.operands[i].opr.typ=OPR_REGISTER) then
+                            case getsupreg(instr.operands[i].opr.reg) of
                               RS_XZR:
                                 useszr:=true;
                               RS_SP:
@@ -494,7 +494,10 @@ Unit racpugas;
                             end;
                         end;
                       result:=valid_shifter_operand(instr.opcode,useszr,usessp,instr.Is64bit,sm,instr.operands[opnr].opr.shifterop.shiftimm);
-                    end
+                      if result then
+                        instr.Ops:=opnr;
+                    end;
+                  break;
                 end;
           end;
       end;

compiler/jvm/jvmdef.pas

@@ -1121,10 +1121,11 @@ implementation
             pd.visibility:=vis_public;
             { result type }
             pd.returndef:=obj;
-            { calling convention, self, ... (not for advanced records, for those
-              this is handled later) }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_declaration,hcc_check])
+            { calling convention }
+            if assigned(current_structdef) or
+               (assigned(pd.owner.defowner) and
+                (pd.owner.defowner.typ=recorddef)) then
+              handle_calling_convention(pd,hcc_default_actions_intf_struct)
             else
               handle_calling_convention(pd,hcc_default_actions_intf);
             { register forward declaration with procsym }

compiler/jvm/pjvm.pas

@@ -322,6 +322,7 @@ implementation
         vmtbuilder:=TVMTBuilder.Create(enumclass);
         vmtbuilder.generate_vmt;
         vmtbuilder.free;
+        insert_struct_hidden_paras(enumclass);
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
         current_structdef:=old_current_structdef;
@@ -376,8 +377,6 @@ implementation
           then wraps them and calls through to JLRMethod.invoke }
         methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
-        insert_self_and_vmt_para(methoddef);
-        insert_funcret_para(methoddef);
         methoddef.synthetickind:=tsk_jvm_procvar_invoke;
         methoddef.calcparas;
 
@@ -411,8 +410,6 @@ implementation
             symtablestack.push(pvintf.symtable);
             methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
-            insert_self_and_vmt_para(methoddef);
-            insert_funcret_para(methoddef);
             { can't be final/static/private/protected, and must be virtual
               since it's an interface method }
             methoddef.procoptions:=methoddef.procoptions-[po_staticmethod,po_finalmethod];
@@ -436,6 +433,7 @@ implementation
         vmtbuilder:=TVMTBuilder.Create(pvclass);
         vmtbuilder.generate_vmt;
         vmtbuilder.free;
+        insert_struct_hidden_paras(pvclass);
 
         restore_after_new_class(sstate,islocal,oldsymtablestack);
       end;
@@ -477,7 +475,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the virtual class method }
-        wrapperpd:=tprocdef(pd.getcopy);
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,''));
         { this one is not virtual nor override }
         exclude(wrapperpd.procoptions,po_virtualmethod);
         exclude(wrapperpd.procoptions,po_overridingmethod);
@@ -508,8 +506,8 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
-        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal,''));
-        wrapperpv.calcparas;
+        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,''));
+        handle_calling_convention(wrapperpv,hcc_default_actions_intf);
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
         jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
@@ -551,11 +549,6 @@ implementation
           in callnodes, we will have to replace the calls to virtual
           constructors with calls to the wrappers) }
         finish_copied_procdef(wrapperpd,pd.procsym.realname+'__fpcvirtconstrwrapper__',pd.owner,tabstractrecorddef(pd.owner.defowner));
-        { since it was a bare copy, insert the self parameter (we can't just
-          copy the vmt parameter from the constructor, that's different) }
-        insert_self_and_vmt_para(wrapperpd);
-        insert_funcret_para(wrapperpd);
-        wrapperpd.calcparas;
         { implementation: call through to the constructor
           Exception: if the current class is abstract, do not call the
             constructor, since abstract class cannot be constructed (and the

compiler/jvm/symcpu.pas

@@ -334,7 +334,7 @@ implementation
                           proc_add_definition will give an error }
                       end;
                     { add method with the correct visibility }
-                    pd:=tprocdef(parentpd.getcopy);
+                    pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
                     { get rid of the import accessorname for inherited virtual class methods,
                       it has to be regenerated rather than amended }
                     if [po_classmethod,po_virtualmethod]<=pd.procoptions then
@@ -394,7 +394,7 @@ implementation
           begin
             { getter/setter could have parameters in case of indexed access
               -> copy original procdef }
-            pd:=tprocdef(orgaccesspd.getcopy);
+            pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
             exclude(pd.procoptions,po_abstractmethod);
             exclude(pd.procoptions,po_overridingmethod);
             { can only construct the artificial accessorname now, because it requires
@@ -488,11 +488,8 @@ implementation
           done already }
         if not assigned(orgaccesspd) then
           begin
-            { calling convention, self, ... }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_declaration,hcc_check])
-            else
-              handle_calling_convention(pd,hcc_default_actions_intf);
+            { calling convention }
+            handle_calling_convention(pd,hcc_default_actions_intf_struct);
             { register forward declaration with procsym }
             proc_add_definition(pd);
           end;
@@ -692,7 +689,6 @@ implementation
       the JVM, this only sets the importname, however) }
     if assigned(paras) then
       begin
-        init_paraloc_info(callerside);
         for i:=0 to paras.count-1 do
           begin
             vs:=tparavarsym(paras[i]);

compiler/pdecl.pas

@@ -888,6 +888,7 @@ implementation
                         vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
                         vmtbuilder.generate_vmt;
                         vmtbuilder.free;
+                        insert_struct_hidden_paras(tobjectdef(hdef));
                       end;
 
                     { In case of an objcclass, verify that all methods have a message

compiler/pdecobj.pas

@@ -72,19 +72,20 @@ implementation
           recorddef:
             begin
               parse_record_proc_directives(pd);
-              // we can't add hidden params here because record is not yet defined
-              // and therefore record size which has influence on paramter passing rules may change too
-              // look at record_dec to see where calling conventions are applied (issue #0021044)
-              handle_calling_convention(pd,[hcc_declaration,hcc_check]);
             end;
           objectdef:
             begin
               parse_object_proc_directives(pd);
-              handle_calling_convention(pd,hcc_default_actions_intf);
             end
           else
             internalerror(2011040502);
         end;
+        // We can't add hidden params here because record is not yet defined
+        // and therefore record size which has influence on paramter passing rules may change too
+        // look at record_dec to see where calling conventions are applied (issue #0021044).
+        // The same goes for objects/classes due to the calling convention that may only be set
+        // later (mantis #35233).
+        handle_calling_convention(pd,hcc_default_actions_intf_struct);
 
         { add definition to procsym }
         proc_add_definition(pd);
@@ -923,7 +924,7 @@ implementation
                      is_classdef and not (po_staticmethod in result.procoptions) then
                     MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
 
-                  handle_calling_convention(result,hcc_default_actions_intf);
+                  handle_calling_convention(result,hcc_default_actions_intf_struct);
 
                   { add definition to procsym }
                   proc_add_definition(result);

compiler/pdecsub.pas

@@ -1696,7 +1696,7 @@ implementation
             // we can't add hidden params here because record is not yet defined
             // and therefore record size which has influence on paramter passing rules may change too
             // look at record_dec to see where calling conventions are applied (issue #0021044)
-            handle_calling_convention(result,[hcc_declaration,hcc_check]);
+            handle_calling_convention(result,hcc_default_actions_intf_struct);
 
             { add definition to procsym }
             proc_add_definition(result);

compiler/pdecvar.pas

@@ -260,7 +260,10 @@ implementation
             var
               sym: tprocsym;
             begin
-              handle_calling_convention(pd,hcc_default_actions_intf);
+              if not assigned(astruct) then
+                handle_calling_convention(pd,hcc_default_actions_intf)
+              else
+                handle_calling_convention(pd,hcc_default_actions_intf_struct);
               sym:=cprocsym.create(prefix+lower(p.realname));
               symtablestack.top.insert(sym);
               pd.procsym:=sym;
@@ -539,7 +542,10 @@ implementation
                       begin
                         readprocdef.returndef:=p.propdef;
                         { Insert hidden parameters }
-                        handle_calling_convention(readprocdef,hcc_default_actions_intf);
+                        if assigned(astruct) then
+                          handle_calling_convention(readprocdef,hcc_default_actions_intf_struct)
+                        else
+                          handle_calling_convention(readprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_read,sym,def,readprocdef);
                   end;
@@ -562,7 +568,10 @@ implementation
                         hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
                         writeprocdef.parast.insert(hparavs);
                         { Insert hidden parameters }
-                        handle_calling_convention(writeprocdef,hcc_default_actions_intf);
+                        if not assigned(astruct) then
+                          handle_calling_convention(writeprocdef,hcc_default_actions_intf)
+                        else
+                          handle_calling_convention(writeprocdef,hcc_default_actions_intf_struct);
                       end;
                     p.add_getter_or_setter_for_sym(palt_write,sym,def,writeprocdef);
                   end;
@@ -650,7 +659,10 @@ implementation
                                    end;
 
                                  { Insert hidden parameters }
-                                 handle_calling_convention(storedprocdef,hcc_default_actions_intf);
+                                 if not assigned(astruct) then
+                                   handle_calling_convention(storedprocdef,hcc_default_actions_intf)
+                                 else
+                                   handle_calling_convention(storedprocdef,hcc_default_actions_intf_struct);
                                  p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).Find_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
                                  if not assigned(p.propaccesslist[palt_stored].procdef) then
                                    message(parser_e_ill_property_storage_sym);

compiler/pgenutil.pas

@@ -1059,6 +1059,7 @@ uses
                       vmtbuilder:=TVMTBuilder.Create(tobjectdef(result));
                       vmtbuilder.generate_vmt;
                       vmtbuilder.free;
+                      insert_struct_hidden_paras(tobjectdef(result));
                     end;
                   { handle params, calling convention, etc }
                   procvardef:

compiler/powerpc64/nppcmat.pas

@@ -169,7 +169,7 @@ var
       end;
     end else begin
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)], OS_INT,
-        tordconstnode(right).value, numerator, resultreg);
+        tordconstnode(right).value.svalue, numerator, resultreg);
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg,
         resultreg);
       cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg);
@@ -202,7 +202,7 @@ begin
   if (cs_opt_level1 in current_settings.optimizerswitches) and (right.nodetype = ordconstn) then begin
     if (nodetype = divn) then
       cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)],
-        size, tordconstnode(right).value, numerator, resultreg)
+        size, tordconstnode(right).value.svalue, numerator, resultreg)
     else
       genOrdConstNodeMod;
     done := true;

compiler/pparautl.pas

@@ -34,7 +34,7 @@ interface
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure check_c_para(pd:Tabstractprocdef);
-    procedure insert_record_hidden_paras(astruct: trecorddef);
+    procedure insert_struct_hidden_paras(astruct: tabstractrecorddef);
 
     type
       // flags of the *handle_calling_convention routines
@@ -47,6 +47,7 @@ interface
 
     const
       hcc_default_actions_intf=[hcc_declaration,hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_intf_struct=hcc_default_actions_intf-[hcc_insert_hidden_paras];
       hcc_default_actions_impl=[hcc_check,hcc_insert_hidden_paras];
       hcc_default_actions_parse=[hcc_check,hcc_insert_hidden_paras];
       PD_VIRTUAL_MUTEXCLPO = [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod];
@@ -448,7 +449,7 @@ implementation
       end;
 
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
+    procedure insert_struct_hidden_paras(astruct: tabstractrecorddef);
       var
         pd: tdef;
         i: longint;
@@ -570,6 +571,13 @@ implementation
 
         if hcc_insert_hidden_paras in flags then
           begin
+            { If the paraloc info has been calculated already, it will be missing for
+              the new parameters we add below. This should never be necessary before
+              we add them, as users of this information would not process these extra
+              parameters in that case }
+            if pd.has_paraloc_info<>callnoside then
+              internalerror(2019031610);
+
             { insert hidden high parameters }
             pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
 
@@ -1086,7 +1094,7 @@ implementation
           representable in source form and we don't need them anyway }
         symtablestack.push(trecorddef(nestedvarsdef).symtable);
         maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
-        insert_record_hidden_paras(trecorddef(nestedvarsdef));
+        insert_struct_hidden_paras(trecorddef(nestedvarsdef));
         symtablestack.pop(trecorddef(nestedvarsdef).symtable);
   {$endif}
         symtablestack.free;

compiler/ptype.pas

@@ -1051,7 +1051,7 @@ implementation
          { don't keep track of procdefs in a separate list, because the
            compiler may add additional procdefs (e.g. property wrappers for
            the jvm backend) }
-         insert_record_hidden_paras(trecorddef(current_structdef));
+         insert_struct_hidden_paras(trecorddef(current_structdef));
          { restore symtable stack }
          symtablestack.pop(recst);
          if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then

compiler/scanner.pas

@@ -3833,14 +3833,14 @@ type
         valuedescr: String;
       begin
         if assigned(preprocstack) and
-           (preprocstack.typ in [pp_if,pp_elseif]) then
+           (preprocstack.typ in [pp_if,pp_ifdef,pp_ifndef,pp_elseif]) then
          begin
            { when the branch is accepted we use pp_elseif so we know that
              all the next branches need to be rejected. when this branch is still
              not accepted then leave it at pp_if }
            if (preprocstack.typ=pp_elseif) then
              preprocstack.accept:=false
-           else if (preprocstack.typ=pp_if) and preprocstack.accept then
+           else if (preprocstack.typ in [pp_if,pp_ifdef,pp_ifndef]) and preprocstack.accept then
                begin
                  preprocstack.accept:=false;
                  preprocstack.typ:=pp_elseif;

compiler/sparcgen/sppara.pas

@@ -85,6 +85,8 @@ implementation
             else
               internalerror(2019021927);
           end;
+        { Create Function result paraloc }
+        create_funcretloc_info(p,side);
         result:=cur_stack_offset;
       end;
 

compiler/symcreat.pas

@@ -352,7 +352,7 @@ implementation
             end;
           { if we get here, we did not find it in the current objectdef ->
             add }
-          childpd:=tprocdef(parentpd.getcopy);
+          childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
           { get rid of the import name for inherited virtual class methods,
             it has to be regenerated rather than amended }
           if [po_classmethod,po_virtualmethod]<=childpd.procoptions then

compiler/symdef.pas

@@ -590,6 +590,8 @@ interface
          pno_mangledname, pno_noparams);
        tprocnameoptions = set of tprocnameoption;
        tproccopytyp = (pc_normal,
+                       { everything except for hidden parameters }
+                       pc_normal_no_hidden,
                        { always creates a top-level function, removes all
                          special parameters (self, vmt, parentfp, ...) }
                        pc_bareproc,
@@ -5197,7 +5199,7 @@ implementation
                   pvs:=tparavarsym(parast.symlist[j]);
                   { in case of bare proc, don't copy self, vmt or framepointer
                     parameters }
-                  if (copytyp=pc_bareproc) and
+                  if (copytyp in [pc_bareproc,pc_normal_no_hidden]) and
                      (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result,vo_is_funcret]*pvs.varoptions)<>[]) then
                     continue;
                   if paraprefix='' then
@@ -6144,7 +6146,7 @@ implementation
         { don't create aliases for bare copies, nor copy the funcretsym as
           the function result parameter will be inserted again if necessary
           (e.g. if the calling convention is changed) }
-        if copytyp<>pc_bareproc then
+        if not(copytyp in [pc_bareproc,pc_normal_no_hidden]) then
           begin
             tprocdef(result).aliasnames.concatListcopy(aliasnames);
             if assigned(funcretsym) then

compiler/systems.pas

@@ -355,7 +355,8 @@ interface
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
                                    system_m68k_atari,system_m68k_palmos,
-                                   system_i386_haiku,system_x86_64_haiku
+                                   system_i386_haiku,system_x86_64_haiku,
+                                   system_x86_64_openbsd
                                   ]+systems_darwin+systems_amigalike;
 
        { all systems that use garbage collection for reference-counted types }

compiler/systems/i_bsd.pas

@@ -338,7 +338,7 @@ unit i_bsd;
             system       : system_i386_OpenBSD;
             name         : 'OpenBSD for i386';
             shortname    : 'OpenBSD';
-            flags        : [tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_sections,tf_has_winlike_resources];
+            flags        : [tf_pic_default,tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_sections,tf_has_winlike_resources];
             cpu          : cpu_i386;
             unit_env     : 'BSDUNITS';
             extradefines : 'UNIX;BSD;HASUNIX';

compiler/systems/t_bsd.pas

@@ -60,6 +60,9 @@ implementation
     private
       LdSupportsNoResponseFile : boolean;
       LibrarySuffix : Char;
+      prtobj : string[80];
+      ReOrder : Boolean;
+      linklibc : boolean;
       Function  WriteResponseFile(isdll:boolean) : Boolean;
       function GetDarwinCrt1ObjName(isdll: boolean): TCmdStr;
       Function GetDarwinPrtobjName(isdll: boolean): TCmdStr;
@@ -73,6 +76,27 @@ implementation
     end;
 
 
+function ModulesLinkToLibc:boolean;
+var
+  hp: tmodule;
+begin
+  { This is called very early, ImportLibraryList is not yet merged into linkothersharedlibs.
+    The former contains library names qualified with prefix and suffix (coming from
+    "external 'c' name 'foo' declarations), the latter contains raw names (from "$linklib c"
+    directives). }
+  hp:=tmodule(loaded_units.first);
+  while assigned(hp) do
+    begin
+      result:=Assigned(hp.ImportLibraryList.find(target_info.sharedClibprefix+'c'+target_info.sharedClibext));
+      if result then break;
+      result:=hp.linkothersharedlibs.find(target_info.sharedClibprefix+'c'+target_info.sharedClibext);
+      if result then break;
+      result:=hp.linkothersharedlibs.find('c');
+      if result then break;
+      hp:=tmodule(hp.next);
+    end;
+end;
+
 
 {*****************************************************************************
                              TIMPORTLIBDARWIN
@@ -126,11 +150,13 @@ Constructor TLinkerBSD.Create;
 begin
   Inherited Create;
   if not Dontlinkstdlibpath Then
-   if not(target_info.system in systems_darwin) then
-     LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true)
-   else
+   if target_info.system in systems_darwin then
      { Mac OS X doesn't have a /lib }
      LibrarySearchPath.AddPath(sysrootpath,'/usr/lib',true)
+   else if target_info.system in systems_openbsd then
+     LibrarySearchPath.AddPath(sysrootpath,'/usr/lib;${X11BASE}/lib;${LOCALBASE}/lib',true)
+   else
+     LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true);
 end;
 
 
@@ -228,11 +254,67 @@ End;
 
 
 procedure TLinkerBSD.InitSysInitUnitName;
+var
+  cprtobj,
+  gprtobj,
+  si_cprt,
+  si_gprt : string[80];
 begin
   if target_info.system in systems_darwin then
-    SysInitUnit:='sysinit'
+    begin
+      { for darwin: always link dynamically against libc }
+      linklibc := true;
+      reorder:=reorderentries;
+      prtobj:='';
+      SysInitUnit:='sysinit';
+    end
   else
-    inherited InitSysInitUnitName;
+    begin
+      linklibc:=ModulesLinkToLibc;
+      if current_module.islibrary and
+         (target_info.system in systems_bsd) then
+        begin
+          prtobj:='dllprt0';
+          cprtobj:='dllprt0';
+          gprtobj:='dllprt0';
+          SysInitUnit:='si_dll';
+          si_cprt:='si_dll';
+          si_gprt:='si_dll';
+        end
+      else
+        begin
+          prtobj:='prt0';
+          cprtobj:='cprt0';
+          gprtobj:='gprt0';
+          SysInitUnit:='si_prc';
+          si_cprt:='si_c';
+          si_gprt:='si_g';
+        end;
+      // this one is a bit complex.
+      // Only reorder for now if -XL or -XO params are given
+      // or when -Xf.
+      reorder:= linklibc and
+                (
+                  ReorderEntries
+                   or
+                  (cs_link_pthread in current_settings.globalswitches));
+      if cs_profile in current_settings.moduleswitches then
+       begin
+         prtobj:=gprtobj;
+         SysInitUnit:=si_gprt;
+         AddSharedLibrary('c');
+         LibrarySuffix:='p';
+         linklibc:=true;
+       end
+      else
+       begin
+         if linklibc then
+           begin
+             prtobj:=cprtobj;
+             SysInitUnit:=si_cprt;
+           end;
+       end;
+    end;
 end;
 
 
@@ -390,16 +472,11 @@ Var
   linkres      : TLinkRes;
   FilesList    : TLinkRes;
   i            : longint;
-  cprtobj,
-  gprtobj,
-  prtobj       : string[80];
   HPath        : TCmdStrListItem;
   s,s1,s2      : TCmdStr;
-  linkdynamic,
-  linklibc     : boolean;
+  linkdynamic  : boolean;
   Fl1,Fl2      : Boolean;
   IsDarwin     : Boolean;
-  ReOrder      : Boolean;
 
 begin
   WriteResponseFile:=False;
@@ -409,47 +486,11 @@ begin
 { set special options for some targets }
   if not IsDarwin Then
     begin
-      if isdll and
-         (target_info.system in systems_bsd) then
-        begin
-          prtobj:='dllprt0';
-          cprtobj:='dllprt0';
-          gprtobj:='dllprt0';
-        end
-      else
-        begin
-          prtobj:='prt0';
-          cprtobj:='cprt0';
-          gprtobj:='gprt0';
-        end;
       linkdynamic:=not(SharedLibFiles.empty);
-      linklibc:=(SharedLibFiles.Find('c')<>nil);
-      // this one is a bit complex.
-      // Only reorder for now if -XL or -XO params are given
-      // or when -Xf.
-      reorder:= linklibc and
-                (
-                  ReorderEntries
-                   or
-                  (cs_link_pthread in current_settings.globalswitches));
-      if cs_profile in current_settings.moduleswitches then
-       begin
-         prtobj:=gprtobj;
-         AddSharedLibrary('c');
-         LibrarySuffix:='p';
-         linklibc:=true;
-       end
-      else
-       begin
-         if linklibc then
-          prtobj:=cprtobj;
-       end;
       // after this point addition of shared libs not allowed.
     end
   else
     begin
-      { for darwin: always link dynamically against libc }
-      linklibc := true;
 {$ifdef MACOSX104ORHIGHER}
       { not sure what this is for, but gcc always links against it }
       if not(cs_profile in current_settings.moduleswitches) then
@@ -457,8 +498,6 @@ begin
       else
         AddSharedLibrary('SystemStubs_profile');
 {$endif MACOSX104ORHIGHER}
-      reorder:=reorderentries;
-      prtobj:='';
     end;
 
   if reorder Then
@@ -569,7 +608,7 @@ begin
   if not LdSupportsNoResponseFile then
     LinkRes.Add('INPUT(');
   { add objectfiles, start with prt0 always }
-  if prtobj<>'' then
+  if not (target_info.system in systems_internal_sysinit) and (prtobj<>'') then
    LinkRes.AddFileName(FindObjectFile(prtobj,'',false));
   { try to add crti and crtbegin if linking to C }
   if linklibc and
@@ -682,7 +721,8 @@ begin
      { when we have -static for the linker the we also need libgcc }
      if (cs_link_staticflag in current_settings.globalswitches) then
       LinkRes.Add('-lgcc');
-     if linkdynamic and (Info.DynamicLinker<>'') then
+     if linkdynamic and (Info.DynamicLinker<>'') and
+        not(target_info.system in systems_openbsd) then
       LinkRes.AddFileName(Info.DynamicLinker);
      if not LdSupportsNoResponseFile then
        LinkRes.Add(')');
@@ -786,7 +826,9 @@ begin
 
    if(not(target_info.system in systems_darwin) and
       (cs_profile in current_settings.moduleswitches)) or
-     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+     ((Info.DynamicLinker<>'') and
+      ((not SharedLibFiles.Empty) or
+       (target_info.system in systems_openbsd))) then
    DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
 
   if CShared Then
@@ -797,9 +839,9 @@ begin
      DynLinKStr:=DynLinkStr+' -dynamic'; // one dash!
    end;
 
-{ Use -nopie on OpenBSD }
+{ Use -nopie on OpenBSD if PIC support is turned off }
   if (target_info.system in systems_openbsd) and
-     (target_info.system <> system_x86_64_openbsd) then
+     not(cs_create_pic in current_settings.moduleswitches) then
     Info.ExtraOptions:=Info.ExtraOptions+' -nopie';
 
 { -N seems to be needed on NetBSD/earm }

compiler/utils/Makefile

@@ -2812,6 +2812,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

compiler/utils/msg2inc.pp

@@ -411,7 +411,7 @@ begin
   writeln(t,');');
   close(t);
 {update arraysize}
-  s:=l0(msgsize div maxslen); { we start with 0 }
+  s:=l0((msgsize-1) div maxslen); { we start with 0 }
   assign(f,fn);
   reset(f,1);
   seek(f,22+34+2*eollen+2*length(constname));

compiler/utils/ppuutils/ppudump.pp

@@ -1938,7 +1938,7 @@ type
   end;
   tprocopt=record
     mask : tprocoption;
-    str  : string[31];
+    str  : string[34];
   end;
 const
   {proccalloptionStr  is also in globtype unit }

compiler/utils/ppuutils/ppuout.pp

@@ -1210,7 +1210,7 @@ begin
   while FOutBufPos > 0 do begin
     len:=FileWrite(FOutFileHandle, FOutBuf[i], FOutBufPos);
     if len < 0 then
-      raise Exception.CreateFmt('Error writing to file: ', [SysErrorMessage(GetLastOSError)]);
+      raise Exception.CreateFmt('Error writing to file: %s', [ {$if declared(GetLastOSError) } SysErrorMessage(GetLastOSError) {$else} 'I/O error' {$endif} ]);
     Inc(i, len);
     Dec(FOutBufPos, len);
   end;

compiler/x86/aoptx86.pas

@@ -3484,44 +3484,44 @@ unit aoptx86;
                       MatchOpType(taicpu(hp1),top_const,top_reg) and
                       (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
                       begin
-                        taicpu(p).opcode := A_MOV;
+                        //taicpu(p).opcode := A_MOV;
                         case taicpu(p).opsize Of
                           S_BL:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var13',p);
-                              taicpu(p).changeopsize(S_L);
+                              taicpu(hp1).changeopsize(S_L);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff);
                             end;
                           S_WL:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var14',p);
-                              taicpu(p).changeopsize(S_L);
+                              taicpu(hp1).changeopsize(S_L);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ffff);
                             end;
                           S_BW:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var15',p);
-                              taicpu(p).changeopsize(S_W);
+                              taicpu(hp1).changeopsize(S_W);
                               taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff);
                             end;
 {$ifdef x86_64}
                           S_BQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var16',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(
                                 0, taicpu(hp1).oper[0]^.val and $ff);
                             end;
                           S_WQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var17',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(0, taicpu(hp1).oper[0]^.val and $ffff);
                             end;
                           S_LQ:
                             begin
                               DebugMsg(SPeepholeOptimization + 'var18',p);
-                              taicpu(p).changeopsize(S_Q);
+                              taicpu(hp1).changeopsize(S_Q);
                               taicpu(hp1).loadConst(
                                 0, taicpu(hp1).oper[0]^.val and $ffffffff);
                             end;

installer/Makefile

@@ -3774,6 +3774,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/Makefile

@@ -1573,6 +1573,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/a52/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/ami-extra/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/amunits/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/arosunits/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/aspell/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/bfd/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/bzip2/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/cairo/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/cdrom/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/cdrom/examples/Makefile

@@ -2762,6 +2762,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/chm/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/cocoaint/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/dblib/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/dbus/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/dbus/examples/Makefile

@@ -2762,6 +2762,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/dts/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fastcgi/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-async/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-base/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-base/examples/Makefile

@@ -3802,6 +3802,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-base/src/base64.pp

@@ -425,6 +425,8 @@ var
   Outstream : TStringStream;
   Decoder   : TBase64DecodingStream;
 begin
+  if Length(s)=0 then
+    Exit('');
   SD:=S;
   while Length(Sd) mod 4 > 0 do 
     SD := SD + '=';

packages/fcl-db/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/examples/sqlshell.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="sqlshell"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="sqlshell.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="sqlshell"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/sqlshell.pas

@@ -0,0 +1,296 @@
+{$mode objfpc}
+{$h+}
+uses
+  custapp, sysutils, strutils, classes, db, sqldb, bufdataset, XMLDatapacketReader,
+  sqlite3conn, pqconnection, ibconnection, mssqlconn, oracleconnection,mysql55conn,mysql40conn,mysql51conn,mysql50conn;
+
+Const
+  CmdSep = [' ',#9,#10,#13,#12];
+
+type
+
+  { TSQLShellApplication }
+
+  TSQLShellApplication = class(TCustomApplication)
+  Private
+    FConn : TSQLConnection;
+    FTR : TSQLTransaction;
+    FQuery : TSQLQuery;
+    FConnType : String;
+    FCharset : String;
+    FDatabaseName: String;
+    FHostName : string;
+    FUserName : String;
+    FPassword : String;
+    FPort : INteger;
+    FAutoCommit : Boolean;
+    procedure ConnectToDatabase;
+    procedure DisconnectFromDatabase;
+    procedure ExecuteCommand(const ASQL: UTF8String);
+    procedure ExecuteSystemCommand(const S : UTF8String);
+    procedure MaybeCommit;
+    procedure MaybeRollBack;
+    function ParseArgs: Boolean;
+    procedure RunCommandLoop;
+    procedure SaveLast(FN: String);
+    procedure Usage(const Err: String);
+    procedure WriteHelp;
+  Protected
+    procedure DoRun; override;
+    Property Conn : TSQLConnection Read FConn;
+    Property AutoCommit : Boolean Read FAutoCommit;
+  end;
+
+
+Procedure TSQLShellApplication.ConnectToDatabase;
+
+begin
+  FConn:=TSQLConnector.Create(Self);
+  TSQLConnector(FConn).ConnectorType:=FConnType;
+  FTR:=TSQLTransaction.Create(Self);
+  Conn.Transaction:=FTR;
+  Conn.DatabaseName:=FDatabaseName;
+  Conn.HostName:=FHostName;
+  Conn.UserName:=FUserName;
+  Conn.Password:=FPassword;
+  Conn.Connected:=True;
+  if FCharset<>'' then
+    Conn.CharSet:=FCharset;
+end;
+
+
+Procedure TSQLShellApplication.DisconnectFromDatabase;
+
+begin
+  FreeAndNil(FTr);
+  FreeAndNil(FConn);
+end;
+
+Procedure TSQLShellApplication.ExecuteCommand(Const ASQL : UTF8String);
+
+Var
+  Q : TSQLQuery;
+  F : TField;
+  
+begin
+  FreeAndNil(FQuery);
+  Q:=TSQLQuery.Create(Conn);
+  Q.Database:=Conn;
+  Q.Transaction:=FTr;
+  if not FTR.Active then
+    FTR.StartTransaction;
+  Q.SQL.Text:=aSQL;
+  Q.Prepare;
+  if Q.StatementType<>stSelect then
+    begin
+    Q.ExecSQL;
+    Writeln('Rows affected : ',Q.RowsAffected);
+    if AutoCommit then
+      (Q.Transaction as TSQLTransaction).Commit;
+    Q.Free;
+    end
+  else
+    begin
+    Q.Open;
+    Write('|');
+    For F in Q.Fields do
+      Write(' ',F.FieldName,' |');
+    Writeln;
+    While not Q.EOF do
+      begin
+      Write('|');
+      For F in Q.Fields do
+        Write(F.AsString,' |');
+      Writeln;
+      Q.Next;
+      end;
+    FQuery:=Q;
+    end;
+end;
+
+Procedure TSQLShellApplication.SaveLast(FN : String);
+
+begin
+  FN:=Trim(FN);
+  if FN='' then
+    begin
+    Write('Type filename to save data: ');
+    Readln(fn);
+    end;
+  if (FN<>'') then
+    FQuery.SaveToFile(FN,dfXML);
+end;
+
+Procedure TSQLShellApplication.MaybeCommit;
+begin
+  if FTR.Active then
+    FTR.Commit;
+end;
+
+Procedure TSQLShellApplication.MaybeRollBack;
+begin
+  if FTR.Active then
+    FTR.Commit;
+end;
+
+Procedure TSQLShellApplication.ExecuteSystemCommand(Const S : UTF8String);
+
+Var
+  Cmd,Args : String;
+
+begin
+  Cmd:=ExtractWord(1,S,CmdSep);
+  Args:=S;
+  Delete(Args,1,Length(Cmd)+Pos(Cmd,Args)-1);
+  While (Length(Args)>0) and (Args[1] in CmdSep) do
+    Delete(Args,1,1);
+  case Cmd of
+   'a','autocommit' :
+      FAutoCommit:=Not FAutoCommit;
+   'q','quit' :
+      begin
+      MaybeCommit;
+      Terminate;
+      end;
+   'x','exit' :
+      begin
+      MaybeRollBack;
+      Terminate;
+      end;
+   'c','commit' :
+      MaybeCommit;
+   'r','collback':
+      MaybeRollBack;
+   's',
+   'save' : SaveLast(Args);
+   '?','h','help' : WriteHelp;
+  end;
+end;
+
+Procedure TSQLShellApplication.WriteHelp;
+
+begin
+  Writeln('Commands : ');
+  Writeln('\a \autocommit  Toggle autocommit (Current autocommit :',FAutoCommit,')');
+  Writeln('\c \commit      commit');
+  Writeln('\h \help        this help');
+  Writeln('\q \quit        commit and quit');
+  Writeln('\r \rollback    commit');
+  Writeln('\x \exit        RollBack and quit');
+  Writeln('\s \save [FN]   Save result of last select to XML file');
+end;
+
+Procedure TSQLShellApplication.RunCommandLoop;
+
+Var
+  S : UTF8String;
+
+begin
+  Writeln('Enter commands, end with \q. \?, \h or \help for help.');
+  Repeat
+    Write('SQL > ');
+    Readln(S);
+    try
+      While (Length(S)>0) and (S[1] in CmdSep) do
+        Delete(S,1,1);
+      if Copy(S,1,1)='\' then
+        begin
+        Delete(S,1,1);
+        ExecuteSystemCommand(S)
+        end
+      else
+        ExecuteCommand(S)
+    except
+      On E : Exception do
+        Writeln(Format('Error %s executing command : %s',[E.ClassName,E.Message]));
+    end;
+  until Terminated;
+  Terminate;
+end;
+
+Procedure  TSQLShellApplication.Usage(Const Err : String);
+
+Var
+  L : TStrings;
+  S : String;
+
+begin
+  if (Err<>'') then
+    Writeln('Error : ',Err);
+  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help           This help text.');
+  Writeln('-t --type=TYPE      Set connection type.');
+  Writeln('-d --database=DB    Set database name.');
+  Writeln('-H --hostname=DB    Set database hostname.');
+  Writeln('-u --username=NAME  Set database user name.');
+  Writeln('-p --password=PWD   Set database user password.');
+  Writeln('-c --charset=SET    Set database character set.');
+  Writeln('-P --port=N         Set database connection port.');
+  Writeln('Known connection types for this binary:');
+  L:=TStringList.Create;
+  try
+    GetConnectionList(L);
+    for S in L do
+      Writeln('  ',S);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TSQLShellApplication.ParseArgs : Boolean;
+
+Var
+  S : String;
+
+begin
+  Result:=False;
+  S:=CheckOptions('hH:d:t:u:p:c:P:',['help','hostname:','database:','type:','username:','password:','c:charset','port']);
+  if (S<>'') or (HasOption('h','help')) then
+    begin
+    Usage(S);
+    exit;
+    end;
+  FConnType:=GetOptionValue('t','type');
+  FHostName:=GetOptionValue('H','hostname');
+  FDatabaseName:=GetOptionValue('d','database');
+  FUserName:=GetOptionValue('u','user');
+  FPassword:=GetOptionValue('p','password');
+  FCharset:=GetOptionValue('c','charset');
+  if HasOption('P','port') then
+    begin
+    FPort:=StrToIntDef(GetOptionValue('P','port'),-1);
+    if FPort=-1 then
+      Usage('Databasename not supplied');
+    exit;
+    end;
+  Result:=(FDatabaseName<>'');
+  if not Result then
+    Usage('Databasename not supplied');
+end;
+
+Procedure TSQLShellApplication.DoRun;
+
+begin
+  StopOnException:=True;
+  if Not ParseArgs then
+    begin
+    terminate;
+    exit;
+    end;
+  ConnectToDatabase;
+  RunCommandLoop;
+  DisconnectFromDatabase;
+end;
+
+begin
+  With TSQLShellApplication.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+end.
+
+

packages/fcl-db/src/base/Makefile

@@ -3713,6 +3713,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -133,7 +133,7 @@ procedure TXMLDatapacketReader.LoadFieldDefs(var AnAutoIncValue: integer);
     else result := '';
   end;
 
-var i           : integer;
+var i,s           : integer;
     AFieldDef   : TFieldDef;
     iFieldType  : TFieldType;
     FTString    : string;
@@ -160,7 +160,11 @@ begin
       AFieldDef := Dataset.FieldDefs.AddFieldDef;
       AFieldDef.DisplayName:=GetNodeAttribute(AFieldNode,'fieldname');
       AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
-      AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
+      // Difference in casing between CDS and bufdataset...
+      S:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),-1);
+      if (S=-1) then
+        S:=StrToIntDef(GetNodeAttribute(AFieldNode,'WIDTH'),0);
+      AFieldDef.Size:=s;
       FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
       SubFTString:=GetNodeAttribute(AFieldNode,'subtype');
       if SubFTString<>'' then

packages/fcl-db/src/codegen/Makefile

@@ -3306,6 +3306,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/datadict/Makefile

@@ -3888,6 +3888,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/dbase/Makefile

@@ -3886,6 +3886,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/export/Makefile

@@ -3436,6 +3436,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/json/Makefile

@@ -2884,6 +2884,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/memds/Makefile

@@ -3326,6 +3326,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/paradox/Makefile

@@ -3160,6 +3160,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sdf/Makefile

@@ -3050,6 +3050,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sql/Makefile

@@ -3582,6 +3582,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/Makefile

@@ -3948,6 +3948,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/interbase/Makefile

@@ -3160,6 +3160,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/mssql/Makefile

@@ -3030,6 +3030,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/mysql/Makefile

@@ -3436,6 +3436,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/odbc/Makefile

@@ -3160,6 +3160,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/oracle/Makefile

@@ -3436,6 +3436,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/postgres/Makefile

@@ -3436,6 +3436,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqldb/sqlite/Makefile

@@ -3160,6 +3160,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/src/sqlite/Makefile

@@ -2884,6 +2884,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-db/tests/Makefile

@@ -3180,6 +3180,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-extra/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-extra/examples/Makefile

@@ -2727,6 +2727,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-fpcunit/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-fpcunit/src/exampletests/Makefile

@@ -3290,6 +3290,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-fpcunit/src/tests/Makefile

@@ -3290,6 +3290,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-image/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-image/examples/Makefile

@@ -2762,6 +2762,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-image/src/clipping.pp

@@ -87,7 +87,7 @@ begin
       y1 := top;
     if ( y2 > bottom ) then // bottom side needs to be clipped
       y2 := bottom;
-    if (x1 > x2) or (y1 < y2) then
+    if (x1 > x2) or (y1 > y2) then
       ClearRect;
     end;
 end;

packages/fcl-image/src/ellipses.pp

@@ -19,11 +19,11 @@ interface
 
 uses classes, FPImage, FPCanvas;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
@@ -317,7 +317,7 @@ end;
 { The drawing routines }
 
 type
-  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
   TLinePoints = array[0..PatternBitCount-1] of boolean;
   PLinePoints = ^TLinePoints;
 
@@ -334,31 +334,31 @@ begin
   LinePoints^[0] := (APattern and i) <> 0;
 end;
 
-procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     DrawPixel(x,y,color);
 end;
 
-procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] xor color;
 end;
 
-procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] or color;
 end;
 
-procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] and color;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     MyPutPix : TPutPixelProc;
@@ -387,7 +387,7 @@ begin
     end;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
 var infoOut, infoIn : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -430,7 +430,7 @@ begin
     end;
 end;
 
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
 var info : TEllipseInfo;
     xx, y : integer;
     LinePoints : TLinePoints;
@@ -496,7 +496,7 @@ begin
     end;
 end;
 
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -514,7 +514,7 @@ begin
   end;
 end;
 
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 begin
 end;
 

packages/fcl-image/src/fpcolcnv.inc

@@ -296,7 +296,7 @@ begin
 end;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 var
   factor1, factor2: single;
 begin

packages/fcl-image/src/fpimage.pp

@@ -286,7 +286,7 @@ function ConvertColor (const From : TFPColor; Fmt : TColorFormat) : TDeviceColor
 function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 
 function FPColor (r,g,b,a:word) : TFPColor;
 function FPColor (r,g,b:word) : TFPColor;
@@ -561,7 +561,7 @@ FuzzyDepth: word = 4): TFPCustomImage;
 { HTML Color support. RRGGBB or color name. Only W3 color names s are supported}
 
 function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 function HtmlToFPColor(const S: String): TFPColor;
 
 
@@ -613,12 +613,12 @@ begin
             (c.Alpha = d.Alpha);
 end;
 
-function GetFullColorData (color:TFPColor) : TColorData;
+function GetFullColorData (const color:TFPColor) : TColorData;
 begin
   result := PColorData(@color)^;
 end;
 
-function SetFullColorData (color:TColorData) : TFPColor;
+function SetFullColorData (const color:TColorData) : TFPColor;
 begin
   result := PFPColor (@color)^;
 end;
@@ -760,7 +760,7 @@ begin
   end;
 end;
 
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 begin
   if not TryHtmlToFPColor(S, Result) then
     Result := Def;

packages/fcl-image/src/fpwritexpm.pp

@@ -28,7 +28,7 @@ type
       FColorShift : word;
       FColorSize : byte;
       procedure SetColorSize (AValue : byte);
-      function ColorToHex (c:TFPColor) : string;
+      function ColorToHex (const c:TFPColor) : string;
     protected
       procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
     public
@@ -61,7 +61,7 @@ begin
     FColorSize := AValue;
 end;
 
-function TFPWriterXPM.ColorToHex (c:TFPColor) : string;
+function TFPWriterXPM.ColorToHex (const c:TFPColor) : string;
 var r,g,b : word;
 begin
   with c do

packages/fcl-image/src/ftfont.pp

@@ -349,7 +349,7 @@ const
 
 procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer);
 
-  procedure Combine (canv:TFPCustomCanvas; x,y:integer; c : TFPColor; t:longword);
+  procedure Combine (canv:TFPCustomCanvas; x,y:integer; const c : TFPColor; t:longword);
   var
     pixelcolor: TFPColor;
   begin

packages/fcl-js/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-json/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-json/tests/testjson.lpi

@@ -1,26 +1,25 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <ProjectOptions>
-    <Version Value="11"/>
+  <ProjectOptions BuildModesCount="1">
+    <Version Value="12"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
     </General>
-    <BuildModes Count="1">
+    <BuildModes>
       <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
     </PublishOptions>
     <RunParams>
-      <local>
-        <CommandLineParams Value="--suite=TTestJSONString.TestJSONStringToString"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
-      </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">

packages/fcl-net/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-net/examples/Makefile

@@ -3583,6 +3583,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-passrc/Makefile

@@ -2359,6 +2359,7 @@ ifdef CLEAN_FILES
 	-$(DEL) $(CLEAN_FILES)
 endif
 	-$(DELTREE) units
+	-$(DELTREE) bin
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 ifneq ($(PPUEXT),.ppu)
 	-$(DEL) *.o *.ppu *.a

packages/fcl-passrc/src/pasresolveeval.pas

@@ -181,12 +181,14 @@ const
   nDerivedXMustExtendASubClassY = 3115;
   nDefaultPropertyNotAllowedInHelperForX = 3116;
   nHelpersCannotBeUsedAsTypes = 3117;
-  // free 3118
+  nMessageHandlersInvalidParams = 3118;
   nImplictConversionUnicodeToAnsi = 3119;
   nWrongTypeXInArrayConstructor = 3120;
   nUnknownCustomAttributeX = 3121;
   nAttributeIgnoredBecauseAbstractX = 3122;
   nCreatingAnInstanceOfAbstractClassY = 3123;
+  nIllegalExpressionAfterX = 3124;
+  nMethodHidesNonVirtualMethodExactly = 3125;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -315,12 +317,14 @@ resourcestring
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
   sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
-  // was 3118
+  sMessageHandlersInvalidParams = 'Message handlers can take only one call by ref. parameter';
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
   sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
   sAttributeIgnoredBecauseAbstractX = 'attribute ignored because abstract %s';
   sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
+  sIllegalExpressionAfterX = 'illegal expression after %s';
+  sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -1234,7 +1234,7 @@ type
     SubType: TResolverBaseType; // for btSet, btArrayLit, btArrayOrSet, btRange
     IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
     LoTypeEl: TPasType; // can be nil for const expression, all alias resolved
-    HiTypeEl: TPasType; // same as BaseTypeEl, except alias types are not resolved
+    HiTypeEl: TPasType; // same as LoTypeEl, except alias types are not resolved
     ExprEl: TPasExpr;
     Flags: TPasResolverResultFlags;
   end;
@@ -1438,7 +1438,7 @@ type
     procedure OnFindFirst(El: TPasElement; ElScope, StartScope: TPasScope;
       FindFirstElementData: Pointer; var Abort: boolean); virtual;
     procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
-      FindProcsData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
+      FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
     procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
       FindProcData: Pointer; var Abort: boolean); virtual;
     function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
@@ -2024,7 +2024,7 @@ type
     function GetFunctionType(El: TPasElement): TPasFunctionType;
     function MethodIsStatic(El: TPasProcedure): boolean;
     function IsMethod(El: TPasProcedure): boolean;
-    function IsHelperMethod(El: TPasElement): boolean;
+    function IsHelperMethod(El: TPasElement): boolean; virtual;
     function IsHelper(El: TPasElement): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
@@ -4373,9 +4373,9 @@ begin
 end;
 
 procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
-  StartScope: TPasScope; FindProcsData: Pointer; var Abort: boolean);
+  StartScope: TPasScope; FindCallElData: Pointer; var Abort: boolean);
 var
-  Data: PFindCallElData absolute FindProcsData;
+  Data: PFindCallElData absolute FindCallElData;
   Proc, PrevProc: TPasProcedure;
   Distance: integer;
   BuiltInProc: TResElDataBuiltInProc;
@@ -4680,7 +4680,7 @@ var
   end;
 
 begin
-  //writeln('TPasResolver.OnFindProcSameSignature START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
+  //writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
   if not (El is TPasProcedure) then
     begin
     // identifier is not a proc
@@ -4711,8 +4711,13 @@ begin
           begin
           // give a hint
           if Data^.Proc.Parent is TPasMembersType then
-            LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
-              [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+            begin
+            if El.Visibility=visStrictPrivate then
+            else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
+            else
+              LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
+                [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
+            end;
           end;
       fpkMethod:
         // method hides a non proc
@@ -4732,7 +4737,7 @@ begin
     end;
 
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.OnFindProcSameSignature ',GetTreeDbg(El,2));
+  writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
   {$ENDIF}
   Store:=CheckOverloadProcCompatibility(Data^.Proc,Proc);
   if Data^.Kind=fpkSameSignature then
@@ -4803,7 +4808,11 @@ begin
             if (Data^.Proc.Parent is TPasMembersType) then
               begin
               ProcScope:=Proc.CustomData as TPasProcedureScope;
-              if (ProcScope.ImplProc<>nil)  // not abstract, external
+              if (Proc.Visibility=visStrictPrivate)
+                  or ((Proc.Visibility=visPrivate)
+                    and (Proc.GetModule<>Data^.Proc.GetModule)) then
+                // a private private is hidden by definition -> no hint
+              else if (ProcScope.ImplProc<>nil)  // not abstract, external
                   and (not ProcHasImplElements(ProcScope.ImplProc)) then
                 // hidden method has implementation, but no statements -> useless
                 // -> do not give a hint for hiding this useless method
@@ -4811,10 +4820,20 @@ begin
               else if (Proc is TPasConstructor)
                   and (Data^.Proc.ClassType=Proc.ClassType) then
                 // do not give a hint for hiding a constructor
+              else if Store then
+                begin
+                // method hides ancestor method with same signature
+                LogMsg(20190316152656,mtHint,
+                  nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
+                  [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+                end
               else
+                begin
+                //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
                 LogMsg(20171118214523,mtHint,
                   nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
                   [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+                end;
               end;
             end;
           Abort:=true;
@@ -5846,6 +5865,9 @@ var
   ptm: TProcTypeModifier;
   ObjKind: TPasObjKind;
   ParentBody: TProcedureBody;
+  HelperForType: TPasType;
+  Args: TFPList;
+  Arg: TPasArgument;
 begin
   if El.Parent is TPasProcedure then
     Proc:=TPasProcedure(El.Parent)
@@ -5940,19 +5962,28 @@ begin
         {if msDelphi in CurrentParser.CurrentModeswitches then
           begin
           // Delphi allows virtual/override in class helpers
-          // But this works differently to normal virtual/override and
-          // requires helpers to be TInterfacedObject
+          // But using them crashes in Delphi 10.3
+          // -> do not support them
           end
         }
         if Proc.IsVirtual then
           RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
         if Proc.IsOverride then
           RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
-        if (ObjKind<>okClassHelper) and IsClassMethod(Proc) and not IsClassConDestructor then
+        HelperForType:=ResolveAliasType(TPasClassType(Proc.Parent).HelperForType);
+        if (not Proc.IsStatic) and IsClassMethod(Proc) and not IsClassConDestructor then
           begin
-          if not Proc.IsStatic then
+          // non static class methods require a class
+          if (not (HelperForType.ClassType=TPasClassType))
+              or (TPasClassType(HelperForType).ObjKind<>okClass) then
             RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
           end;
+        if Proc.ClassType=TPasDestructor then
+          RaiseMsg(20190302151019,nXIsNotSupported,sXIsNotSupported,['destructor'],Proc);
+        if (Proc.ClassType=TPasConstructor)
+            and (HelperForType.ClassType=TPasClassType)
+            and (TPasClassType(HelperForType).ObjKind<>okClass) then
+          RaiseMsg(20190302151514,nXIsNotSupported,sXIsNotSupported,['constructor'],Proc);
         end;
       end;
       if Proc.IsAbstract then
@@ -6036,10 +6067,28 @@ begin
     if El is TPasFunctionType then
       EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
 
+    if Proc.PublicName<>nil then
+      ResolveExpr(Proc.PublicName,rraRead);
     if Proc.LibraryExpr<>nil then
       ResolveExpr(Proc.LibraryExpr,rraRead);
     if Proc.LibrarySymbolName<>nil then
       ResolveExpr(Proc.LibrarySymbolName,rraRead);
+    if Proc.DispIDExpr<>nil then
+      ResolveExpr(Proc.DispIDExpr,rraRead);
+    if Proc.MessageExpr<>nil then
+      begin
+      // message modifier
+      ResolveExpr(Proc.MessageExpr,rraRead);
+      Args:=Proc.ProcType.Args;
+      if Args.Count<>1 then
+        RaiseMsg(20190303223701,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
+      Arg:=TPasArgument(Args[0]);
+      if not (Arg.Access in [argVar,argOut]) then
+        RaiseMsg(20190303223834,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
+      if (Proc.ClassType<>TPasProcedure)
+          and (Proc.ClassType<>TPasFunction) then
+        RaiseMsg(20190303224128,nXExpectedButYFound,sXExpectedButYFound,['procedure name(var Msg);message id;',GetElementTypeName(El)],El);
+      end;
 
     if Proc.Parent is TPasMembersType then
       begin
@@ -6345,7 +6394,8 @@ begin
         SelfType:=TPasClassType(SelfType).HelperForType;
         end;
       LoSelfType:=ResolveAliasType(SelfType);
-      if LoSelfType is TPasClassType then
+      if (LoSelfType is TPasClassType)
+          and (TPasClassType(LoSelfType).ObjKind=okClass) then
         SelfArg.Access:=argConst
       else
         SelfArg.Access:=argVar;
@@ -7234,7 +7284,7 @@ begin
       else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
           and (HelperForType.CustomData is TResElDataBaseType)) then
       else if (HelperForType.ClassType=TPasClassType)
-          and (TPasClassType(HelperForType).ObjKind=okClass) then
+          and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
         begin
         if TPasClassType(HelperForType).IsForward then
           RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
@@ -9646,7 +9696,8 @@ begin
   if DeclEl is TPasProcedure then
     begin
     Proc:=TPasProcedure(DeclEl);
-    if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
+    if (Access=rraAssign)
+        and (Proc.ProcType is TPasFunctionType)
         and (Params.Parent.ClassType=TPasImplAssign)
         and (TPasImplAssign(Params.Parent).left=Params) then
       begin
@@ -9662,6 +9713,7 @@ begin
         end;
       end;
     end;
+
   ComputeElement(NameExpr,ResolvedEl,[rcSetReferenceFlags]);
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.ResolveArrayParamsExprName NameExp=',GetObjName(NameExpr),' ',GetResolverResultDbg(ResolvedEl));
@@ -9672,11 +9724,33 @@ end;
 procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
   const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
 
+  procedure ReadAccessParamValue;
+  var
+    Left: TPasExpr;
+    Ref: TResolvedReference;
+  begin
+    if Access=rraAssign then
+      begin
+      // ArrayStringPointer[]:=
+      // -> writing the element needs reading the value
+      Left:=Params.Value;
+      if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode=eopSubIdent) then
+        Left:=TBinaryExpr(Left).right;
+      if Left.CustomData is TResolvedReference then
+        begin
+        Ref:=TResolvedReference(Left.CustomData);
+        if Ref.Access=rraAssign then
+          Ref.Access:=rraReadAndAssign;
+        end;
+      end;
+  end;
+
   function CheckStringOrPointerIndex(IsStringIndex: boolean): boolean;
   var
     ArgExp: TPasExpr;
     ResolvedArg: TPasResolverResult;
   begin
+    ReadAccessParamValue;
     if not IsStringIndex then
       begin
       // pointer
@@ -9745,6 +9819,7 @@ begin
       if ResolvedValue.IdentEl is TPasType then
         RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
           ['[',ResolvedValue.IdentEl.ElementTypeName],Params);
+      ReadAccessParamValue;
       CheckCallArrayCompatibility(TPasArrayType(TypeEl),Params,true,true);
       for i:=0 to length(Params.Params)-1 do
         AccessExpr(Params.Params[i],rraRead);
@@ -10054,9 +10129,10 @@ begin
     pekArrayParams:
       begin
       ComputeElement(Params.Value,ValueResolved,[]);
-      if IsDynArray(ValueResolved.LoTypeEl,false) then
-        // an element of a dynamic array is independent of the array variable
-        // an element of an open array depends on the argument
+      if IsDynArray(ValueResolved.LoTypeEl,false)
+          or (ValueResolved.BaseType=btPointer) then
+        // when accessing an element of a dynamic array the array is read
+        AccessExpr(Params.Value,rraRead)
       else
         AccessExpr(Params.Value,Access);
       // Note: an element of an open or static array or a string is connected to the variable
@@ -20167,18 +20243,25 @@ begin
         end;
       exit;
       end;
+    if (Param.ArgType=nil) then
+      exit(cExact); // untyped argument
     if (ParamResolved.BaseType=ExprResolved.BaseType) then
       begin
       if msDelphi in CurrentParser.CurrentModeswitches then
         begin
+        // Delphi allows passing alias, but not type alias to a var arg
         if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
           exit(cExact);
         end
       else if IsSameType(ParamResolved.LoTypeEl,ExprResolved.LoTypeEl,prraNone) then
-        exit(cExact);
+        begin
+        // ObjFPC allows passing type alias to a var arg, but simple alias wins
+        if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
+          exit(cExact)
+        else
+          exit(cAliasExact);
+        end;
       end;
-    if (Param.ArgType=nil) then
-      exit(cExact); // untyped argument
     if RaiseOnError then
       RaiseIncompatibleTypeRes(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
         [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,
@@ -22106,6 +22189,8 @@ begin
     exit(TPasArgument(IdentEl).ArgType<>nil)
   else if IdentEl.ClassType=TPasResultElement then
     exit(TPasResultElement(IdentEl).ResultType<>nil)
+  else if IdentEl is TPasType then
+    Result:=true
   else
     Result:=false;
 end;

packages/fcl-passrc/src/pastree.pp

@@ -1054,6 +1054,7 @@ type
     LibrarySymbolName,
     LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     DispIDExpr :  TPasExpr;
+    MessageExpr: TPasExpr;
     AliasName : String;
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
@@ -3398,6 +3399,7 @@ begin
   ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
   ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
+  ReleaseAndNil(TPasElement(MessageExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.MessageExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
   ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   inherited Destroy;
@@ -4472,6 +4474,7 @@ begin
   ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
   ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
+  ForEachChildCall(aMethodCall,Arg,MessageExpr,false);
   ForEachChildCall(aMethodCall,Arg,Body,false);
 end;
 

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1037,9 +1037,10 @@ begin
   repeat
     El:=El.Parent;
     if not (El is TPasType) then break;
-    MarkElementAsUsed(El);
-    if El is TPasMembersType then
-      UseClassConstructor(TPasMembersType(El));
+    UseType(TPasType(El),paumElement);
+    //MarkElementAsUsed(El);
+    //if El is TPasMembersType then
+    //  UseClassConstructor(TPasMembersType(El));
   until false;
 end;
 
@@ -2005,6 +2006,9 @@ begin
     else
       begin
       if ElementVisited(El,Mode) then exit;
+      // this class has been used (e.g. paumElement), which marked ancestors
+      // and published members
+      // -> now mark all members paumAllPasUsable
       FirstTime:=false;
       end;
     end;
@@ -2031,8 +2035,6 @@ begin
       end;
 
     ClassScope:=aClass.CustomData as TPasClassScope;
-    if ClassScope=nil then
-      exit; // ClassScope can be nil if msIgnoreInterfaces
 
     if FirstTime then
       begin
@@ -2115,6 +2117,11 @@ begin
         end;
         //writeln('TPasAnalyzer.UseClassType ',El.FullName,' ',Mode,' ',Member.Name);
         end;
+      if Proc.MessageExpr<>nil then
+        begin
+        UseProcedure(Proc);
+        continue;
+        end;
       end
     else if Member.ClassType=TPasAttributes then
       continue; // attributes are never used directly

packages/fcl-passrc/src/pparser.pp

@@ -4866,21 +4866,24 @@ begin
     end;
   pmMessage:
     begin
-    Repeat
-      NextToken;
-      If CurToken<>tkSemicolon then
-        begin
-        if Parent is TPasProcedure then
-          TPasProcedure(Parent).MessageName:=CurtokenString;
-        If (CurToken=tkString) and (Parent is TPasProcedure) then
-          TPasProcedure(Parent).Messagetype:=pmtString;
-        end;
-    until CurToken = tkSemicolon;
-    UngetToken;
+    NextToken;
+    E:=DoParseExpression(Parent);
+    TPasProcedure(Parent).MessageExpr:=E;
+    if E is TPrimitiveExpr then
+      begin
+      TPasProcedure(Parent).MessageName:=TPrimitiveExpr(E).Value;
+      case E.Kind of
+      pekNumber, pekUnary: TPasProcedure(Parent).Messagetype:=pmtInteger;
+      pekString: TPasProcedure(Parent).Messagetype:=pmtString;
+      end;
+      end;
+    if CurToken = tkSemicolon then
+      UngetToken;
     end;
   pmDispID:
     begin
-    TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent,Nil);
+    NextToken;
+    TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent);
     if CurToken = tkSemicolon then
       UngetToken;
     end;

packages/fcl-passrc/src/pscanner.pp

@@ -78,6 +78,8 @@ const
   nIllegalStateForWarnDirective = 1027;
   nErrIncludeLimitReached = 1028;
   nMisplacedGlobalCompilerSwitch = 1029;
+  nLogMacroXSetToY = 1030;
+  nInvalidDispatchFieldName = 1031;
 
 // resourcestring patterns of messages
 resourcestring
@@ -112,6 +114,8 @@ resourcestring
   SIllegalStateForWarnDirective = 'Illegal state "%s" for $WARN directive';
   SErrIncludeLimitReached = 'Include file limit reached';
   SMisplacedGlobalCompilerSwitch = 'Misplaced global compiler switch, ignored';
+  SLogMacroXSetToY = 'Macro %s set to %s';
+  SInvalidDispatchFieldName = 'Invalid Dispatch field name';
 
 type
   TMessageType = (
@@ -376,13 +380,19 @@ const
 
 type
   TValueSwitch = (
-    vsInterfaces
+    vsInterfaces,
+    vsDispatchField,
+    vsDispatchStrField
     );
   TValueSwitches = set of TValueSwitch;
   TValueSwitchArray = array[TValueSwitch] of string;
 const
   vsAllValueSwitches = [low(TValueSwitch)..high(TValueSwitch)];
-  DefaultVSInterfaces = 'com';
+  DefaultValueSwitches: array[TValueSwitch] of string = (
+     'com', // vsInterfaces
+     'Msg', // vsDispatchField
+     'MsgStr' // vsDispatchStrField
+     );
   DefaultMaxIncludeStackDepth = 20;
 
 type
@@ -763,6 +773,8 @@ type
     function HandleDirective(const ADirectiveText: String): TToken; virtual;
     function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
     procedure HandleBoolDirective(bs: TBoolSwitch; const Param: String); virtual;
+    procedure DoHandleDirective(Sender: TObject; Directive, Param: String;
+      var Handled: boolean); virtual;
     procedure HandleIFDEF(const AParam: String);
     procedure HandleIFNDEF(const AParam: String);
     procedure HandleIFOPT(const AParam: String);
@@ -771,6 +783,7 @@ type
     procedure HandleELSE(const AParam: String);
     procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
+    procedure HandleDispatchField(Param: String; vs: TValueSwitch); virtual;
     procedure HandleError(Param: String); virtual;
     procedure HandleMessageDirective(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
@@ -1106,7 +1119,9 @@ const
     );
 
   ValueSwitchNames: array[TValueSwitch] of string = (
-    'Interfaces'
+    'Interfaces', // vsInterfaces
+    'DispatchField', // vsDispatchField
+    'DispatchStrField' // vsDispatchStrField
     );
 
 const
@@ -2655,6 +2670,8 @@ constructor TPascalScanner.Create(AFileResolver: TBaseFileResolver);
     Result.Duplicates:=dupError;
   end;
 
+var
+  vs: TValueSwitch;
 begin
   inherited Create;
   FFileResolver := AFileResolver;
@@ -2669,7 +2686,8 @@ begin
   FCurrentBoolSwitches:=bsFPCMode;
   FAllowedBoolSwitches:=bsAll;
   FAllowedValueSwitches:=vsAllValueSwitches;
-  FCurrentValueSwitches[vsInterfaces]:=DefaultVSInterfaces;
+  for vs in TValueSwitch do
+    FCurrentValueSwitches[vs]:=DefaultValueSwitches[vs];
 
   FConditionEval:=TCondDirectiveEvaluator.Create;
   FConditionEval.OnLog:=@OnCondEvalLog;
@@ -2731,9 +2749,9 @@ begin
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
   FCurFilename := AFilename;
   AddFile(FCurFilename);
-{$IFDEF HASFS}
+  {$IFDEF HASFS}
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
-{$ENDIF}
+  {$ENDIF}
   if LogEvent(sleFile) then
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
 end;
@@ -3295,6 +3313,26 @@ begin
     end;
 end;
 
+procedure TPascalScanner.HandleDispatchField(Param: String; vs: TValueSwitch);
+var
+  NewValue: String;
+begin
+  if not (vs in AllowedValueSwitches) then
+    Error(nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,[ValueSwitchNames[vs]]);
+  NewValue:=ReadIdentifier(Param);
+  if NewValue='-' then
+    NewValue:=''
+  else if not IsValidIdent(NewValue,false) then
+    DoLog(mtWarning,nInvalidDispatchFieldName,SInvalidDispatchFieldName,[]);
+  if SameText(NewValue,CurrentValueSwitch[vs]) then exit;
+  if vs in ReadOnlyValueSwitches then
+    begin
+    Error(nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,[ValueSwitchNames[vs]]);
+    exit;
+    end;
+  CurrentValueSwitch[vs]:=NewValue;
+end;
+
 procedure TPascalScanner.HandleError(Param: String);
 begin
   if po_StopOnErrorDirective in Options then
@@ -3680,6 +3718,10 @@ begin
           HandleDefine(Param);
         'GOTO':
           DoBoolDirective(bsGoto);
+        'DIRECTIVEFIELD':
+          HandleDispatchField(Param,vsDispatchField);
+        'DIRECTIVESTRFIELD':
+          HandleDispatchField(Param,vsDispatchStrField);
         'ERROR':
           HandleError(Param);
         'HINT':
@@ -3733,8 +3775,7 @@ begin
       end;
       end;
 
-    if Assigned(OnDirective) then
-      OnDirective(Self,Directive,Param,Handled);
+    DoHandleDirective(Self,Directive,Param,Handled);
     if (not Handled) then
       if LogEvent(sleDirective) then
         DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
@@ -3799,6 +3840,13 @@ begin
     CurrentBoolSwitches:=CurrentBoolSwitches-[bs];
 end;
 
+procedure TPascalScanner.DoHandleDirective(Sender: TObject; Directive,
+  Param: String; var Handled: boolean);
+begin
+  if Assigned(OnDirective) then
+    OnDirective(Self,Directive,Param,Handled);
+end;
+
 function TPascalScanner.DoFetchToken: TToken;
 var
   TokenStart: {$ifdef UsePChar}PChar{$else}integer{$endif};
@@ -4853,7 +4901,7 @@ begin
     end;
   Result:=true;
   if (not Quiet) and LogEvent(sleConditionals) then
-    DoLog(mtInfo,nLogMacroDefined,sLogMacroDefined,[aName])
+    DoLog(mtInfo,nLogMacroXSetToY,SLogMacroXSetToY,[aName,aValue])
 end;
 
 function TPascalScanner.RemoveMacro(const aName: String; Quiet: boolean

packages/fcl-passrc/tests/tcresolver.pas

@@ -557,6 +557,7 @@ type
     Procedure TestClass_MethodOverloadUnit;
     Procedure TestClass_HintMethodHidesNonVirtualMethod;
     Procedure TestClass_HintMethodHidesNonVirtualMethodWithoutBody_NoHint;
+    Procedure TestClass_NoHintMethodHidesPrivateMethod;
     Procedure TestClass_MethodReintroduce;
     Procedure TestClass_MethodOverloadArrayOfTClass;
     Procedure TestClass_ConstructorHidesAncestorWarning;
@@ -620,6 +621,8 @@ type
     Procedure TestClass_EnumeratorFunc;
     Procedure TestClass_ForInPropertyStaticArray;
     Procedure TestClass_TypeAlias;
+    Procedure TestClass_Message;
+    Procedure TestClass_Message_MissingParamFail;
 
     // published
     Procedure TestClass_PublishedClassVarFail;
@@ -636,6 +639,7 @@ type
     // external class
     Procedure TestExternalClass;
     Procedure TestExternalClass_Descendant;
+    Procedure TestExternalClass_HintMethodHidesNonVirtualMethodExact;
 
     // class of
     Procedure TestClassOf;
@@ -931,8 +935,10 @@ type
     Procedure TestTypeHelper_String;
     Procedure TestTypeHelper_Boolean;
     Procedure TestTypeHelper_Double;
+    Procedure TestTypeHelper_DoubleAlias;
     Procedure TestTypeHelper_Constructor_NewInstance;
-    Procedure TestTypeHelper_InterfaceFail;
+    Procedure TestTypeHelper_Interface;
+    Procedure TestTypeHelper_Interface_ConstructorFail;
 
     // attributes
     Procedure TestAttributes_Globals;
@@ -6418,14 +6424,26 @@ begin
   '  TAliasValue = TValue;',
   '  TColor = type TAliasValue;',
   '  TAliasColor = TColor;',
-  'procedure DoIt(i: TAliasValue); external;',
-  'procedure DoIt(i: TAliasColor); external;',
+  'procedure {#a}DoIt(i: TAliasValue); external;',
+  'procedure {#b}DoIt(i: TAliasColor); external;',
+  'procedure {#c}Fly(var i: TAliasValue); external;',
+  'procedure {#d}Fly(var i: TAliasColor); external;',
   'var',
   '  v: TAliasValue;',
   '  c: TAliasColor;',
   'begin',
-  '  DoIt(v);',
-  '  DoIt(c);',
+  '  {@a}DoIt(v);',
+  '  {@a}DoIt(TAliasValue(c));',
+  '  {@a}DoIt(TValue(c));',
+  '  {@b}DoIt(c);',
+  '  {@b}DoIt(TAliasColor(v));',
+  '  {@b}DoIt(TColor(v));',
+  '  {@c}Fly(v);',
+  '  {@c}Fly(TAliasValue(c));',
+  '  {@c}Fly(TValue(c));',
+  '  {@d}Fly(c);',
+  '  {@d}Fly(TAliasColor(v));',
+  '  {@d}Fly(TColor(v));',
   '']);
   ParseProgram;
 end;
@@ -9492,6 +9510,47 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
+procedure TTestResolver.TestClass_NoHintMethodHidesPrivateMethod;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  private',
+    '    procedure DoIt(p: pointer);',
+    '  end;',
+    '']),
+    LinesToStr([
+    'procedure TObject.DoIt(p: pointer);',
+    'begin',
+    '  if p=nil then ;',
+    'end;',
+    '']) );
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'type',
+  '  TAnimal = class',
+  '  strict private',
+  '    procedure Fly(p: pointer);',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '    procedure DoIt(i: longint);',
+  '    procedure Fly(b: boolean);',
+  '  end;',
+  'procedure TAnimal.Fly(p: pointer);',
+  'begin',
+  '  if p=nil then ;',
+  'end;',
+  'procedure TBird.DoIt(i: longint); begin end;',
+  'procedure TBird.Fly(b: boolean); begin end;',
+  'var b: TBird;',
+  'begin',
+  '  b.DoIt(3);']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestClass_MethodReintroduce;
 begin
   StartProgram(false);
@@ -11117,6 +11176,42 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_Message;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  FlyId = 2;',
+  '  RunStr = ''Fast'';',
+  'type',
+  '  TObject = class',
+  '    procedure Fly(var msg); message 3+FlyId;',
+  '    procedure Run(var msg); virtual; abstract; message ''prefix''+RunStr;',
+  '  end;',
+  'procedure TObject.Fly(var msg);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_Message_MissingParamFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure Fly; message 3;',
+  '  end;',
+  'procedure TObject.Fly;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sMessageHandlersInvalidParams,nMessageHandlersInvalidParams);
+end;
+
 procedure TTestResolver.TestClass_PublishedClassVarFail;
 begin
   StartProgram(false);
@@ -11302,6 +11397,31 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestExternalClass_HintMethodHidesNonVirtualMethodExact;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''JSObject''',
+  '    procedure DoIt(p: pointer);',
+  '  end;',
+  '  TBird = class external name ''Bird''(TJSObject)',
+  '    procedure DoIt(p: pointer);',
+  '  end;',
+  'procedure TJSObject.DoIt(p: pointer);',
+  'begin',
+  '  if p=nil then ;',
+  'end;',
+  'procedure TBird.DoIt(p: pointer); begin end;',
+  'var b: TBird;',
+  'begin',
+  '  b.DoIt(nil);']);
+  ParseProgram;
+  CheckResolverHint(mtHint,nMethodHidesNonVirtualMethodExactly,
+   'method hides identifier at "afile.pp(5,19)". Use reintroduce');
+end;
+
 procedure TTestResolver.TestClassOf;
 begin
   StartProgram(false);
@@ -12873,7 +12993,8 @@ begin
   '  end;',
   'begin']);
   ParseProgram;
-  CheckResolverHint(mtHint,nFunctionHidesIdentifier_NonVirtualMethod,'function hides identifier at "afile.pp(4,19)". Use overload or reintroduce');
+  CheckResolverHint(mtHint,nMethodHidesNonVirtualMethodExactly,
+    'method hides identifier at "afile.pp(4,19)". Use reintroduce');
 end;
 
 procedure TTestResolver.TestClassInterface_OverloadNoHint;
@@ -17490,6 +17611,32 @@ begin
 end;
 
 procedure TTestResolver.TestTypeHelper_Double;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  Float = double;',
+  '  THelper = type helper for float',
+  '    const NPI = 3.141592;',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelper.ToStr: String;',
+  'begin',
+  'end;',
+  'var',
+  '  a,b: Float;',
+  '  s: string;',
+  'begin',
+  '  s:=(a * b.NPI).ToStr;',
+  '  s:=(a * float.NPI).ToStr;',
+  '  s:=float.NPI.ToStr;',
+  '  s:=3.2.ToStr;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTypeHelper_DoubleAlias;
 begin
   StartProgram(false);
   Add([
@@ -17593,18 +17740,69 @@ begin
     end;
 end;
 
-procedure TTestResolver.TestTypeHelper_InterfaceFail;
+procedure TTestResolver.TestTypeHelper_Interface;
 begin
   StartProgram(false);
   Add([
   '{$modeswitch typehelpers}',
   'type',
-  '  IUnknown = interface end;',
+  '  IUnknown = interface',
+  '    function GetSizes(Index: word): word;',
+  '    procedure SetSizes(Index: word; value: word);',
+  '  end;',
+  '  TObject = class(IUnknown)',
+  '    function GetSizes(Index: word): word; virtual; abstract;',
+  '    procedure SetSizes(Index: word; value: word); virtual; abstract;',
+  '  end;',
   '  THelper = type helper for IUnknown',
+  '    procedure Fly;',
+  '    class procedure Run; static;',
+  '    property Sizes[Index: word]: word read GetSizes write SetSizes; default;',
   '  end;',
+  'var',
+  '  i: IUnknown;',
+  '  o: TObject;',
+  'procedure THelper.Fly;',
+  'begin',
+  '  i:=Self;',
+  '  o:=Self as TObject;',
+  '  Self:=nil;',
+  '  Self:=i;',
+  '  Self:=o;',
+  'end;',
+  'class procedure THelper.Run;',
+  'begin',
+  'end;',
+  'begin',
+  '  i.Fly;',
+  '  i.Fly();',
+  '  i.Run;',
+  '  i.Run();',
+  '  i.Sizes[3]:=i.Sizes[4];',
+  '  i[5]:=i[6];',
+  '  IUnknown.Run;',
+  '  IUnknown.Run();',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTypeHelper_Interface_ConstructorFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  IUnknown = interface',
+  '  end;',
+  '  THelper = type helper for IUnknown',
+  '    constructor Fly;',
+  '  end;',
+  'constructor THelper.Fly;',
+  'begin',
+  'end;',
   'begin',
   '']);
-  CheckResolverException('Type "IUnknown" cannot be extended by a type helper',nTypeXCannotBeExtendedByATypeHelper);
+  CheckResolverException('constructor is not supported',nXIsNotSupported);
 end;
 
 procedure TTestResolver.TestAttributes_Globals;