From ca02da2492d71624b9041418e50a0a99207a77b1 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 20 Jun 2019 08:47:04 +0000 Subject: fcl-passrc: fixed parsing objfpc inline specialize git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@42251 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-passrc/src/pasresolver.pp | 24 +++++- packages/fcl-passrc/src/pastree.pp | 138 ++++++++++++++++++++++++++----- packages/fcl-passrc/src/pparser.pp | 128 +++++++++++++++++++--------- packages/fcl-passrc/src/pscanner.pp | 6 ++ packages/fcl-passrc/tests/tcgenerics.pp | 67 ++++++++++++--- packages/fcl-passrc/tests/testpassrc.lpr | 2 +- 6 files changed, 290 insertions(+), 75 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 5460af4a71..fc4e3c3e34 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1525,6 +1525,7 @@ type procedure FinishClassOfType(El: TPasClassOfType); virtual; procedure FinishPointerType(El: TPasPointerType); virtual; procedure FinishArrayType(El: TPasArrayType); virtual; + procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual; procedure FinishResourcestring(El: TPasResString); virtual; procedure FinishProcedure(aProc: TPasProcedure); virtual; procedure FinishProcedureType(El: TPasProcedureType); virtual; @@ -5397,7 +5398,9 @@ begin EmitTypeHints(El,TPasAliasType(El).DestType); end else if (C=TPasPointerType) then - EmitTypeHints(El,TPasPointerType(El).DestType); + EmitTypeHints(El,TPasPointerType(El).DestType) + else if C=TPasGenericTemplateType then + FinishGenericTemplateType(TPasGenericTemplateType(El)); end; procedure TPasResolver.FinishEnumType(El: TPasEnumType); @@ -5801,6 +5804,24 @@ begin end; end; +procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType); +var + i: Integer; + Expr: TPasExpr; + Value: String; +begin + for i:=0 to length(El.Constraints)-1 do + begin + Expr:=El.Constraints[i]; + if (Expr.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then + begin + Value:=TPrimitiveExpr(Expr).Value; + if SameText(Value,'class') then + ; // ToDo + end; + end; +end; + procedure TPasResolver.FinishResourcestring(El: TPasResString); var ResolvedEl: TPasResolverResult; @@ -15852,6 +15873,7 @@ begin // resolved when finished else if AClass=TPasImplCommand then else if AClass=TPasAttributes then + else if AClass=TPasGenericTemplateType then else if AClass=TPasUnresolvedUnitRef then RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El) else diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index af8c0c7499..39661abefb 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -58,6 +58,7 @@ resourcestring SPasTreeClassType = 'class'; SPasTreeInterfaceType = 'interface'; SPasTreeSpecializedType = 'specialized class type'; + SPasTreeSpecializedExpr = 'specialize expr'; SPasClassHelperType = 'class helper type'; SPasRecordHelperType = 'record helper type'; SPasTypeHelperType = 'type helper type'; @@ -564,28 +565,27 @@ type destructor Destroy; override; function ElementTypeName: string; override; function GetDeclaration(full: boolean) : string; override; + procedure ForEachCall(const aMethodCall: TOnForEachPasElement; + const Arg: Pointer); override; procedure AddParam(El: TPasElement); public Params: TFPList; // list of TPasType or TPasExpr end; - { TInlineTypeExpr - base class TInlineSpecializeExpr } + { TInlineSpecializeExpr - A } - TInlineTypeExpr = class(TPasExpr) + TInlineSpecializeExpr = class(TPasExpr) public + constructor Create(const AName: string; AParent: TPasElement); override; destructor Destroy; override; function ElementTypeName: string; override; function GetDeclaration(full : Boolean): string; override; procedure ForEachCall(const aMethodCall: TOnForEachPasElement; const Arg: Pointer); override; - procedure ClearTypeReferences(aType: TPasElement); override; + procedure AddParam(El: TPasElement); public - DestType: TPasType; // TPasSpecializeType - end; - - { TInlineSpecializeExpr - A } - - TInlineSpecializeExpr = class(TInlineTypeExpr) + NameExpr: TPasExpr; // TPrimitiveExpr + Params: TFPList; // list of TPasType or TPasExpr end; { TPasRangeType } @@ -731,9 +731,18 @@ type Function IsAdvancedRecord : Boolean; end; + { TPasGenericTemplateType } + TPasGenericTemplateType = Class(TPasType) + public + destructor Destroy; override; + function GetDeclaration(full : boolean) : string; override; + procedure ForEachCall(const aMethodCall: TOnForEachPasElement; + const Arg: Pointer); override; + procedure AddConstraint(Expr: TPasExpr); Public - TypeConstraint : String; + TypeConstraint: String deprecated; // deprecated in fpc 3.3.1 + Constraints: TPasExprArray; end; TPasObjKind = ( @@ -1753,6 +1762,54 @@ begin end; end; +{ TPasGenericTemplateType } + +destructor TPasGenericTemplateType.Destroy; +var + i: Integer; +begin + for i:=0 to length(Constraints)-1 do + Constraints[i].Release; + Constraints:=nil; + inherited Destroy; +end; + +function TPasGenericTemplateType.GetDeclaration(full: boolean): string; +var + i: Integer; +begin + Result:=inherited GetDeclaration(full); + if length(Constraints)>0 then + begin + Result:=Result+': '; + for i:=0 to length(Constraints)-1 do + begin + if i>0 then + Result:=Result+','; + Result:=Result+Constraints[i].GetDeclaration(false); + end; + end; +end; + +procedure TPasGenericTemplateType.ForEachCall( + const aMethodCall: TOnForEachPasElement; const Arg: Pointer); +var + i: Integer; +begin + inherited ForEachCall(aMethodCall, Arg); + for i:=0 to length(Constraints)-1 do + ForEachChildCall(aMethodCall,Arg,Constraints[i],false); +end; + +procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr); +var + l: Integer; +begin + l:=Length(Constraints); + SetLength(Constraints,l+1); + Constraints[l]:=Expr; +end; + {$IFDEF HasPTDumpStack} procedure PTDumpStack; begin @@ -1831,34 +1888,61 @@ begin SemicolonAtEOL := true; end; -{ TInlineTypeExpr } +{ TInlineSpecializeExpr } -destructor TInlineTypeExpr.Destroy; +constructor TInlineSpecializeExpr.Create(const AName: string; + AParent: TPasElement); begin - ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF}); + if AName='' then ; + inherited Create(AParent, pekSpecialize, eopNone); + Params:=TFPList.Create; +end; + +destructor TInlineSpecializeExpr.Destroy; +var + i: Integer; +begin + ReleaseAndNil(TPasElement(NameExpr)); + for i:=0 to Params.Count-1 do + TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF}; + FreeAndNil(Params); inherited Destroy; end; -function TInlineTypeExpr.ElementTypeName: string; +function TInlineSpecializeExpr.ElementTypeName: string; begin - Result := DestType.ElementTypeName; + Result:=SPasTreeSpecializedExpr; end; -function TInlineTypeExpr.GetDeclaration(full: Boolean): string; +function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string; +var + i: Integer; begin - Result:=DestType.GetDeclaration(full); + Result:='specialize '; + Result:=Result+NameExpr.GetDeclaration(full); + Result:=Result+'<'; + for i:=0 to Params.Count-1 do + begin + if i>0 then + Result:=Result+','; + Result:=Result+TPasElement(Params[i]).GetDeclaration(false); + end; end; -procedure TInlineTypeExpr.ForEachCall( +procedure TInlineSpecializeExpr.ForEachCall( const aMethodCall: TOnForEachPasElement; const Arg: Pointer); +var + i: Integer; begin - DestType.ForEachChildCall(aMethodCall,Arg,DestType,true); + inherited ForEachCall(aMethodCall, Arg); + ForEachChildCall(aMethodCall,Arg,NameExpr,false); + for i:=0 to Params.Count-1 do + ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true); end; -procedure TInlineTypeExpr.ClearTypeReferences(aType: TPasElement); +procedure TInlineSpecializeExpr.AddParam(El: TPasElement); begin - if DestType=aType then - ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF}); + Params.Add(El); end; { TPasSpecializeType } @@ -1903,6 +1987,16 @@ begin end; end; +procedure TPasSpecializeType.ForEachCall( + const aMethodCall: TOnForEachPasElement; const Arg: Pointer); +var + i: Integer; +begin + inherited ForEachCall(aMethodCall, Arg); + for i:=0 to Params.Count-1 do + ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true); +end; + procedure TPasSpecializeType.AddParam(El: TPasElement); begin Params.Add(El); diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 0dd9261666..3271b6bc38 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -72,7 +72,7 @@ const nParserNotAProcToken = 2026; nRangeExpressionExpected = 2027; nParserExpectCase = 2028; - // free 2029; + nParserGenericFunctionNeedsGenericKeyword = 2029; nLogStartImplementation = 2030; nLogStartInterface = 2031; nParserNoConstructorAllowed = 2032; @@ -132,7 +132,7 @@ resourcestring SParserNotAProcToken = 'Not a procedure or function token'; SRangeExpressionExpected = 'Range expression expected'; SParserExpectCase = 'Case label expression expected'; - // free for 2029 + SParserGenericFunctionNeedsGenericKeyword = 'Generic function needs keyword generic'; SLogStartImplementation = 'Start parsing implementation section.'; SLogStartInterface = 'Start parsing interface section'; SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records'; @@ -319,7 +319,7 @@ type procedure ParseClassMembers(AType: TPasClassType); procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility); procedure ReadGenericArguments(List : TFPList;Parent : TPasElement); - procedure ReadSpecializeArguments(Spec: TPasSpecializeType); + procedure ReadSpecializeArguments(Spec: TPasElement); function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String; function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; // list of TPasArgument @@ -1587,7 +1587,7 @@ begin Expr:=nil; ST:=nil; try - if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then + if CurToken=tkspecialize then begin IsSpecialize:=true; NextToken; @@ -1739,7 +1739,8 @@ begin Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface); tkInterface: Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface); - tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName); + tkSpecialize: + Result:=ParseSpecializeType(Parent,TypeName); tkClass: begin isHelper:=false; @@ -2165,6 +2166,8 @@ begin end; function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr; +type + TAllow = (aCannot, aCan, aMust); Function IsWriteOrStr(P : TPasExpr) : boolean; @@ -2235,17 +2238,17 @@ var Last, Func, Expr: TPasExpr; Params: TParamsExpr; Bin: TBinaryExpr; - ok, CanSpecialize: Boolean; + ok: Boolean; + CanSpecialize: TAllow; aName: String; ISE: TInlineSpecializeExpr; - ST: TPasSpecializeType; SrcPos, ScrPos: TPasSourcePos; ProcType: TProcType; ProcExpr: TProcedureExpr; begin Result:=nil; - CanSpecialize:=false; + CanSpecialize:=aCannot; aName:=''; case CurToken of tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString); @@ -2253,13 +2256,20 @@ begin tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString); tkIdentifier: begin - CanSpecialize:=true; + CanSpecialize:=aCan; aName:=CurTokenText; if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then Last:=CreateSelfExpr(AParent) else Last:=CreatePrimitiveExpr(AParent,pekIdent,aName); end; + tkspecialize: + begin + CanSpecialize:=aMust; + ExpectToken(tkIdentifier); + aName:=CurTokenText; + Last:=CreatePrimitiveExpr(AParent,pekIdent,aName); + end; tkfalse, tktrue: Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue); tknil: Last:=CreateNilExpr(AParent); tkSquaredBraceOpen: @@ -2288,7 +2298,7 @@ begin end; tkself: begin - CanSpecialize:=true; + CanSpecialize:=aCan; aName:=CurTokenText; Last:=CreateSelfExpr(AParent); end; @@ -2350,6 +2360,13 @@ begin begin ScrPos:=CurTokenPos; NextToken; + if CurToken=tkspecialize then + begin + if CanSpecialize=aMust then + CheckToken(tkLessThan); + CanSpecialize:=aMust; + NextToken; + end; if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well begin aName:=aName+'.'+CurTokenString; @@ -2374,34 +2391,32 @@ begin Params.Value:=Result; Result.Parent:=Params; Result:=Params; - CanSpecialize:=false; + CanSpecialize:=aCannot; Func:=nil; end; tkCaret: begin Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken)); NextToken; - CanSpecialize:=false; + CanSpecialize:=aCannot; Func:=nil; end; tkLessThan: begin SrcPos:=CurTokenPos; - if (not CanSpecialize) or not IsSpecialize then + if CanSpecialize=aCannot then + break + else if (CanSpecialize=aCan) and not IsSpecialize then break else begin // an inline specialization (e.g. A) ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos)); - ISE.Kind:=pekSpecialize; - ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos)); - ISE.DestType:=ST; - ReadSpecializeArguments(ST); - ST.DestType:=ResolveTypeReference(aName,ST); - ST.Expr:=Result; + ReadSpecializeArguments(ISE); + ISE.NameExpr:=Result; Result:=ISE; ISE:=nil; - CanSpecialize:=false; + CanSpecialize:=aCannot; NextToken; end; Func:=nil; @@ -3585,6 +3600,9 @@ begin Declarations.Declarations.Add(ArrEl); Declarations.Types.Add(ArrEl); CheckHint(ArrEl,True); + {$IFDEF VerbosePasResolver} + ParseExcTokenError('20190619145000'); + {$ENDIF} ArrEl.ElType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; ArrEl.ElType:=TPasGenericTemplateType(List[0]); List.Clear; @@ -4008,12 +4026,12 @@ begin end; end; +{$warn 5043 off} procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement); - Var N : String; T : TPasGenericTemplateType; - + Expr: TPasExpr; begin ExpectToken(tkLessThan); repeat @@ -4022,17 +4040,46 @@ begin List.Add(T); NextToken; if Curtoken = tkColon then - begin - T.TypeConstraint:=ExpectIdentifier; - NextToken; - end; - if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then - ParseExc(nParserExpectToken2Error,SParserExpectToken2Error, - [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]); - until CurToken = tkGreaterThan; + repeat + NextToken; + // comma separated list: identifier, class, record, constructor + if CurToken in [tkclass,tkrecord,tkconstructor] then + begin + if T.TypeConstraint='' then + T.TypeConstraint:=CurTokenString; + Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText); + NextToken; + end + else if CurToken=tkIdentifier then + begin + if T.TypeConstraint='' then + T.TypeConstraint:=ReadDottedIdentifier(T,Expr,true) + else + ReadDottedIdentifier(T,Expr,false); + end + else + CheckToken(tkIdentifier); + T.AddConstraint(Expr); + until CurToken<>tkComma; + Engine.FinishScope(stTypeDef,T); + until not (CurToken in [tkSemicolon,tkComma]); + if CurToken<>tkGreaterThan then + ParseExc(nParserExpectToken2Error,SParserExpectToken2Error, + [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]); end; +{$warn 5043 on} + +procedure TPasParser.ReadSpecializeArguments(Spec: TPasElement); -procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType); + procedure AddParam(El: TPasElement); + begin + if Spec is TPasSpecializeType then + TPasSpecializeType(Spec).AddParam(El) + else if Spec is TInlineSpecializeExpr then + TInlineSpecializeExpr(Spec).AddParam(El) + else + ParseExcTokenError('[20190619112611] '+Spec.ClassName); + end; Var Name : String; @@ -4042,6 +4089,7 @@ Var Expr: TPasExpr; begin + //writeln('START TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString); CheckToken(tkLessThan); NextToken; Expr:=nil; @@ -4049,7 +4097,8 @@ begin NestedSpec:=nil; try repeat - if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then + //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString); + if CurToken=tkspecialize then begin IsNested:=true; NextToken; @@ -4060,6 +4109,7 @@ begin CheckToken(tkIdentifier); Expr:=nil; Name:=ReadDottedIdentifier(Spec,Expr,true); + //writeln('AFTER NAME TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString); if CurToken=tkLessThan then begin @@ -4075,18 +4125,19 @@ begin // read nested specialize arguments ReadSpecializeArguments(NestedSpec); // add nested specialize - Spec.AddParam(NestedSpec); + AddParam(NestedSpec); NestedSpec:=nil; NextToken; end else if IsNested then - CheckToken(tkLessThan) + CheckToken(tkLessThan) // specialize keyword without < else begin // simple type reference - Spec.AddParam(Expr); + AddParam(Expr); Expr:=nil; end; + //writeln('AFTER PARAMS TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString); if CurToken=tkComma then begin @@ -6043,7 +6094,8 @@ begin tkEOF: CheckToken(tkend); tkAt,tkAtAt, - tkIdentifier,tkNumber,tkString,tkfalse,tktrue,tkChar, + tkIdentifier,tkspecialize, + tkNumber,tkString,tkfalse,tktrue,tkChar, tkBraceOpen,tkSquaredBraceOpen, tkMinus,tkPlus,tkinherited: begin @@ -6207,9 +6259,9 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; if CurToken=tkDot then Result:=Result+'.'+ExpectIdentifier else if CurToken=tkLessThan then - begin // <> can be ignored, we read the list but discard its content + begin if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then - ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc + ParseExc(nParserGenericFunctionNeedsGenericKeyword,SParserGenericFunctionNeedsGenericKeyword); UnGetToken; L:=TFPList.Create; Try diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp index f3d67722ff..90c4f7d578 100644 --- a/packages/fcl-passrc/src/pscanner.pp +++ b/packages/fcl-passrc/src/pscanner.pp @@ -3432,16 +3432,22 @@ begin 'FPC','DEFAULT': SetMode(msFpc,FPCModeSwitches,false,bsFPCMode); 'OBJFPC': + begin SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode); + UnsetNonToken(tkgeneric); + UnsetNonToken(tkspecialize); + end; 'DELPHI': begin SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]); SetNonToken(tkgeneric); + SetNonToken(tkspecialize); end; 'DELPHIUNICODE': begin SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]); SetNonToken(tkgeneric); + SetNonToken(tkspecialize); end; 'TP': SetMode(msTP7,TPModeSwitches,false); diff --git a/packages/fcl-passrc/tests/tcgenerics.pp b/packages/fcl-passrc/tests/tcgenerics.pp index 722fa84827..4dc0959666 100644 --- a/packages/fcl-passrc/tests/tcgenerics.pp +++ b/packages/fcl-passrc/tests/tcgenerics.pp @@ -17,6 +17,7 @@ Type Procedure TestRecordGenerics; Procedure TestArrayGenerics; Procedure TestGenericConstraint; + Procedure TestGenericInterfaceConstraint; // ToDo Procedure TestDeclarationConstraint; Procedure TestSpecializationDelphi; Procedure TestDeclarationDelphi; @@ -26,7 +27,8 @@ Type Procedure TestInlineSpecializationInArgument; Procedure TestSpecializeNested; Procedure TestInlineSpecializeInStatement; - Procedure TestGenericFunction; // ToDo + Procedure TestInlineSpecializeInStatementDelphi; + Procedure TestGenericFunction; end; implementation @@ -69,6 +71,32 @@ begin 'Generic TSomeClass = class', ' b : T;', 'end;', + 'Generic TBird = class', + ' c : TBird;', + 'end;', + 'Generic TEagle = class', + 'end;', + 'Generic TEagle = class', + 'end;', + '']); + ParseDeclarations; +end; + +procedure TTestGenerics.TestGenericInterfaceConstraint; +begin + Add([ + 'Type', + 'TIntfA = interface end;', + 'TIntfB = interface end;', + 'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;', + 'Generic TAnt = class', + ' b: T;', + ' c: TAnt;', + 'end;', + 'Generic TFly = class', + ' b: S;', + ' c: TFly;', + 'end;', '']); ParseDeclarations; end; @@ -80,8 +108,8 @@ begin Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ; Source.Add('Type'); Source.Add(' TSomeClass = Class(TObject)'); - Source.Add(' b : T;'); - Source.Add('end;'); + Source.Add(' b : T;'); + Source.Add(' end;'); ParseDeclarations; AssertNotNull('have generic definition',Declarations.Classes); AssertEquals('have generic definition',1,Declarations.Classes.Count); @@ -105,9 +133,9 @@ begin Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ; Source.Add('Type'); Source.Add(' TSomeClass = Class(TObject)'); - Source.Add(' b : T;'); - Source.Add(' b2 : T2;'); - Source.Add('end;'); + Source.Add(' b : T;'); + Source.Add(' b2 : T2;'); + Source.Add(' end;'); ParseDeclarations; AssertNotNull('have generic definition',Declarations.Classes); AssertEquals('have generic definition',1,Declarations.Classes.Count); @@ -126,9 +154,9 @@ begin Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ; Source.Add('Type'); Source.Add(' TSomeClass = Class(TSomeGeneric)'); - Source.Add(' b : T;'); - Source.Add(' b2 : T2;'); - Source.Add('end;'); + Source.Add(' b : T;'); + Source.Add(' b2 : T2;'); + Source.Add(' end;'); ParseDeclarations; AssertNotNull('have generic definition',Declarations.Classes); AssertEquals('have generic definition',1,Declarations.Classes.Count); @@ -148,9 +176,9 @@ begin Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches; Source.Add('Type'); Source.Add(' TSomeClass = Class(TObject)'); - Source.Add(' b : T;'); - Source.Add(' b2 : T2;'); - Source.Add('end;'); + Source.Add(' b : T;'); + Source.Add(' b2 : T2;'); + Source.Add(' end;'); ParseDeclarations; AssertNotNull('have generic definition',Declarations.Classes); AssertEquals('have generic definition',1,Declarations.Classes.Count); @@ -207,12 +235,25 @@ begin end; procedure TTestGenerics.TestInlineSpecializeInStatement; +begin + Add([ + 'begin', + ' t:=specialize a;', + ' t:=a.specialize b;', + '']); + ParseModule; +end; + +procedure TTestGenerics.TestInlineSpecializeInStatementDelphi; begin Add([ 'begin', ' vec:=TVector.create;', ' b:=a>;', + ' t:=a.b;', + ' t:=a.c;', + // forbidden:' t:=a.d>;', '']); ParseModule; end; @@ -224,7 +265,7 @@ begin 'begin', 'end;', 'begin', - //' specialize IfThen(true,2,3);', + ' specialize IfThen(true,2,3);', '']); ParseModule; end; diff --git a/packages/fcl-passrc/tests/testpassrc.lpr b/packages/fcl-passrc/tests/testpassrc.lpr index 55604dccc8..9f9444929b 100644 --- a/packages/fcl-passrc/tests/testpassrc.lpr +++ b/packages/fcl-passrc/tests/testpassrc.lpr @@ -7,7 +7,7 @@ uses Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements, tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype, tcexprparser, tcprocfunc, tcpassrcutil, tcresolver, tcgenerics, - tcuseanalyzer, pasresolveeval; + tcuseanalyzer, pasresolveeval, tcresolvegenerics; type -- cgit v1.2.1