mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 08:29:20 +02:00
* inheritance based on message also needs to find hidden
private methods git-svn-id: trunk@4024 -
This commit is contained in:
parent
c88b2e8369
commit
172413fd09
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -7180,6 +7180,7 @@ tests/webtbs/tw5036.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw5082.pp -text svneol=unset#text/plain
|
tests/webtbs/tw5082.pp -text svneol=unset#text/plain
|
||||||
tests/webtbs/tw5086.pp -text
|
tests/webtbs/tw5086.pp -text
|
||||||
tests/webtbs/tw5094.pp -text
|
tests/webtbs/tw5094.pp -text
|
||||||
|
tests/webtbs/tw6203.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw6435.pp svneol=native#text/plain
|
tests/webtbs/tw6435.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw6491.pp svneol=native#text/plain
|
tests/webtbs/tw6491.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw6624.pp svneol=native#text/plain
|
tests/webtbs/tw6624.pp svneol=native#text/plain
|
||||||
@ -7239,6 +7240,7 @@ tests/webtbs/uw4352c.pp svneol=native#text/plain
|
|||||||
tests/webtbs/uw4352d.pp svneol=native#text/plain
|
tests/webtbs/uw4352d.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw4352e.pp svneol=native#text/plain
|
tests/webtbs/uw4352e.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw4541.pp svneol=native#text/plain
|
tests/webtbs/uw4541.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/uw6203.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw6767.pp svneol=native#text/plain
|
tests/webtbs/uw6767.pp svneol=native#text/plain
|
||||||
utils/Makefile svneol=native#text/plain
|
utils/Makefile svneol=native#text/plain
|
||||||
utils/Makefile.fpc svneol=native#text/plain
|
utils/Makefile.fpc svneol=native#text/plain
|
||||||
|
@ -1804,8 +1804,9 @@ implementation
|
|||||||
def:=tdef(classh.symtable.defindex.first);
|
def:=tdef(classh.symtable.defindex.first);
|
||||||
while assigned(def) do
|
while assigned(def) do
|
||||||
begin
|
begin
|
||||||
|
{ Find also all hidden private methods to
|
||||||
|
be compatible with delphi, see tw6203 (PFV) }
|
||||||
if (def.deftype=procdef) and
|
if (def.deftype=procdef) and
|
||||||
tprocdef(def).is_visible_for_object(topclassh) and
|
|
||||||
(po_msgint in tprocdef(def).procoptions) and
|
(po_msgint in tprocdef(def).procoptions) and
|
||||||
(tprocdef(def).messageinf.i=i) then
|
(tprocdef(def).messageinf.i=i) then
|
||||||
begin
|
begin
|
||||||
@ -1850,8 +1851,9 @@ implementation
|
|||||||
def:=tdef(classh.symtable.defindex.first);
|
def:=tdef(classh.symtable.defindex.first);
|
||||||
while assigned(def) do
|
while assigned(def) do
|
||||||
begin
|
begin
|
||||||
|
{ Find also all hidden private methods to
|
||||||
|
be compatible with delphi, see tw6203 (PFV) }
|
||||||
if (def.deftype=procdef) and
|
if (def.deftype=procdef) and
|
||||||
tprocdef(def).is_visible_for_object(topclassh) and
|
|
||||||
(po_msgstr in tprocdef(def).procoptions) and
|
(po_msgstr in tprocdef(def).procoptions) and
|
||||||
(tprocdef(def).messageinf.str=s) then
|
(tprocdef(def).messageinf.str=s) then
|
||||||
begin
|
begin
|
||||||
|
28
tests/webtbs/tw6203.pp
Normal file
28
tests/webtbs/tw6203.pp
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
uses
|
||||||
|
uw6203;
|
||||||
|
|
||||||
|
type
|
||||||
|
TDerived = class(TTest)
|
||||||
|
private
|
||||||
|
procedure CMTest(var Msg: TMessage); message CM_TEST;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDerived.CMTest(var Msg: TMessage);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
WriteLn('TDerived.CMTest');
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Test: TTest;
|
||||||
|
Msg: TMessage;
|
||||||
|
begin
|
||||||
|
err:=true;
|
||||||
|
Test := TDerived.Create;
|
||||||
|
Msg.Msg := CM_TEST;
|
||||||
|
Test.Dispatch(Msg);
|
||||||
|
if err then
|
||||||
|
halt(1);
|
||||||
|
end.
|
44
tests/webtbs/uw6203.pp
Normal file
44
tests/webtbs/uw6203.pp
Normal file
@ -0,0 +1,44 @@
|
|||||||
|
unit uw6203;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
const
|
||||||
|
CM_TEST = $B000 + 18;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMessage = packed record
|
||||||
|
Msg: Cardinal;
|
||||||
|
case Integer of
|
||||||
|
0: (
|
||||||
|
WParam: Longint;
|
||||||
|
LParam: Longint;
|
||||||
|
Result: Longint);
|
||||||
|
1: (
|
||||||
|
WParamLo: Word;
|
||||||
|
WParamHi: Word;
|
||||||
|
LParamLo: Word;
|
||||||
|
LParamHi: Word;
|
||||||
|
ResultLo: Word;
|
||||||
|
ResultHi: Word);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTest = class
|
||||||
|
private
|
||||||
|
procedure CMTest(var Msg: TMessage); message CM_TEST;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Err : boolean;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure TTest.CMTest(var Msg: TMessage);
|
||||||
|
begin
|
||||||
|
WriteLn('TTest.CMTest');
|
||||||
|
err:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user