fcl-passrc: resolver: check class of method in same unit

git-svn-id: trunk@38215 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -156,6 +156,7 @@ const
   nIllegalQualifierAfter = 3004;
   nIllegalQualifierInFrontOf = 3005;
   nIllegalQualifierWithin = 3006;
+  nMethodClassXInOtherUnitY = 3007;
 
 // resourcestring patterns of messages
 resourcestring
@@ -244,7 +245,7 @@ resourcestring
   sIllegalQualifierAfter = 'illegal qualifier "%s" after "%s"';
   sIllegalQualifierInFrontOf = 'illegal qualifier "%s" in front of "%s"';
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
-
+  sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -7284,8 +7284,15 @@ begin
       CurClassType:=TPasClassType(FindElementWithoutParams(aClassName,El,false));
       if not (CurClassType is TPasClassType) then
         begin
-        aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName));
-        RaiseXExpectedButYFound(20170216152557,'class',aClassname+':'+GetElementTypeName(CurClassType),El);
+        aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
+        RaiseXExpectedButYFound(20170216152557,
+          'class',aClassname+':'+GetElementTypeName(CurClassType),El);
+        end;
+      if CurClassType.GetModule<>El.GetModule then
+        begin
+        aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
+        RaiseMsg(20180211230432,nMethodClassXInOtherUnitY,sMethodClassXInOtherUnitY,
+          [aClassName,CurClassType.GetModule.Name],El);
         end;
 
       // restore scope

packages/fcl-passrc/tests/tcresolver.pas

@@ -430,6 +430,7 @@ type
     Procedure TestClass_Method;
     Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_MethodWithoutClassFail;
+    Procedure TestClass_MethodInOtherUnitFail;
     Procedure TestClass_MethodWithParams;
     Procedure TestClass_MethodUnresolvedPrg;
     Procedure TestClass_MethodUnresolvedUnit;
@@ -6562,6 +6563,27 @@ begin
   CheckResolverException('identifier not found "TClassA"',nIdentifierNotFound);
 end;
 
+procedure TTestResolver.TestClass_MethodInOtherUnitFail;
+begin
+  AddModuleWithIntfImplSrc('unit1.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '  end;',
+    '']),
+    '');
+
+  StartProgram(true);
+  Add([
+  'uses unit1;',
+  'procedure TObject.DoIt;',
+  'begin',
+  'end;',
+  'begin']);
+  CheckResolverException('method class "TObject" in other unit "unit1"',nMethodClassXInOtherUnitY);
+end;
+
 procedure TTestResolver.TestClass_MethodWithParams;
 begin
   StartProgram(false);