Ver código fonte

* fixed calling inherited message handlers after r18162

git-svn-id: trunk@18173 -
Jonas Maebe 14 anos atrás
pai
commit
d8a2c47c75
3 arquivos alterados com 82 adições e 4 exclusões
  1. 1 0
      .gitattributes
  2. 18 4
      compiler/htypechk.pas
  3. 63 0
      tests/tbs/tb0577a.pp

+ 1 - 0
.gitattributes

@@ -9134,6 +9134,7 @@ tests/tbs/tb0574.pp svneol=native#text/pascal
 tests/tbs/tb0575.pp svneol=native#text/plain
 tests/tbs/tb0576.pp svneol=native#text/plain
 tests/tbs/tb0577.pp svneol=native#text/plain
+tests/tbs/tb0577a.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

+ 18 - 4
compiler/htypechk.pas

@@ -1810,10 +1810,24 @@ implementation
               pd:=tprocdef(srsym.ProcdefList[j]);
               { in case of anonymous inherited, only match procdefs identical
                 to the current one (apart from hidden parameters), rather than
-                anything compatible to the parameters }
-              if anoninherited and
-                 (compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then
-                continue;
+                anything compatible to the parameters -- except in case of
+                the presence of a messagestr/int, in which case those have to
+                match exactly }
+              if anoninherited then
+                if po_msgint in current_procinfo.procdef.procoptions then
+                  begin
+                    if not(po_msgint in pd.procoptions) or
+                       (pd.messageinf.i<>current_procinfo.procdef.messageinf.i) then
+                      continue
+                  end
+                else if po_msgstr in current_procinfo.procdef.procoptions then
+                  begin
+                    if not(po_msgstr in pd.procoptions) or
+                       (pd.messageinf.str^<>current_procinfo.procdef.messageinf.str^) then
+                      continue
+                  end
+                else if (compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then
+                  continue;
               foundanything:=true;
               { Store first procsym found }
               if not assigned(FProcsym) then

+ 63 - 0
tests/tbs/tb0577a.pp

@@ -0,0 +1,63 @@
+{$mode delphi}
+
+const
+  cdefaulthandler = 1;
+  cinheritedhandler = 2;
+  cunsupportedhandler = 3;
+
+type
+  tc = class
+    procedure defaulthandler(var message); override;
+    procedure handler(var message:longint); message cinheritedhandler;
+  end;
+
+  tc2 = class(tc)
+    procedure handler(var message: longint);
+  end;
+
+  tc3 = class(tc2)
+    procedure someproc(var message:tc3); message cinheritedhandler;
+    procedure handler(var message:tc3); message cunsupportedhandler;
+  end;
+
+var
+  glob: longint;
+
+procedure tc.defaulthandler(var message);
+begin
+  glob:=cdefaulthandler;
+end;
+
+procedure tc.handler(var message: longint);
+begin
+  glob:=cinheritedhandler;
+end;
+
+
+procedure tc2.handler(var message: longint);
+begin
+  halt(1);
+end;
+
+procedure tc3.someproc(var message: tc3);
+begin
+  inherited;
+end;
+
+procedure tc3.handler(var message: tc3);
+begin
+  glob:=cunsupportedhandler;
+  inherited
+end;
+
+var
+  c: tc3;
+begin
+  c:=tc3.create;
+  c.someproc(c);
+  if glob<>cinheritedhandler then
+    halt(2);
+  c.handler(c);
+  if glob<>cdefaulthandler then
+    halt(3);
+end.