fcl-passrc: resolver: error on using generic types without params

This commit is contained in:
mattias 2020-11-29 00:06:47 +00:00
parent 0bfef62666
commit 84321a4c29
3 changed files with 43 additions and 7 deletions

View File

@ -20904,11 +20904,27 @@ end;
function TPasResolver.FindElementFor(const aName: String; AParent: TPasElement;
TypeParamCount: integer): TPasElement;
// called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
var
ErrorEl: TPasElement;
procedure CheckGenericRefWithoutParams(GenEl: TPasGenericType);
// called when TypeParamCount=0 check if reference to a generic type is allowed with
begin
if (GenEl.GenericTemplateTypes=nil) or (GenEl.GenericTemplateTypes.Count=0) then
exit;
// referrring to a generic type without params
if not (msDelphi in CurrentParser.CurrentModeswitches)
and (AParent<>nil)
and AParent.HasParent(GenEl) then
exit; // mode objfpc: inside the generic type it can be referred without params
RaiseMsg(20201129005025,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,['variable'],ErrorEl);
end;
var
p: SizeInt;
RightPath, CurName, LeftPath: String;
NeedPop: Boolean;
CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
CurScopeEl, NextEl, BestEl: TPasElement;
CurSection: TPasSection;
i: Integer;
UsesUnit: TPasUsesUnit;
@ -20980,11 +20996,17 @@ begin
RaiseInternalError(20190801104033); // caller forgot to handle "With"
end
else
begin
NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true);
if (NextEl is TPasGenericType) and (RightPath='') then
CheckGenericRefWithoutParams(TPasGenericType(NextEl));
end;
{$IFDEF VerbosePasResolver}
//if RightPath<>'' then
// writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
{$ENDIF}
if NextEl=nil then
RaiseIdentifierNotFound(20201129004745,CurName,ErrorEl);
if NextEl is TPasModule then
begin
if CurScopeEl is TPasModule then
@ -21038,10 +21060,8 @@ begin
else
CurScopeEl:=BestEl;
end
else if NextEl<>nil then
CurScopeEl:=NextEl
else
RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
CurScopeEl:=NextEl;
// restore scope
if NeedPop then

View File

@ -64,6 +64,7 @@ type
procedure TestGen_ClassObjFPC;
procedure TestGen_ClassObjFPC_OverloadFail;
procedure TestGen_ClassObjFPC_OverloadOtherUnit;
procedure TestGen_ClassGenAncestorWithoutParamFail;
procedure TestGen_ClassForward;
procedure TestGen_ClassForwardConstraints;
procedure TestGen_ClassForwardConstraintNameMismatch;
@ -261,8 +262,8 @@ begin
' TBirdAlias = TBird;',
'begin',
'']);
CheckResolverException('type expected, but TBird<> found',
nXExpectedButYFound);
CheckResolverException('Generics without specialization cannot be used as a type for a variable',
nGenericsWithoutSpecializationAsType);
end;
procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
@ -940,6 +941,22 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_ClassGenAncestorWithoutParamFail;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class end;',
' generic TBird<T> = class end;',
' generic TEagle<T> = class(TBird)',
' end;',
'begin',
'']);
CheckResolverException('Generics without specialization cannot be used as a type for a variable',
nGenericsWithoutSpecializationAsType);
end;
procedure TTestResolveGenerics.TestGen_ClassForward;
begin
StartProgram(false);

View File

@ -16991,7 +16991,6 @@ begin
' end;',
'begin',
' JSwiper.new;',
//' if typeinfo(JSwiper)=nil then ;',
'']);
ConvertProgram;
CheckSource('TestExternalClass_SameNamePublishedProperty',