paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 20:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: class visibility protected: aClassInThisModule.Identifier

Browse Source 
git-svn-id: trunk@37360 -
This commit is contained in:
Mattias Gaertner 2017-09-30 11:18:18 +00:00
parent 81a0f88d8c
commit abbea4c416
2 changed files with 47 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1450,6 +1450,7 @@ function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
{$IF FPC_FULLVERSION<30101}
function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
{$ENDIF}
function NoNil(o: TObject): TObject;
function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
function dbgs(const a: TResolvedRefAccess): string;
@ -1750,6 +1751,13 @@ begin
Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
end;
function NoNil(o: TObject): TObject;
begin
if o=nil then
raise Exception.Create('');
Result:=o;
end;
{$IF FPC_FULLVERSION<30101}
function IsValidIdent(const Ident: string; AllowDots: Boolean;
StrictDots: Boolean): Boolean;
@ -9795,12 +9803,20 @@ begin
RaiseMsg(20170216152354,nCantAccessPrivateMember,sCantAccessPrivateMember,
['private',FindData.Found.Name],FindData.ErrorPosEl);
visProtected:
// protected members can only be accessed in same module or descendant classes
// protected members can only be accessed in same module
// or modules of descendant classes
if FoundContext.GetModule=Context.GetModule then
// same module -> ok
else if (Context is TPasType)
and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
// context in class or descendant
else if (TopScope is TPasDotClassScope)
and (TPasDotClassScope(TopScope).ClassScope.Element.GetModule=Context.GetModule) then
// e.g. aClassInThisModule.identifier
else if (TopScope is TPasWithExprScope)
and (TPasWithExprScope(TopScope).Scope is TPasClassScope)
and (TPasClassScope(TPasWithExprScope(TopScope).Scope).Element.GetModule=Context.GetModule) then
// e.g. with aClassInThisModule do identifier
else
RaiseMsg(20170216152356,nCantAccessPrivateMember,sCantAccessPrivateMember,
['protected',FindData.Found.Name],FindData.ErrorPosEl);
@ -9810,7 +9826,7 @@ begin
RaiseMsg(20170216152357,nCantAccessPrivateMember,sCantAccessPrivateMember,
['strict private',FindData.Found.Name],FindData.ErrorPosEl);
visStrictProtected:
// strict protected members can only be access in their and descendant classes
// strict protected members can only be accessed in their and descendant classes
if (Context is TPasType)
and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
// context in class or descendant

40
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -6600,17 +6600,35 @@ begin
'end.'
]));
StartProgram(true);
Add('uses unit1;');
Add('type');
Add(' TClassA = class(TObject)');
Add(' procedure ProcA;');
Add(' end;');
Add('procedure TClassA.ProcA;');
Add('begin');
Add(' if vprotected=3 then ;');
Add(' if vstrictprotected=4 then ;');
Add('end;');
Add('begin');
Add([
'uses unit1;',
'type',
' TClassA = class(TObject)',
' procedure ProcA;',
' end;',
' TClassB = class(TObject)',
' procedure ProcB;',
' end;',
'procedure TClassA.ProcA;',
'begin',
' if vprotected=3 then ;',
' if vstrictprotected=4 then ;',
' if self.vprotected=5 then;',
' if self.vstrictprotected=6 then;',
' with self do if vprotected=7 then;',
' with self do if vstrictprotected=8 then;',
'end;',
'procedure TClassB.ProcB;',
'var A: TClassA;',
'begin',
' if A.vprotected=9 then;',
' with A do if vprotected=10 then;',
'end;',
'var A: TClassA;',
'begin',
' A.vprotected:=11;',
' with A do vprotected:=12;',
' // error: A.vstrictprotected:=13; ']);
ParseProgram;
end;