paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 07:39:13 +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} {$IF FPC_FULLVERSION<30101}
function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean; function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
{$ENDIF} {$ENDIF}
function NoNil(o: TObject): TObject;
function dbgs(const Flags: TPasResolverComputeFlags): string; overload; function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
function dbgs(const a: TResolvedRefAccess): string; function dbgs(const a: TResolvedRefAccess): string;
@ -1750,6 +1751,13 @@ begin
Result:=(length(Identifier)=l) or (Identifier[l+1]='.'); Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
end; end;
function NoNil(o: TObject): TObject;
begin
if o=nil then
raise Exception.Create('');
Result:=o;
end;
{$IF FPC_FULLVERSION<30101} {$IF FPC_FULLVERSION<30101}
function IsValidIdent(const Ident: string; AllowDots: Boolean; function IsValidIdent(const Ident: string; AllowDots: Boolean;
StrictDots: Boolean): Boolean; StrictDots: Boolean): Boolean;
@ -9795,12 +9803,20 @@ begin
RaiseMsg(20170216152354,nCantAccessPrivateMember,sCantAccessPrivateMember, RaiseMsg(20170216152354,nCantAccessPrivateMember,sCantAccessPrivateMember,
['private',FindData.Found.Name],FindData.ErrorPosEl); ['private',FindData.Found.Name],FindData.ErrorPosEl);
visProtected: 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 if FoundContext.GetModule=Context.GetModule then
// same module -> ok // same module -> ok
else if (Context is TPasType) else if (Context is TPasType)
and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
// context in class or descendant // 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 else
RaiseMsg(20170216152356,nCantAccessPrivateMember,sCantAccessPrivateMember, RaiseMsg(20170216152356,nCantAccessPrivateMember,sCantAccessPrivateMember,
['protected',FindData.Found.Name],FindData.ErrorPosEl); ['protected',FindData.Found.Name],FindData.ErrorPosEl);
@ -9810,7 +9826,7 @@ begin
RaiseMsg(20170216152357,nCantAccessPrivateMember,sCantAccessPrivateMember, RaiseMsg(20170216152357,nCantAccessPrivateMember,sCantAccessPrivateMember,
['strict private',FindData.Found.Name],FindData.ErrorPosEl); ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
visStrictProtected: 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) if (Context is TPasType)
and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
// context in class or descendant // context in class or descendant

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

@ -6600,17 +6600,35 @@ begin
'end.' 'end.'
])); ]));
StartProgram(true); StartProgram(true);
Add('uses unit1;'); Add([
Add('type'); 'uses unit1;',
Add(' TClassA = class(TObject)'); 'type',
Add(' procedure ProcA;'); ' TClassA = class(TObject)',
Add(' end;'); ' procedure ProcA;',
Add('procedure TClassA.ProcA;'); ' end;',
Add('begin'); ' TClassB = class(TObject)',
Add(' if vprotected=3 then ;'); ' procedure ProcB;',
Add(' if vstrictprotected=4 then ;'); ' end;',
Add('end;'); 'procedure TClassA.ProcA;',
Add('begin'); '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; ParseProgram;
end; end;