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

fcl-passrc: resolver: check duplicate class forwards

Browse Source 
git-svn-id: trunk@38224 -
This commit is contained in:
Mattias Gaertner 2018-02-12 13:50:12 +00:00
parent 032c8f99a6
commit 2ae54c3c00
2 changed files with 30 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5191,9 +5191,24 @@ var
aModifier: String;
IsSealed: Boolean;
CanonicalSelf: TPasClassOfType;
ParentDecls: TPasDeclarations;
Decl: TPasElement;
begin
if aClass.IsForward then
begin
// check for duplicate forwards
ParentDecls:=aClass.Parent as TPasDeclarations;
for i:=0 to ParentDecls.Declarations.Count-1 do
begin
Decl:=TPasElement(ParentDecls.Declarations[i]);
if (CompareText(Decl.Name,aClass.Name)=0)
and (Decl<>aClass) then
RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
[Decl.Name,GetElementSourcePosStr(Decl)],aClass);
end;
exit;
end;
if aClass.ObjKind<>okClass then
begin
if (aClass.ObjKind=okInterface)
@ -7103,7 +7118,7 @@ begin
if not (TopScope is TPasSectionScope) then
RaiseNotYetImplemented(20171225110934,El,'nested classes');
Duplicate:=TPasIdentifierScope(TopScope).FindIdentifier(El.Name);
Duplicate:=TPasIdentifierScope(TopScope).FindLocalIdentifier(El.Name);
//if Duplicate<>nil then
//writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));

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

@ -427,6 +427,7 @@ type
Procedure TestClassForward;
Procedure TestClassForwardAsAncestorFail;
Procedure TestClassForwardNotResolved;
Procedure TestClassForwardDuplicateFail;
Procedure TestClass_Method;
Procedure TestClass_ConstructorMissingDotFail;
Procedure TestClass_MethodImplDuplicateFail;
@ -6518,6 +6519,19 @@ begin
nForwardTypeNotResolved);
end;
procedure TTestResolver.TestClassForwardDuplicateFail;
begin
StartProgram(false);
Add([
'type',
' TObject = class;',
' TObject = class;',
' TObject = class',
' end;',
'begin']);
CheckResolverException('Duplicate identifier "TObject" at afile.pp(3,10)',nDuplicateIdentifier);
end;
procedure TTestResolver.TestClass_Method;
begin
StartProgram(false);