paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 18:08:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@18166 -
This commit is contained in:
sergei 2011-08-10 21:33:39 +00:00
parent a88ee0d95d
commit 25bf0012f2
3 changed files with 52 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

9
compiler/nobj.pas
View File

@ -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
tests/webtbf/tw19591.pp Normal file
View File

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