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

* when comparing overridden methods, ignore hidden parameters because overridden methods does not

Browse Source 
need to repeat a calling convention specifier so if the calling convention specifier 
  influences the hidden parameters, the methods are not considered equal, resolves #19159

git-svn-id: trunk@17832 -
This commit is contained in:
florian 2011-06-26 12:34:59 +00:00
parent 23363f3158
commit 589d061c3d
3 changed files with 89 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12501,6 +12501,7 @@ tests/webtbs/uw18087a.pp svneol=native#text/pascal
tests/webtbs/uw18087b.pp svneol=native#text/pascal
tests/webtbs/uw18909a.pp svneol=native#text/pascal
tests/webtbs/uw18909b.pp svneol=native#text/pascal
tests/webtbs/uw19159.pp svneol=native#text/pascal
tests/webtbs/uw2004.inc svneol=native#text/plain
tests/webtbs/uw2040.pp svneol=native#text/plain
tests/webtbs/uw2266a.inc svneol=native#text/plain

4
compiler/nobj.pas
View File

@ -266,7 +266,7 @@ implementation
end;
{ compare parameter types only, no specifiers yet }
hasequalpara:=(compare_paras(vmtpd.paras,pd.paras,cp_none,[cpo_ignoreuniv])>=te_equal);
hasequalpara:=(compare_paras(vmtpd.paras,pd.paras,cp_none,[cpo_ignoreuniv,cpo_ignorehidden])>=te_equal);
{ check that we are not trying to override a final method }
if (po_finalmethod in vmtpd.procoptions) and
@ -352,7 +352,7 @@ implementation
{ All parameter specifiers and some procedure the flags have to match
except abstract and override }
if (compare_paras(vmtpd.paras,pd.paras,cp_all,[cpo_ignoreuniv])<te_equal) or
if (compare_paras(vmtpd.paras,pd.paras,cp_all,[cpo_ignoreuniv,cpo_ignorehidden])<te_equal) or
(vmtpd.proccalloption<>pd.proccalloption) or
(vmtpd.proctypeoption<>pd.proctypeoption) or
((vmtpd.procoptions*po_comp)<>(pd.procoptions*po_comp)) then

86
tests/webtbs/uw19159.pp Normal file
View File

@ -0,0 +1,86 @@
Unit uw19159;
{$MODE DELPHI}
interface
type
IGMStringStorage = interface(IUnknown)
['{6C1E6792-ED8D-4c16-A49E-12CB62F61E7E}']
function ReadString(const ValueName: String; const DefaultValue: String = ''): String; stdcall;
procedure WriteString(const ValueName, Value: String); stdcall;
end;
TGMStorageBase = class(TObject, IGMStringStorage)
protected
FRefCount: LongInt;
public
function QueryInterface(constref IID: TGUID; out Intf): HResult; virtual; stdcall;
function _AddRef: LongInt; virtual; stdcall;
function _Release: LongInt; virtual; stdcall;
function ReadString(const ValueName: String; const DefaultValue: String { = '' }): String; virtual; stdcall; abstract;
procedure WriteString(const ValueName, Value: String); virtual; stdcall; abstract;
end;
TGMIniFileStorage = class(TGMStorageBase)
public
//
// Error: There is no method in an ancestor class to be overridden: "TGMIniFileStorage.ReadString(const AnsiString,const AnsiString):AnsiString;"
//
// function ReadString(const ValueName: String; const DefaultValue: String = ''): String; override;
//
// Repeating the stdcall directive and it gets compiled!
//
function ReadString(const ValueName: String; const DefaultValue: String = '' ): String; override;
//
// But why does this method work without repeating the stdcall directive?
//
procedure WriteString(const ValueName, Value: String); override;
end;
implementation
{ ------------------------ }
{ ---- TGMStorageBase ---- }
{ ------------------------ }
function TGMStorageBase.QueryInterface(constref IID: TGUID; out Intf): HResult;
begin
if GetInterface(IID, Intf) then Result := S_OK else Result := E_NOINTERFACE;
end;
function TGMStorageBase._AddRef: LongInt;
begin
Result := InterlockedIncrement(FRefCount);
end;
function TGMStorageBase._Release: LongInt;
begin
Result := InterlockedDecrement(FRefCount);
//if (Result = 0) and RefLifeTime then OnFinalRelease;
end;
{ --------------------------- }
{ ---- TGMIniFileStorage ---- }
{ --------------------------- }
function TGMIniFileStorage.ReadString(const ValueName: String; const DefaultValue: String = ''): String;
begin
Result := '';
end;
procedure TGMIniFileStorage.WriteString(const ValueName, Value: String);
begin
end;
end.