diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index c456afcc80..beaa4214b0 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1405,6 +1405,7 @@ type Found: TPasElement; ElScope: TPasScope; // Where Found was found StartScope: TPasScope; // where the search started + SkipGenerics: boolean; end; PPRFindData = ^TPRFindData; @@ -2047,9 +2048,9 @@ type function FindElement(const aName: String): TPasElement; override; // used by TPasParser function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement; - NoProcsWithArgs: boolean): TPasElement; + NoProcsWithArgs, NoGenerics: boolean): TPasElement; function FindElementWithoutParams(const AName: String; out Data: TPRFindData; - ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement; + ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement; function FindFirstEl(const AName: String; out Data: TPRFindData; ErrorPosEl: TPasElement): TPasElement; procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr); @@ -4757,12 +4758,31 @@ procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope, var Data: PPRFindData absolute FindFirstElementData; ok: Boolean; + Proc: TPasProcedure; + Templates: TFPList; begin ok:=true; - if (El is TPasProcedure) - and ProcNeedsParams(TPasProcedure(El).ProcType) then - // found a proc, but it needs parameters -> remember the first and continue - ok:=false; + if (El is TPasProcedure) then + begin + Proc:=TPasProcedure(El); + if Data^.SkipGenerics then + begin + Templates:=GetProcTemplateTypes(Proc); + if (Templates<>nil) and (Templates.Count>0) then + ok:=false; + end; + if ok and ProcNeedsParams(Proc.ProcType) then + // found a proc, but it needs parameters -> remember the first and continue + ok:=false; + end + else if Data^.SkipGenerics then + begin + if El is TPasGenericType then + begin + if GetTypeParameterCount(TPasGenericType(El))>0 then + ok:=false; + end; + end; if ok or (Data^.Found=nil) then begin Data^.Found:=El; @@ -5433,12 +5453,9 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope; function SkipGenericTypes(Identifier: TPasIdentifier; TypeParamCnt: integer): TPasIdentifier; - {$IFDEF EnableGenTypeOverload} var CurEl: TPasElement; - {$ENDIF} begin - {$IFDEF EnableGenTypeOverload} while Identifier<>nil do begin CurEl:=Identifier.Element; @@ -5454,9 +5471,6 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope; end; Identifier:=Identifier.NextSameIdentifier; end; - {$ELSE} - if TypeParamCnt=0 then ; - {$ENDIF} Result:=Identifier; end; @@ -8385,7 +8399,7 @@ var if IsDefaultAncestor(aClass,DefAncestorName) then exit; RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass); end; - CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false); + CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false,true); if not (CurEl is TPasType) then RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass); DirectAncestor:=TPasType(CurEl); @@ -8946,7 +8960,7 @@ begin begin // attribute without params // -> resolve call 'Create' - DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false); + DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false,true); if DeclEl=nil then RaiseIdentifierNotFound(20190221144516,'Create',NameExpr); // check call is constructor @@ -9996,7 +10010,7 @@ begin RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El); end else - DeclEl:=FindElementWithoutParams(aName,FindData,El,false); + DeclEl:=FindElementWithoutParams(aName,FindData,El,false,false); if DeclEl.ClassType=TPasUsesUnit then begin @@ -10980,7 +10994,7 @@ begin else RaiseNotYetImplemented(20190131154557,NameExpr); - DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true); + DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true,true); Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData); CheckFoundElement(FindData,Ref); if DeclEl is TPasProcedure then @@ -20548,7 +20562,7 @@ begin RaiseInternalError(20190801104033); // caller forgot to handle "With" end else - NextEl:=FindElementWithoutParams(CurName,ErrorEl,true); + NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true); {$IFDEF VerbosePasResolver} //if RightPath<>'' then // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl)); @@ -20623,11 +20637,11 @@ begin end; function TPasResolver.FindElementWithoutParams(const AName: String; - ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement; + ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement; var Data: TPRFindData; begin - Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs); + Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs,NoGenerics); if Data.Found=nil then exit; // forward type: class-of or ^ CheckFoundElement(Data,nil); if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr) @@ -20636,8 +20650,8 @@ begin end; function TPasResolver.FindElementWithoutParams(const AName: String; out - Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean - ): TPasElement; + Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs, + NoGenerics: boolean): TPasElement; var Abort: boolean; begin @@ -20646,6 +20660,7 @@ begin Abort:=false; Data:=Default(TPRFindData); Data.ErrorPosEl:=ErrorPosEl; + Data.SkipGenerics:=NoGenerics; IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort); Result:=Data.Found; if Result=nil then diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 963eacf5b2..0e0d334764 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -410,7 +410,7 @@ type function ArrayExprToText(Expr: TPasExprArray): String; // Type declarations function ResolveTypeReference(Name: string; Parent: TPasElement; ParamCnt: integer = 0): TPasType; - function ParseComplexType(Parent : TPasElement = Nil): TPasType; + function ParseVarType(Parent : TPasElement = Nil): TPasType; function ParseTypeDecl(Parent: TPasElement): TPasType; function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType; function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType; @@ -420,7 +420,7 @@ type function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType; function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType; function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType; - function ParseSpecializeType(Parent: TPasElement; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType; + function ParseSpecializeType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType; function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType; Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType; Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String) : TPasFileType; @@ -1504,10 +1504,11 @@ begin begin Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result)); Params.Value:=Result.Expr; + Params.Value.Parent:=Params; Result.Expr:=Params; LengthAsText:=''; NextToken; - LengthExpr:=DoParseExpression(Result,nil,false); + LengthExpr:=DoParseExpression(Params,nil,false); Params.AddParam(LengthExpr); CheckToken(tkSquaredBraceClose); LengthAsText:=ExprToText(LengthExpr); @@ -1584,7 +1585,7 @@ begin else if (CurToken = tkLessThan) and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B; begin - Result:=ParseSpecializeType(Parent,TypeName,Name,Expr); + Result:=ParseSpecializeType(Parent,NamePos,TypeName,Name,Expr); ok:=true; exit; end @@ -1676,11 +1677,13 @@ function TPasParser.ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; var Name: String; IsSpecialize, ok: Boolean; + NamePos: TPasSourcePos; begin Result:=nil; Expr:=nil; ok:=false; try + NamePos:=CurSourcePos; if CurToken=tkspecialize then begin IsSpecialize:=true; @@ -1697,7 +1700,7 @@ begin // specialize if IsSpecialize or (msDelphi in CurrentModeswitches) then begin - Result:=ParseSpecializeType(Parent,'',Name,Expr); + Result:=ParseSpecializeType(Parent,NamePos,'',Name,Expr); NextToken; end else @@ -1723,8 +1726,9 @@ begin end; end; -function TPasParser.ParseSpecializeType(Parent: TPasElement; const TypeName, - GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType; +function TPasParser.ParseSpecializeType(Parent: TPasElement; + const NamePos: TPasSourcePos; const TypeName, GenName: string; + var GenNameExpr: TPasExpr): TPasSpecializeType; // after parsing CurToken is at > var ST: TPasSpecializeType; @@ -1732,7 +1736,7 @@ begin Result:=nil; if CurToken<>tkLessThan then ParseExcTokenError('[20190801112729]'); - ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent)); + ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent,NamePos)); try if GenNameExpr<>nil then begin @@ -1998,7 +2002,9 @@ begin Result.IsReferenceTo:=True; end; -function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType; +function TPasParser.ParseVarType(Parent : TPasElement = Nil): TPasType; +var + NamePos: TPasSourcePos; begin NextToken; case CurToken of @@ -2017,8 +2023,9 @@ begin UngetToken; // Unget semicolon end; else + NamePos:=CurSourcePos; UngetToken; - Result := ParseType(Parent,CurSourcePos); + Result := ParseType(Parent,NamePos); end; end; @@ -3670,7 +3677,7 @@ begin tkGeneric: begin NextToken; - if (CurToken in [tkprocedure,tkfunction]) then + if (CurToken in [tkclass,tkprocedure,tkfunction]) then begin if msDelphi in CurrentModeswitches then ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens @@ -4625,7 +4632,7 @@ begin Until (CurToken=tkColon); OldForceCaret:=Scanner.SetForceCaret(True); try - VarType := ParseComplexType(VarEl); + VarType := ParseVarType(VarEl); {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; finally Scanner.SetForceCaret(OldForceCaret); diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas index a8bd41f06a..96b850ca33 100644 --- a/packages/fcl-passrc/tests/tcresolvegenerics.pas +++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas @@ -58,9 +58,10 @@ type // generic class procedure TestGen_Class; procedure TestGen_ClassDelphi; - procedure TestGen_ClassDelphi_TypeOverload; // ToDo: type overload + procedure TestGen_ClassDelphi_TypeOverload; procedure TestGen_ClassObjFPC; procedure TestGen_ClassObjFPC_OverloadFail; + procedure TestGen_ClassObjFPC_OverloadOtherUnit; procedure TestGen_ClassForward; procedure TestGen_ClassForwardConstraints; procedure TestGen_ClassForwardConstraintNameMismatch; @@ -68,7 +69,7 @@ type procedure TestGen_ClassForwardConstraintTypeMismatch; procedure TestGen_ClassForward_Circle; procedure TestGen_Class_RedeclareInUnitImplFail; - procedure TestGen_Class_AnotherInUnitImpl; // ToDo: type overload + procedure TestGen_Class_TypeOverloadInUnitImpl; procedure TestGen_Class_MethodObjFPC; procedure TestGen_Class_MethodOverride; procedure TestGen_Class_MethodDelphi; @@ -768,18 +769,18 @@ begin '{$mode delphi}', 'type', ' TObject = class end;', - ' TBird = word;', - ' TBird = class', + ' {#a}TBird = word;', + ' {#b}TBird = class', ' v: T;', ' end;', - //' TEagle = TBird;', - //'var', - //' b: TBird;', - //' w: TBird;', + ' {=b}TEagle = TBird;', + 'var', + ' b: {@b}TBird;', + ' {=a}w: TBird;', 'begin', - //' b.v:=w;', + ' b.v:=w;', '']); - CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier); + ParseProgram; end; procedure TTestResolveGenerics.TestGen_ClassObjFPC; @@ -816,6 +817,41 @@ begin CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier); end; +procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadOtherUnit; +begin + AddModuleWithIntfImplSrc('unit1.pas', + LinesToStr([ + 'type', + ' TBird = class b1: word; end;', + ' generic TAnt = class a1: T; end;', + '']), + LinesToStr([ + ''])); + AddModuleWithIntfImplSrc('unit2.pas', + LinesToStr([ + 'type', + ' generic TBird = class b2:T; end;', + ' TAnt = class a2:word; end;', + '']), + LinesToStr([ + ''])); + StartProgram(true,[supTObject]); + Add([ + 'uses unit1, unit2;', + 'var', + ' b1: TBird;', + ' b2: specialize TBird;', + ' a1: specialize TAnt;', + ' a2: TAnt;', + 'begin', + ' b1.b1:=1;', + ' b2.b2:=2;', + ' a1.a1:=3;', + ' a2.a2:=4;', + '']); + ParseProgram; +end; + procedure TTestResolveGenerics.TestGen_ClassForward; begin StartProgram(false); @@ -970,7 +1006,7 @@ begin nDuplicateIdentifier); end; -procedure TTestResolveGenerics.TestGen_Class_AnotherInUnitImpl; +procedure TTestResolveGenerics.TestGen_Class_TypeOverloadInUnitImpl; begin StartUnit(false); Add([ @@ -981,7 +1017,7 @@ begin 'implementation', 'type generic TBird = record x: T; y: U; end;', '']); - CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',nDuplicateIdentifier); + ParseUnit; end; procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC; @@ -995,10 +1031,18 @@ begin ' generic TBird<{#Templ}T> = class', ' function Fly(p:T): T; virtual; abstract;', ' function Run(p:T): T;', + ' procedure Jump(p:T);', + ' class procedure Go(p:T);', ' end;', 'function TBird.Run(p:T): T;', 'begin', 'end;', + 'generic procedure TBird.Jump(p:T);', + 'begin', + 'end;', + 'generic class procedure TBird.Go(p:T);', + 'begin', + 'end;', 'var', ' b: specialize TBird;', ' {=Typ}w: T;', diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 13dc1fba62..7c00203dbd 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -1462,7 +1462,9 @@ var if El.CustomData is TResolvedReference then Ref:=TResolvedReference(El.CustomData).Declaration else if El.CustomData is TPasPropertyScope then - Ref:=TPasPropertyScope(El.CustomData).AncestorProp; + Ref:=TPasPropertyScope(El.CustomData).AncestorProp + else if El.CustomData is TPasSpecializeTypeData then + Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType; if Ref<>nil then for j:=0 to LabelElements.Count-1 do begin @@ -1478,11 +1480,17 @@ var El:=TPasElement(ReferenceElements[i]); write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')'); write(' El=',GetObjName(El)); + if EL is TPrimitiveExpr then + begin + writeln('CheckResolverReference ',TPrimitiveExpr(El).Value); + end; Ref:=nil; if El.CustomData is TResolvedReference then Ref:=TResolvedReference(El.CustomData).Declaration else if El.CustomData is TPasPropertyScope then - Ref:=TPasPropertyScope(El.CustomData).AncestorProp; + Ref:=TPasPropertyScope(El.CustomData).AncestorProp + else if El.CustomData is TPasSpecializeTypeData then + Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType; if Ref<>nil then begin write(' Decl=',GetObjName(Ref)); @@ -1490,7 +1498,7 @@ var write(',',Ref.SourceFilename,'(',aLine,',',aCol,')'); end else - write(' has no TResolvedReference'); + write(' has no TResolvedReference. El.CustomData=',GetObjName(El.CustomData)); writeln; end; for i:=0 to LabelElements.Count-1 do @@ -1533,7 +1541,7 @@ var for i:=0 to ReferenceElements.Count-1 do begin El:=TPasElement(ReferenceElements[i]); - //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDesc(El,2)); + //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDbg(El,2)); if El.ClassType=TPasVariable then begin if TPasVariable(El).VarType=nil then @@ -1582,6 +1590,8 @@ var begin El:=TPasElement(ReferenceElements[i]); writeln(' Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El)); + //if EL is TPasVariable then + // writeln('CheckDirectReference ',GetObjPath(TPasVariable(El).VarType),' ',ResolverEngine.GetElementSourcePosStr(TPasVariable(EL).VarType)); end; RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker); finally