From 0d57d38d7c48dafd1eed0a00daf8669bf815f3bc Mon Sep 17 00:00:00 2001 From: paul Date: Mon, 29 Nov 2010 04:08:00 +0000 Subject: [PATCH] compiler: fix visibility of inherited protected members (mantis #0018087) and strict private/protected members (mantis #0018085) to nested classes git-svn-id: trunk@16473 - --- .gitattributes | 3 +++ compiler/symtable.pas | 29 ++++++++++++++++++++++------- tests/webtbs/tw18085.pp | 21 +++++++++++++++++++++ tests/webtbs/uw18087a.pp | 19 +++++++++++++++++++ tests/webtbs/uw18087b.pp | 25 +++++++++++++++++++++++++ 5 files changed, 90 insertions(+), 7 deletions(-) create mode 100644 tests/webtbs/tw18085.pp create mode 100644 tests/webtbs/uw18087a.pp create mode 100644 tests/webtbs/uw18087b.pp diff --git a/.gitattributes b/.gitattributes index ea10cb2a1d..eb8f5d455f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10767,6 +10767,7 @@ tests/webtbs/tw17986.pp svneol=native#text/pascal tests/webtbs/tw17998.pp svneol=native#text/plain tests/webtbs/tw18013.pp svneol=native#text/plain tests/webtbs/tw18075.pp svneol=native#text/pascal +tests/webtbs/tw18085.pp svneol=native#text/pascal tests/webtbs/tw1820.pp svneol=native#text/plain tests/webtbs/tw1825.pp svneol=native#text/plain tests/webtbs/tw1850.pp svneol=native#text/plain @@ -11616,6 +11617,8 @@ tests/webtbs/uw17220.pp svneol=native#text/plain tests/webtbs/uw17220a.pp svneol=native#text/plain tests/webtbs/uw17493.pp svneol=native#text/plain tests/webtbs/uw17950.pas svneol=native#text/pascal +tests/webtbs/uw18087a.pp svneol=native#text/pascal +tests/webtbs/uw18087b.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 diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 43be5c7817..58e18eaa57 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -97,6 +97,7 @@ interface databitsize : aint; procedure setdatasize(val: aint); public + function iscurrentunit: boolean; override; property datasize : aint read _datasize write setdatasize; end; @@ -1028,6 +1029,11 @@ implementation databitsize:=val*8; end; + function tabstractrecordsymtable.iscurrentunit: boolean; + begin + Result := Assigned(current_module) and (current_module.moduleid=moduleid); + end; + {**************************************************************************** TRecordSymtable ****************************************************************************} @@ -1667,6 +1673,14 @@ implementation function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean; + + function is_holded_by(childdef,ownerdef: tobjectdef): boolean; + begin + result:=childdef=ownerdef; + if not result and (childdef.owner.symtabletype=ObjectSymtable) then + result:=is_holded_by(tobjectdef(childdef.owner.defowner),ownerdef); + end; + var symownerdef : tobjectdef; begin @@ -1692,24 +1706,25 @@ implementation assigned(current_objectdef) and ( (current_objectdef=symownerdef) or - (current_objectdef.owner.moduleid=symownerdef.owner.moduleid) + (current_objectdef.owner.iscurrentunit) ) ) or ( not assigned(current_objectdef) and - (symownerdef.owner.moduleid=current_module.moduleid) + (symownerdef.owner.iscurrentunit) ) ); end; vis_strictprivate : begin result:=assigned(current_objectdef) and - (current_objectdef=symownerdef); + is_holded_by(current_objectdef,symownerdef); end; vis_strictprotected : begin result:=assigned(current_objectdef) and - current_objectdef.is_related(symownerdef); + (current_objectdef.is_related(symownerdef) or + is_holded_by(current_objectdef,symownerdef)); end; vis_protected : begin @@ -1723,7 +1738,7 @@ implementation ) or ( assigned(contextobjdef) and - (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable]) and (contextobjdef.owner.iscurrentunit) and contextobjdef.is_related(symownerdef) ) or @@ -1733,12 +1748,12 @@ implementation assigned(current_objectdef) and ( (current_objectdef=symownerdef) or - (current_objectdef.owner.moduleid=symownerdef.owner.moduleid) + (current_objectdef.owner.iscurrentunit) ) ) or ( not assigned(current_objectdef) and - (symownerdef.owner.moduleid=current_module.moduleid) + (symownerdef.owner.iscurrentunit) ) ) ); diff --git a/tests/webtbs/tw18085.pp b/tests/webtbs/tw18085.pp new file mode 100644 index 0000000000..ff2eee69a5 --- /dev/null +++ b/tests/webtbs/tw18085.pp @@ -0,0 +1,21 @@ +program Project1; + +{$mode delphi} + +uses + uw18087a, uw18087b; + +type + TFoo1 = class + strict private + type + TFoo2 = record + end; + TFoo3 = class + FFoo2: TFoo2; // was error: Identifier not found "TFoo2" + end; + end; + +begin +end. + diff --git a/tests/webtbs/uw18087a.pp b/tests/webtbs/uw18087a.pp new file mode 100644 index 0000000000..92cd249a9c --- /dev/null +++ b/tests/webtbs/uw18087a.pp @@ -0,0 +1,19 @@ +unit uw18087a; + +interface + +{$mode delphi} + +type + TFoo1 = class + protected // it worked if "protected" was removed + procedure Proc1; virtual; + end; + +implementation + + procedure TFoo1.Proc1; + begin + end; + +end. \ No newline at end of file diff --git a/tests/webtbs/uw18087b.pp b/tests/webtbs/uw18087b.pp new file mode 100644 index 0000000000..47d4fb5326 --- /dev/null +++ b/tests/webtbs/uw18087b.pp @@ -0,0 +1,25 @@ +unit uw18087b; + +interface + +{$mode delphi} + +uses + uw18087a; + +type + TFoo2 = class + type + TFoo3 = class(TFoo1) + protected + procedure Proc1; override; // was error: There is no method in an ancestor class to be overridden: "TFoo2.TFoo3.Proc1;" + end; + end; + +implementation + +procedure TFoo2.TFoo3.Proc1; +begin +end; + +end. \ No newline at end of file