--- Merging r18106 into '.':

U    compiler/i386/i386op.inc
U    compiler/i386/i386att.inc
U    compiler/i386/i386int.inc
U    compiler/i386/i386tab.inc
U    compiler/i386/i386atts.inc
U    compiler/i386/i386prop.inc
U    compiler/i386/i386nop.inc
U    compiler/x86_64/x8664ats.inc
U    compiler/x86_64/x8664att.inc
U    compiler/x86_64/x8664int.inc
U    compiler/x86_64/x8664pro.inc
U    compiler/x86_64/x8664tab.inc
U    compiler/x86_64/x8664nop.inc
U    compiler/x86_64/x8664op.inc
U    compiler/x86/x86ins.dat
--- Merging r18121 into '.':
U    compiler/pmodules.pas
U    compiler/ppu.pas
U    compiler/ncgutil.pas
U    compiler/symconst.pas
U    compiler/ptconst.pas
U    compiler/utils/ppudump.pp
--- Merging r18179 into '.':
A    tests/webtbf/tw18058c.pp
A    tests/webtbf/tw18058a.pp
A    tests/webtbf/tw18058b.pp
C    compiler/msgtxt.inc
C    compiler/msgidx.inc
U    compiler/pdecsub.pas
U    compiler/msg/errore.msg
U    compiler/pdecvar.pas
--- Merging r18172 into '.':
U    compiler/ogcoff.pas
--- Merging r18166 into '.':
A    tests/webtbf/tw19591.pp
U    compiler/nobj.pas
Summary of conflicts:
  Text conflicts: 2

# revisions: 18106,18121,18179,18172,18166
------------------------------------------------------------------------
r18106 | sergei | 2011-08-06 08:59:33 +0200 (Sat, 06 Aug 2011) | 1 line
Changed paths:
   M /trunk/compiler/i386/i386att.inc
   M /trunk/compiler/i386/i386atts.inc
   M /trunk/compiler/i386/i386int.inc
   M /trunk/compiler/i386/i386nop.inc
   M /trunk/compiler/i386/i386op.inc
   M /trunk/compiler/i386/i386prop.inc
   M /trunk/compiler/i386/i386tab.inc
   M /trunk/compiler/x86/x86ins.dat
   M /trunk/compiler/x86_64/x8664ats.inc
   M /trunk/compiler/x86_64/x8664att.inc
   M /trunk/compiler/x86_64/x8664int.inc
   M /trunk/compiler/x86_64/x8664nop.inc
   M /trunk/compiler/x86_64/x8664op.inc
   M /trunk/compiler/x86_64/x8664pro.inc
   M /trunk/compiler/x86_64/x8664tab.inc

+ Added missing PMULLD instruction, part of Mantis #19910
------------------------------------------------------------------------
------------------------------------------------------------------------
r18121 | sergei | 2011-08-06 20:11:39 +0200 (Sat, 06 Aug 2011) | 4 lines
Changed paths:
   M /trunk/compiler/ncgutil.pas
   M /trunk/compiler/pmodules.pas
   M /trunk/compiler/ppu.pas
   M /trunk/compiler/ptconst.pas
   M /trunk/compiler/symconst.pas
   M /trunk/compiler/utils/ppudump.pp

* Fix handling of Windows WideString typed constants, resolves #15842 and completes the related #14308:
  * Do not initialize unused symbols, because finalization code is not generated for them either.
  * Always initialize/finalize such constants, even if they are declared in {$J-} state and cannot be modified by user code.

------------------------------------------------------------------------
------------------------------------------------------------------------
r18179 | sergei | 2011-08-12 16:42:30 +0200 (Fri, 12 Aug 2011) | 2 lines
Changed paths:
   M /trunk/compiler/msg/errore.msg
   M /trunk/compiler/msgidx.inc
   M /trunk/compiler/msgtxt.inc
   M /trunk/compiler/pdecsub.pas
   M /trunk/compiler/pdecvar.pas
   A /trunk/tests/webtbf/tw18058a.pp
   A /trunk/tests/webtbf/tw18058b.pp
   A /trunk/tests/webtbf/tw18058c.pp

* Check that a single interface is only delegated to a single property within a class.
* Disallow simultaneous use of method resolution and delegation for the same interface. An interface with method resolution must be implemented directly. This is Delphi compatible and resolves #18058.
------------------------------------------------------------------------
------------------------------------------------------------------------
r18172 | sergei | 2011-08-11 18:42:24 +0200 (Thu, 11 Aug 2011) | 1 line
Changed paths:
   M /trunk/compiler/ogcoff.pas

* Another attempt to align section raw data size in COFF headers. Without this, image modification WinAPIs like BeginUpdateResource/EndUpdateResource typically corrupt the image. Resolves #16852 (at least partially).
------------------------------------------------------------------------
------------------------------------------------------------------------
r18166 | sergei | 2011-08-10 23:33:39 +0200 (Wed, 10 Aug 2011) | 1 line
Changed paths:
   M /trunk/compiler/nobj.pas
   A /trunk/tests/webtbf/tw19591.pp

* When the interface method mapping is present, being unable to find the implementing procedure using the mapped name is a error condition. No attempt to find implementing procedure using symbol name should be made in this case. Resolves #19591.
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@18904 -

.gitattributes

@@ -10836,6 +10836,9 @@ tests/webtbf/tw1754.pp svneol=native#text/plain
 tests/webtbf/tw1754b.pp svneol=native#text/plain
 tests/webtbf/tw17646a.pp svneol=native#text/plain
 tests/webtbf/tw1782.pp svneol=native#text/plain
+tests/webtbf/tw18058a.pp svneol=native#text/plain
+tests/webtbf/tw18058b.pp svneol=native#text/plain
+tests/webtbf/tw18058c.pp svneol=native#text/plain
 tests/webtbf/tw18096.pp svneol=native#text/pascal
 tests/webtbf/tw18096c.pp svneol=native#text/pascal
 tests/webtbf/tw18267.pp svneol=native#text/plain
@@ -10850,6 +10853,7 @@ tests/webtbf/tw1928.pp svneol=native#text/plain
 tests/webtbf/tw1939.pp svneol=native#text/plain
 tests/webtbf/tw19463.pp svneol=native#text/pascal
 tests/webtbf/tw1949.pp svneol=native#text/plain
+tests/webtbf/tw19591.pp svneol=native#text/plain
 tests/webtbf/tw1969.pp svneol=native#text/plain
 tests/webtbf/tw1995.pp svneol=native#text/plain
 tests/webtbf/tw2018.pp svneol=native#text/plain

compiler/i386/i386att.inc

@@ -662,6 +662,7 @@
 'pmovzxwq',
 'pmovzxdq',
 'pmuldq',
+'pmulld',
 'ptest',
 'roundps',
 'roundpd',

compiler/i386/i386atts.inc

@@ -667,6 +667,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufINT,
 attsufNONE,
 attsufNONE,

compiler/i386/i386int.inc

@@ -662,6 +662,7 @@
 'pmovzxwq',
 'pmovzxdq',
 'pmuldq',
+'pmulld',
 'ptest',
 'roundps',
 'roundpd',

compiler/i386/i386nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-1203;
+1204;

compiler/i386/i386op.inc

@@ -662,6 +662,7 @@ A_PMOVZXWD,
 A_PMOVZXWQ,
 A_PMOVZXDQ,
 A_PMULDQ,
+A_PMULLD,
 A_PTEST,
 A_ROUNDPS,
 A_ROUNDPD,

compiler/i386/i386prop.inc

@@ -667,6 +667,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_Mop1, Ch_Rop2, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

compiler/i386/i386tab.inc

@@ -8281,6 +8281,13 @@
     code    : #241#3#15#56#40#72;
     flags   : if_sse41 or if_sm
   ),
+  (
+    opcode  : A_PMULLD;
+    ops     : 2;
+    optypes : (ot_xmmreg,ot_xmmrm,ot_none);
+    code    : #241#3#15#56#64#72;
+    flags   : if_sse41 or if_sm
+  ),
   (
     opcode  : A_PTEST;
     ops     : 2;

compiler/msg/errore.msg

@@ -1388,6 +1388,14 @@ parser_e_inherited_not_in_record=03309_E_The use of "inherited" is not allowed i
 parser_e_no_types_in_local_anonymous_records=03310_E_Type declarations are not allowed in local or anonymous records
 % Records with types must be defined globally. Types cannot be defined inside records which are defined in a
 % procedure or function or in anonymous records.
+parser_e_duplicate_implements_clause=03311_E_Duplicate implements clause for interface "$1"
+% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times
+% is a error.
+parser_e_mapping_no_implements=03312_E_Interface "$1" can't be delegated by "$2", it already has method resolutions
+% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class
+% has to implement the interface directly. Delegation is not possible.
+parser_e_implements_no_mapping=03313_E_Interface "$1" can't have method resolutions, "$2" already delegates it
+% Method resoulution is only possible for interfaces that are implemented directly, not by delegation.
 % \end{description}
 # Type Checking
 #

compiler/msgidx.inc

@@ -400,6 +400,9 @@ const
   parser_e_no_class_constructor_in_helpers=03308;
   parser_e_inherited_not_in_record=03309;
   parser_e_no_types_in_local_anonymous_records=03310;
+  parser_e_duplicate_implements_clause=03311;
+  parser_e_mapping_no_implements=03312;
+  parser_e_implements_no_mapping=03313;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -895,9 +898,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 60714;
+  MsgTxtSize = 60934;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,89,311,103,85,54,111,23,202,63,
+    24,89,314,103,85,54,111,23,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/ncgutil.pas

@@ -1510,7 +1510,10 @@ implementation
         include(current_procinfo.flags,pi_needs_implicit_finally);
         OldAsmList:=current_asmdata.CurrAsmList;
         current_asmdata.CurrAsmList:=asmlist;
-        hp:=finalize_data_node(cloadnode.create(sym,sym.owner));
+        hp:=cloadnode.create(sym,sym.owner);
+        if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
+          include(hp.flags,nf_isinternal_ignoreconst);
+        hp:=finalize_data_node(hp);
         firstpass(hp);
         secondpass(hp);
         hp.free;
@@ -1548,7 +1551,10 @@ implementation
                     they may also be used in another unit
                   }
                   (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
-                 (tstaticvarsym(p).varspez<>vs_const) and
+                  (
+                    (tstaticvarsym(p).varspez<>vs_const) or
+                    (vo_force_finalize in tstaticvarsym(p).varoptions)
+                  ) and
                  not(vo_is_funcret in tstaticvarsym(p).varoptions) and
                  not(vo_is_external in tstaticvarsym(p).varoptions) and
                  is_managed_type(tstaticvarsym(p).vardef) then

compiler/nobj.pas

@@ -529,14 +529,19 @@ implementation
               begin
                 { Find implementing procdef
                    1. Check for mapped name
-                   2. Use symbol name }
+                   2. Use symbol name, but only if there's no mapping,
+                      or we're processing ancestor of interface.
+                  When modifying this code, ensure that webtbs/tw11862, webtbs/tw4950
+                  and webtbf/tw19591 stay correct. }
                 implprocdef:=nil;
                 hs:=prefix+tprocdef(def).procsym.name;
                 mappedname:=ImplIntf.GetMapping(hs);
                 if mappedname<>'' then
                   implprocdef:=intf_search_procdef_by_name(tprocdef(def),mappedname);
                 if not assigned(implprocdef) then
-                  implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name);
+                  if (mappedname='') or (ImplIntf.IntfDef<>IntfDef) then
+                    implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name);
+
                 { Add procdef to the implemented interface }
                 if assigned(implprocdef) then
                   begin

compiler/ogcoff.pas

@@ -2111,12 +2111,14 @@ const pemagic : array[0..3] of byte = (
               sechdr.vsize:=mempos;
 
             { sechdr.dataSize is size of initilized data. Must be zero for sections that
-              do not contain one.
-              TODO: In Windows it must be rounded up to FileAlignment
+              do not contain one. In Windows it must be rounded up to FileAlignment
               (so it can be greater than VirtualSize) }
             if (oso_data in SecOptions) then
               begin
-                sechdr.dataSize:=Size;
+                if win32 then
+                  sechdr.dataSize:=Align(Size,SectionDataAlign)
+                else
+                  sechdr.dataSize:=Size;
                 if (Size>0) then
                   sechdr.datapos:=datapos;
               end;
@@ -2229,7 +2231,7 @@ const pemagic : array[0..3] of byte = (
         inherited DataPos_Symbols;
         { Calculating symbols position and size }
         nsyms:=ExeSymbolList.Count;
-        sympos:=CurrDataPos;
+        sympos:=Align(CurrDataPos,SectionDataAlign);
         inc(CurrDataPos,sizeof(coffsymbol)*nsyms);
       end;
 
@@ -2495,6 +2497,9 @@ const pemagic : array[0..3] of byte = (
         ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil);
         { Section data }
         ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil);
+        { Align after the last section }
+        FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
+
         { Optional Symbols }
         if SymPos<>FWriter.Size then
           internalerror(200602252);

compiler/pdecsub.pas

@@ -1008,6 +1008,9 @@ implementation
              ImplIntf:=tobjectdef(astruct).find_implemented_interface(tobjectdef(ttypesym(srsym).typedef));
            if ImplIntf=nil then
              Message(parser_e_interface_id_expected);
+           { must be a directly implemented interface }
+           if Assigned(ImplIntf.ImplementsGetter) then
+             Message2(parser_e_implements_no_mapping,ImplIntf.IntfDef.typename,astruct.objrealname^);
            consume(_ID);
            { Create unique name <interface>.<method> }
            hs:=sp+'.'+pattern;

compiler/pdecvar.pas

@@ -841,6 +841,13 @@ implementation
                end;
              if found then
                begin
+                 { An interface may not be delegated by more than one property,
+                   it also may not have method mappings. }
+                 if Assigned(ImplIntf.ImplementsGetter) then
+                   message1(parser_e_duplicate_implements_clause,ImplIntf.IntfDef.typename);
+                 if Assigned(ImplIntf.NameMappings) then
+                   message2(parser_e_mapping_no_implements,ImplIntf.IntfDef.typename,astruct.objrealname^);
+
                  ImplIntf.ImplementsGetter:=p;
                  ImplIntf.VtblImplIntf:=ImplIntf;
                  case p.propaccesslist[palt_read].firstsym^.sym.typ of

compiler/pmodules.pas

@@ -243,10 +243,14 @@ implementation
         new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
         current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
         repeat
-          { address to initialize }
-          current_asmdata.asmlists[al_globals].concat(Tai_const.createname(item.sym.mangledname, item.offset));
-          { value with which to initialize }
-          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(item.datalabel));
+          { optimize away unused local/static symbols }
+          if (item.sym.refs>0) or (item.sym.owner.symtabletype=globalsymtable) then
+            begin
+              { address to initialize }
+              current_asmdata.asmlists[al_globals].concat(Tai_const.createname(item.sym.mangledname, item.offset));
+              { value with which to initialize }
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(item.datalabel));
+            end;
           item:=TTCInitItem(item.Next);
         until item=nil;
         { end-of-list marker }

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 133;
+  CurrentPPUVersion = 134;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/ptconst.pas

@@ -172,6 +172,7 @@ implementation
         list   : tasmlist;
         origsym: tstaticvarsym;
         offset:  asizeint;
+        origblock: tblock_type;
       end;
 
     { this procedure reads typed constants }
@@ -748,13 +749,17 @@ implementation
                               strval,
                               winlike);
 
-                       { collect global Windows widestrings }
-                       if winlike and (hr.origsym.owner.symtablelevel <= main_program_level) then
+                       { Collect Windows widestrings that need initialization at startup.
+                         Local initialized vars are excluded because they are initialized
+                         at function entry instead. }
+                       if winlike and ((hr.origsym.owner.symtablelevel <= main_program_level) or
+                         (hr.origblock=bt_const)) then
                        begin
                          current_asmdata.WideInits.Concat(
                             TTCInitItem.Create(hr.origsym, hr.offset, ll)
                          );
                          ll := nil;
+                         Include(hr.origsym.varoptions, vo_force_finalize);
                        end;
                      end;
                      hr.list.concat(Tai_const.Create_sym(ll));
@@ -1457,6 +1462,7 @@ implementation
         hrec.list:=tasmlist.create;
         hrec.origsym:=sym;
         hrec.offset:=0;
+        hrec.origblock:=block_type;
         read_typed_const_data(hrec,sym.vardef);
 
         { Parse hints }

compiler/symconst.pas

@@ -433,7 +433,10 @@ type
     { first field of variant part of a record }
     vo_is_first_field,
     vo_volatile,
-    vo_has_section
+    vo_has_section,
+    { variable contains a winlike WideString which should be finalized
+      even in $J- state }
+    vo_force_finalize
   );
   tvaroptions=set of tvaroption;
 

compiler/utils/ppudump.pp

@@ -1232,7 +1232,8 @@ const
      (mask:vo_is_weak_external;str:'WeakExternal'),
      (mask:vo_is_first_field;str:'IsFirstField'),
      (mask:vo_volatile;str:'Volatile'),
-     (mask:vo_has_section;str:'HasSection')
+     (mask:vo_has_section;str:'HasSection'),
+     (mask:vo_force_finalize;str:'ForceFinalize')
   );
 var
   i : longint;

compiler/x86/x86ins.dat

@@ -3321,6 +3321,10 @@ xmmreg,xmmrm          \361\3\x0F\x38\x35\110               SSE41,SM
 (Ch_All, Ch_None, Ch_None)
 xmmreg,xmmrm          \361\3\x0F\x38\x28\110               SSE41,SM
 
+[PMULLD]
+(Ch_All, Ch_None, Ch_None)
+xmmreg,xmmrm          \361\3\x0F\x38\x40\110               SSE41,SM
+
 [PTEST]
 (Ch_All, Ch_None, Ch_None)
 xmmreg,xmmrm          \361\3\x0F\x38\x17\110               SSE41,SM

compiler/x86_64/x8664ats.inc

@@ -667,6 +667,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
+attsufNONE,
 attsufINT,
 attsufNONE,
 attsufNONE,

compiler/x86_64/x8664att.inc

@@ -662,6 +662,7 @@
 'pmovzxwq',
 'pmovzxdq',
 'pmuldq',
+'pmulld',
 'ptest',
 'roundps',
 'roundpd',

compiler/x86_64/x8664int.inc

@@ -662,6 +662,7 @@
 'pmovzxwq',
 'pmovzxdq',
 'pmuldq',
+'pmulld',
 'ptest',
 'roundps',
 'roundpd',

compiler/x86_64/x8664nop.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86ins.dat }
-1212;
+1213;

compiler/x86_64/x8664op.inc

@@ -662,6 +662,7 @@ A_PMOVZXWD,
 A_PMOVZXWQ,
 A_PMOVZXDQ,
 A_PMULDQ,
+A_PMULLD,
 A_PTEST,
 A_ROUNDPS,
 A_ROUNDPD,

compiler/x86_64/x8664pro.inc

@@ -667,6 +667,7 @@
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
+(Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_Mop1, Ch_Rop2, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),
 (Ch: (Ch_All, Ch_None, Ch_None)),

compiler/x86_64/x8664tab.inc

@@ -8302,6 +8302,13 @@
     code    : #241#3#15#56#40#72;
     flags   : if_sse41 or if_sm
   ),
+  (
+    opcode  : A_PMULLD;
+    ops     : 2;
+    optypes : (ot_xmmreg,ot_xmmrm,ot_none);
+    code    : #241#3#15#56#64#72;
+    flags   : if_sse41 or if_sm
+  ),
   (
     opcode  : A_PTEST;
     ops     : 2;

tests/webtbf/tw18058a.pp

@@ -0,0 +1,74 @@
+{ %fail }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes;
+
+type
+  IIntf1 = interface
+    ['{87776F0F-8CE0-4881-B969-C76F5A9CA517}']
+    procedure M1;
+  end;
+
+  IIntf2 = interface
+    ['{923C47DF-0A7E-4698-98B8-45175306CDF2}']
+    procedure M2;
+  end;
+
+  { TObjIntf2 }
+
+  TObjIntf2 = class(TInterfacedObject, IIntf2)
+    procedure M2;
+  end;
+
+  { TObj }
+
+  TObj = class(TInterfacedObject, IIntf1, IIntf2)
+  private
+    FObjIntf2:IIntf2;
+  public
+    constructor Create;
+    procedure M1;
+
+    // multiple delegations are forbidden
+    property I2:IIntf2 read FObjIntf2 implements IIntf2;
+    property I21: IIntf2 read FObjIntf2 implements IIntf2;
+  end;
+
+{ TObjIntf2 }
+
+procedure TObjIntf2.M2;
+begin
+  Writeln('TObjIntf2.M2 called');
+end;
+
+{ TObj }
+
+constructor TObj.Create;
+begin
+  FObjIntf2:=TObjIntf2.Create;
+end;
+
+procedure TObj.M1;
+begin
+  Writeln('TObj.M1 called');
+end;
+
+
+var O:TObj;
+    i1:IIntf1;
+    i2:IIntf2;
+begin
+  O:=TObj.Create;
+  i1:=O;
+
+  //all tries are unsuccessful
+  i2:=O as IIntf2;
+  //(O as IIntf1).QueryInterface(IIntf2, i2);
+//  i1.QueryInterface(IIntf2, i2);
+
+  //still calls TObj1.M1
+  i2.M2;
+end.
+

tests/webtbf/tw18058b.pp

@@ -0,0 +1,81 @@
+{ %fail }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes;
+
+type
+  IIntf1 = interface
+    ['{87776F0F-8CE0-4881-B969-C76F5A9CA517}']
+    procedure M1;
+  end;
+
+  IIntf2 = interface
+    ['{923C47DF-0A7E-4698-98B8-45175306CDF2}']
+    procedure M2;
+  end;
+
+  { TObjIntf2 }
+
+  TObjIntf2 = class(TInterfacedObject, IIntf2)
+    procedure M2;
+  end;
+
+  { TObj }
+
+  TObj = class(TInterfacedObject, IIntf1, IIntf2)
+  private
+    FObjIntf2:IIntf2;
+  public
+    constructor Create;
+    procedure M1;
+
+     
+    property I2:IIntf2 read FObjIntf2 implements IIntf2;
+
+    // method resolution after delegation, forbidden
+    procedure IIntf2.M2 = _M2;
+    procedure _M2;
+  end;
+
+{ TObjIntf2 }
+
+procedure TObjIntf2.M2;
+begin
+  Writeln('TObjIntf2.M2 called');
+end;
+
+{ TObj }
+
+constructor TObj.Create;
+begin
+  FObjIntf2:=TObjIntf2.Create;
+end;
+
+procedure TObj.M1;
+begin
+  Writeln('TObj.M1 called');
+end;
+
+procedure TObj._M2;
+begin
+  Writeln('TObj.M2 called');
+end;
+
+var O:TObj;
+    i1:IIntf1;
+    i2:IIntf2;
+begin
+  O:=TObj.Create;
+  i1:=O;
+
+  //all tries are unsuccessful
+  i2:=O as IIntf2;
+  //(O as IIntf1).QueryInterface(IIntf2, i2);
+//  i1.QueryInterface(IIntf2, i2);
+
+  //still calls TObj1.M1
+  i2.M2;
+end.
+

tests/webtbf/tw18058c.pp

@@ -0,0 +1,81 @@
+{ %fail }
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes;
+
+type
+  IIntf1 = interface
+    ['{87776F0F-8CE0-4881-B969-C76F5A9CA517}']
+    procedure M1;
+  end;
+
+  IIntf2 = interface
+    ['{923C47DF-0A7E-4698-98B8-45175306CDF2}']
+    procedure M2;
+  end;
+
+  { TObjIntf2 }
+
+  TObjIntf2 = class(TInterfacedObject, IIntf2)
+    procedure M2;
+  end;
+
+  { TObj }
+
+  TObj = class(TInterfacedObject, IIntf1, IIntf2)
+  private
+    FObjIntf2:IIntf2;
+  public
+    constructor Create;
+
+    procedure M1;
+
+    procedure IIntf2.M2 = _M2;
+    procedure _M2;
+
+    // delegation after method resolution, forbidden
+    property I2:IIntf2 read FObjIntf2 implements IIntf2;
+  end;
+
+{ TObjIntf2 }
+
+procedure TObjIntf2.M2;
+begin
+  Writeln('TObjIntf2.M2 called');
+end;
+
+{ TObj }
+
+constructor TObj.Create;
+begin
+  FObjIntf2:=TObjIntf2.Create;
+end;
+
+procedure TObj.M1;
+begin
+  Writeln('TObj.M1 called');
+end;
+
+procedure TObj._M2;
+begin
+  Writeln('TObj.M2 called');
+end;
+
+var O:TObj;
+    i1:IIntf1;
+    i2:IIntf2;
+begin
+  O:=TObj.Create;
+  i1:=O;
+
+  //all tries are unsuccessful
+  i2:=O as IIntf2;
+  //(O as IIntf1).QueryInterface(IIntf2, i2);
+//  i1.QueryInterface(IIntf2, i2);
+
+  //still calls TObj1.M1
+  i2.M2;
+end.
+

tests/webtbf/tw19591.pp

@@ -0,0 +1,44 @@
+{ %fail }
+{ %CPU=i386 }
+{ %target=windows,linux }
+{ Target must have distinct stdcall and cdecl calling conventions, otherwise this test will (wrongly) succeed }
+
+{$mode objfpc}{$H+}
+{$MACRO ON}
+
+uses
+  Classes;
+
+type
+// Declare wrong calling convention
+{$ifdef WINDOWS}
+  {$DEFINE extdecl := cdecl}
+{$else}  
+  {$DEFINE extdecl := stdcall}
+{$endif}  
+
+  { TObj }
+
+  TObj = class(TInterfacedObject, IUnknown)
+  
+    function IUnknown._AddRef = AddRef;  // This must produce a error because of calling convention mismatch.
+
+    function AddRef : longint;extdecl;
+  end;
+
+{ TObj }
+
+function TObj.AddRef: longint;extdecl;
+begin
+  WriteLn('TObj.AddRef call');
+  inherited;
+end;
+
+var O:TObj;
+
+begin
+  O:=TObj.Create;
+  (O as IUnknown)._AddRef;
+  O.Free;
+end.
+