From d8a2c47c7579289f8de282bfca791d5761a23f8c Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Thu, 11 Aug 2011 20:08:43 +0000
Subject: [PATCH]   * fixed calling inherited message handlers after r18162

git-svn-id: trunk@18173 -
---
 .gitattributes        |  1 +
 compiler/htypechk.pas | 22 ++++++++++++---
 tests/tbs/tb0577a.pp  | 63 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 82 insertions(+), 4 deletions(-)
 create mode 100644 tests/tbs/tb0577a.pp

diff --git a/.gitattributes b/.gitattributes
index eebeeee392..cbe72fb900 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 669c958643..7de4c646e4 100644
--- a/compiler/htypechk.pas
+++ b/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
diff --git a/tests/tbs/tb0577a.pp b/tests/tbs/tb0577a.pp
new file mode 100644
index 0000000000..981c3984f8
--- /dev/null
+++ b/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.