Browse Source

* 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: trunk@18166 -
sergei 14 years ago
parent
commit
25bf0012f2
3 changed files with 52 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 7 2
      compiler/nobj.pas
  3. 44 0
      tests/webtbf/tw19591.pp

+ 1 - 0
.gitattributes

@@ -10862,6 +10862,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

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

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