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

git-svn-id: trunk@37360 -

packages/fcl-passrc/src/pasresolver.pp

@@ -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

packages/fcl-passrc/tests/tcresolver.pas

@@ -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;