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

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

Browse Source 
git-svn-id: trunk@38215 -
This commit is contained in:
Mattias Gaertner 2018-02-11 22:09:59 +00:00
parent 30d80beb7e
commit e5b376f3be
3 changed files with 33 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-passrc/src/pasresolveeval.pas
View File

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

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

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

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

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