diff options
author | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-04-24 13:53:28 +0000 |
---|---|---|
committer | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-04-24 13:53:28 +0000 |
commit | ec2bca61ec83873beb28eb2f0df6bc00da70c0a8 (patch) | |
tree | f69671d3df9ddc2455876e0396a306b95453b77d | |
parent | 1c1eaf2aa2edfc36da8bdc4587beecfd948e1905 (diff) | |
download | fpc-ec2bca61ec83873beb28eb2f0df6bc00da70c0a8.tar.gz |
fcl-passrc: started specialize type reference a<b>.c
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49256 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r-- | packages/fcl-passrc/src/pasresolver.pp | 46 | ||||
-rw-r--r-- | packages/fcl-passrc/src/pasuseanalyzer.pas | 1 | ||||
-rw-r--r-- | packages/fcl-passrc/src/pparser.pp | 7 | ||||
-rw-r--r-- | packages/fcl-passrc/tests/tcresolvegenerics.pas | 6 |
4 files changed, 49 insertions, 11 deletions
diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index ed20471c25..e726e9a5c5 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1690,6 +1690,7 @@ type procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual; procedure FinishExceptOnExpr; virtual; procedure FinishExceptOnStatement; virtual; + procedure FinishParserSpecializeType(El: TPasSpecializeType); virtual; procedure FinishWithDo(El: TPasImplWithDo); virtual; procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual; procedure FinishDeclaration(El: TPasElement); virtual; @@ -2153,6 +2154,7 @@ type function PushHelperDotScope(HiType: TPasType): TPasDotBaseScope; function PushTemplateDotScope(TemplType: TPasGenericTemplateType; ErrorEl: TPasElement): TPasDotBaseScope; function PushDotScope(HiType: TPasType): TPasDotBaseScope; + function PushParserSpecializeType(SpecType: TPasSpecializeType): TPasDotBaseScope; function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope; function StashScopes(NewScopeCnt: integer): integer; // returns old StashDepth function StashSubExprScopes: integer; // returns old StashDepth @@ -5238,6 +5240,9 @@ begin begin // El is the first element found -> raise error // ToDo: use the ( as error position + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.OnFindCallElements El=',GetObjPath(El)); + {$ENDIF} RaiseMsg(20170216151525,nIllegalQualifierAfter,sIllegalQualifierAfter, ['(',El.ElementTypeName],Data^.Params); end; @@ -7606,6 +7611,12 @@ begin PopScope; end; +procedure TPasResolver.FinishParserSpecializeType(El: TPasSpecializeType); +begin + if El=nil then ; + PopScope; +end; + procedure TPasResolver.FinishWithDo(El: TPasImplWithDo); begin PopWithScope(El); @@ -18120,6 +18131,13 @@ begin SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true {$IFDEF CheckPasTreeRefCount},'TPasSpecializeType.Params'{$ENDIF}); + if GenEl.SubType<>nil then + begin + PushParserSpecializeType(SpecEl); + SpecializeElType(GenEl,SpecEl,GenEl.SubType,SpecEl.SubType); + PopScope; + end; + FinishSpecializeType(SpecEl); {$IFDEF VerbosePasResolver} //writeln('TPasResolver.SpecializeSpecializeType ',GetObjName(SpecEl.DestType),' ',GetObjName(SpecEl.CustomData)); @@ -21807,6 +21825,7 @@ end; procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement); begin case ScopeType of + stSpecializeType: PushParserSpecializeType(El as TPasSpecializeType); stWithExpr: PushWithExprScope(El as TPasExpr); else RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil); @@ -21824,9 +21843,10 @@ begin stResourceString: FinishResourcestring(El as TPasResString); stProcedure: FinishProcedure(El as TPasProcedure); stProcedureHeader: FinishProcedureType(El as TPasProcedureType); + stSpecializeType: FinishParserSpecializeType(El as TPasSpecializeType); + stWithExpr: FinishWithDo(El as TPasImplWithDo); stExceptOnExpr: FinishExceptOnExpr; stExceptOnStatement: FinishExceptOnStatement; - stWithExpr: FinishWithDo(El as TPasImplWithDo); stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop); stDeclaration: FinishDeclaration(El); stAncestors: FinishAncestors(El as TPasClassType); @@ -22784,6 +22804,12 @@ begin Result:=PushHelperDotScope(HiType); end; +function TPasResolver.PushParserSpecializeType(SpecType: TPasSpecializeType + ): TPasDotBaseScope; +begin + Result:=PushDotScope(SpecType.DestType); +end; + function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope; var WithEl: TPasImplWithDo; @@ -27709,7 +27735,9 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out var TypeEl: TPasType; begin - if SpecType.CustomData is TPasSpecializeTypeData then + if SpecType.SubType<>nil then + ComputeElement(SpecType.SubType,ResolvedEl,Flags,StartEl) + else if SpecType.CustomData is TPasSpecializeTypeData then begin TypeEl:=TPasSpecializeTypeData(SpecType.CustomData).SpecializedType; if TypeEl=nil then @@ -28393,6 +28421,7 @@ function TPasResolver.ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean ): TPasType; var C: TClass; + SpecType: TPasSpecializeType; begin while aType<>nil do begin @@ -28406,9 +28435,16 @@ begin aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType else if C=TPasSpecializeType then begin - if aType.CustomData is TPasSpecializeTypeData then - exit(TPasSpecializeTypeData(aType.CustomData).SpecializedType); - aType:=TPasSpecializeType(aType).DestType; + SpecType:=TPasSpecializeType(aType); + if SpecType.SubType<>nil then + // e.g. a<b>.c + aType:=SpecType.SubType + else + begin + if SpecType.CustomData is TPasSpecializeTypeData then + exit(TPasSpecializeTypeData(SpecType.CustomData).SpecializedType); + aType:=SpecType.DestType; + end; end else exit(aType); diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index 54a45c93ff..2a9ab54a24 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -2471,6 +2471,7 @@ begin if Param is TPasGenericTemplateType then continue; UseElement(Param,rraRead,false); end; + UseElType(El,El.SubType,Mode); end; procedure TPasAnalyzer.UseVariable(El: TPasVariable; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index b3741ee1ff..f24a2aab6b 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -157,6 +157,7 @@ type stResourceString, // e.g. TPasResString stProcedure, // also method, procedure, constructor, destructor, ... stProcedureHeader, + stSpecializeType, // calls BeginScope to resolve c in a<b>.c stWithExpr, // calls BeginScope after parsing every WITH-expression stExceptOnExpr, stExceptOnStatement, @@ -1766,6 +1767,8 @@ begin ReadSpecializeArguments(ST,ST.Params); if CurToken<>tkGreaterThan then ParseExcTokenError('[20190801113005]'); + // Important: resolve type reference AFTER args, because arg count is needed + ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count); // Check for cascaded specialize A<B>.C or A<B>.C<D> NextToken; @@ -1774,10 +1777,10 @@ begin else begin NextToken; + Engine.BeginScope(stSpecializeType,ST); ST.SubType:=ParseSimpleType(ST,CurSourcePos,GenName,False); + Engine.FinishScope(stSpecializeType,ST); end; - // Important: resolve type reference AFTER args, because arg count is needed - ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count); Engine.FinishScope(stTypeDef,ST); Result:=ST; diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas index bf0e95dc5e..db692e4358 100644 --- a/packages/fcl-passrc/tests/tcresolvegenerics.pas +++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas @@ -157,7 +157,7 @@ type procedure TestGenProc_TypeParamCntOverloadNoParams; procedure TestGenProc_TypeParamWithDefaultParamDelphiFail; procedure TestGenProc_ParamSpecWithT; - procedure TestGenProc_ParamSpecWithTNestedType; // ToDo + procedure TestGenProc_ParamSpecWithTNestedType; // ToDo: NestedResultAssign // generic function infer types @@ -2557,8 +2557,6 @@ end; procedure TTestResolveGenerics.TestGenProc_ParamSpecWithTNestedType; begin - exit; - StartProgram(false); Add([ '{$mode delphi}', @@ -2578,7 +2576,7 @@ begin 'var', ' Bird: TBird<TObject>;', 'begin', - ' Fly<TObject>(Run,Bird);', + ' Fly<TObject>(@Run,Bird);', '']); ParseProgram; end; |