diff --git a/.gitattributes b/.gitattributes index 5432829c80..3b38d3769a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7180,6 +7180,7 @@ tests/webtbs/tw5036.pp svneol=native#text/plain tests/webtbs/tw5082.pp -text svneol=unset#text/plain tests/webtbs/tw5086.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/tw6491.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/uw4352e.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 utils/Makefile svneol=native#text/plain utils/Makefile.fpc svneol=native#text/plain diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 3c1cc0121e..e6ab087bd7 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -1804,8 +1804,9 @@ implementation def:=tdef(classh.symtable.defindex.first); while assigned(def) do begin + { Find also all hidden private methods to + be compatible with delphi, see tw6203 (PFV) } if (def.deftype=procdef) and - tprocdef(def).is_visible_for_object(topclassh) and (po_msgint in tprocdef(def).procoptions) and (tprocdef(def).messageinf.i=i) then begin @@ -1850,8 +1851,9 @@ implementation def:=tdef(classh.symtable.defindex.first); while assigned(def) do begin + { Find also all hidden private methods to + be compatible with delphi, see tw6203 (PFV) } if (def.deftype=procdef) and - tprocdef(def).is_visible_for_object(topclassh) and (po_msgstr in tprocdef(def).procoptions) and (tprocdef(def).messageinf.str=s) then begin diff --git a/tests/webtbs/tw6203.pp b/tests/webtbs/tw6203.pp new file mode 100644 index 0000000000..a7dad0aecc --- /dev/null +++ b/tests/webtbs/tw6203.pp @@ -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. diff --git a/tests/webtbs/uw6203.pp b/tests/webtbs/uw6203.pp new file mode 100644 index 0000000000..c8aca89b21 --- /dev/null +++ b/tests/webtbs/uw6203.pp @@ -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. +