Przeglądaj źródła

* when comparing overridden methods, ignore hidden parameters because overridden methods does not
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 -

florian 14 lat temu
rodzic
commit
589d061c3d
3 zmienionych plików z 89 dodań i 2 usunięć
  1. 1 0
      .gitattributes
  2. 2 2
      compiler/nobj.pas
  3. 86 0
      tests/webtbs/uw19159.pp

+ 1 - 0
.gitattributes

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

+ 2 - 2
compiler/nobj.pas

@@ -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 - 0
tests/webtbs/uw19159.pp

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