From 5c3b2e881a4553f6e256273cf756ad9e316d3d27 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 7 Jan 2012 15:20:43 +0000 Subject: [PATCH] * Allow streams as source * Improved range type parsing (handle deprecated etc.) * Improvements in record type parsing type (handle deprecated etc.) git-svn-id: trunk@19993 - --- packages/fcl-passrc/src/pastree.pp | 99 ++++++++++++++++++++++++++---- packages/fcl-passrc/src/pparser.pp | 44 ++++++++----- 2 files changed, 118 insertions(+), 25 deletions(-) diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index 7c18626b49..17fe5c1d65 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -116,6 +116,7 @@ type function PathName: string; // = Module.Name + FullName function GetModule: TPasModule; function ElementTypeName: string; virtual; + Function HintsString : String; function GetDeclaration(full : Boolean) : string; virtual; procedure Accept(Visitor: TPassTreeVisitor); override; property RefCount: LongWord read FRefCount; @@ -307,10 +308,11 @@ type TPasResString = class(TPasElement) public + Destructor Destroy; override; function ElementTypeName: string; override; function GetDeclaration(full : Boolean) : string; Override; public - Value: string; + Expr: TPasExpr; end; { TPasType } @@ -365,7 +367,10 @@ type function ElementTypeName: string; override; function GetDeclaration(full : boolean) : string; override; public - RangeStart, RangeEnd: string; + RangeExpr : TBinaryExpr; + Destructor Destroy; override; + Function RangeStart : String; + Function RangeEnd : String; end; { TPasArrayType } @@ -399,8 +404,8 @@ type public function ElementTypeName: string; override; public - IsValueUsed: Boolean; - Value: Integer; +// IsValueUsed: Boolean; +// Value: Integer; AssignedValue : string; end; @@ -1059,6 +1064,23 @@ uses SysUtils; { Parse tree element type name functions } function TPasElement.ElementTypeName: string; begin Result := SPasTreeElement end; + +function TPasElement.HintsString: String; + +Var + H : TPasmemberHint; + +begin + Result:=''; + For H := Low(TPasmemberHint) to High(TPasMemberHint) do + if H in Hints then + begin + If (Result<>'') then + Result:=Result+'; '; + Result:=Result+cPasMemberHint[h]; + end; +end; + function TPasDeclarations.ElementTypeName: string; begin Result := SPasTreeSection end; function TPasModule.ElementTypeName: string; begin Result := SPasTreeModule end; function TPasPackage.ElementTypeName: string; begin Result := SPasTreePackage end; @@ -1119,17 +1141,18 @@ end; procedure TPasElement.ProcessHints(const ASemiColonPrefix: boolean; var AResult: string); var h: TPasMemberHint; + S : String; begin if Hints <> [] then - begin + begin if ASemiColonPrefix then AResult := AResult + ';'; - for h := Low(TPasMemberHint) to High(TPasMemberHint) do - begin - if h in Hints then - AResult := AResult + ' ' + cPasMemberHint[h] + ';' + S:=HintsString; + if (S<>'') then + AResult:=AResult+' '+S; + if ASemiColonPrefix then + AResult:=AResult+';'; end; - end; end; constructor TPasElement.Create(const AName: string; AParent: TPasElement); @@ -1810,37 +1833,75 @@ end; function TPasResString.GetDeclaration (full : boolean) : string; begin - Result:=Value; + Result:=Expr.GetDeclaration(true); If Full Then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; +end; + +destructor TPasResString.Destroy; +begin + If Assigned(Expr) then + Expr.Release; + inherited Destroy; end; function TPasPointerType.GetDeclaration (full : boolean) : string; begin Result:='^'+DestType.Name; If Full then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; end; function TPasAliasType.GetDeclaration (full : boolean) : string; begin Result:=DestType.Name; If Full then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; end; function TPasClassOfType.GetDeclaration (full : boolean) : string; begin Result:='Class of '+DestType.Name; If Full then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; end; function TPasRangeType.GetDeclaration (full : boolean) : string; begin Result:=RangeStart+'..'+RangeEnd; If Full then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; +end; + +destructor TPasRangeType.Destroy; +begin + FreeAndNil(RangeExpr); + inherited Destroy; +end; + +function TPasRangeType.RangeStart: String; +begin + Result:=RangeExpr.Left.GetDeclaration(False); +end; + +function TPasRangeType.RangeEnd: String; +begin + Result:=RangeExpr.Right.GetDeclaration(False); end; function TPasArrayType.GetDeclaration (full : boolean) : string; @@ -1856,7 +1917,10 @@ begin else Result:=Result+'const'; If Full Then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; end; function TPasArrayType.IsPacked: Boolean; @@ -1870,7 +1934,10 @@ begin If Assigned(Eltype) then Result:=Result+' of '+ElType.Name; If Full Then + begin Result:=Name+' = '+Result; + ProcessHints(False,Result); + end; end; Function IndentStrings(S : TStrings; indent : Integer) : string; @@ -1914,6 +1981,8 @@ begin Result:=IndentStrings(S,Length(Name)+4) else Result:=IndentStrings(S,1); + if Full then + ProcessHints(False,Result); finally S.Free; end; @@ -1948,6 +2017,8 @@ begin If Full then Result:=Name+' = '+Result; end; + If Full then + ProcessHints(False,Result); end; function TPasRecordType.GetDeclaration (full : boolean) : string; @@ -2085,6 +2156,9 @@ function TPasVariable.GetDeclaration (full : boolean) : string; Const Seps : Array[Boolean] of Char = ('=',':'); +Var + H : TPasMemberHint; + B : Boolean; begin if (Value = '') and Assigned(Expr) then Value := Expr.GetDeclaration(full); @@ -2101,7 +2175,10 @@ begin else Result:=Value; If Full then + begin Result:=Name+' '+Seps[Assigned(VarType)]+' '+Result; + Result:=Result+HintsString; + end; end; function TPasProperty.GetDeclaration (full : boolean) : string; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index d25eae6c10..3abfaa6c6d 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -50,6 +50,7 @@ resourcestring SParserInvalidTypeDef = 'Invalid type definition'; SParserExpectedIdentifier = 'Identifier expected'; SParserNotAProcToken = 'Not a procedure or function token'; + SRangeExpressionExpected = 'Range expression expected'; SLogStartImplementation = 'Start parsing implementation section.'; SLogStartInterface = 'Start parsing interface section'; @@ -112,7 +113,7 @@ type TPasParser = class private FCurModule: TPasModule; - FFileResolver: TFileResolver; + FFileResolver: TBaseFileResolver; FLogEvents: TPParserLogEvents; FOnLog: TPasParserLogHandler; FOptions: TPOptions; @@ -164,7 +165,7 @@ type procedure AddProcOrFunction(Decs: TPasDeclarations; AProc: TPasProcedure); function CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement; public - constructor Create(AScanner: TPascalScanner; AFileResolver: TFileResolver; AEngine: TPasTreeContainer); + constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer); // General parsing routines function CurTokenName: String; function CurTokenText: String; @@ -219,7 +220,7 @@ type procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean); procedure ParseProcedureBody(Parent: TPasElement); // Properties for external access - property FileResolver: TFileResolver read FFileResolver; + property FileResolver: TBaseFileResolver read FFileResolver; property Scanner: TPascalScanner read FScanner; property Engine: TPasTreeContainer read FEngine; property CurToken: TToken read FCurToken; @@ -231,7 +232,8 @@ type end; function ParseSource(AEngine: TPasTreeContainer; - const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule; + const FPCCommandLine, OSTarget, CPUTarget: String; + UseStreams : Boolean = False): TPasModule; Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean; Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean; Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean; @@ -320,7 +322,8 @@ begin end; function ParseSource(AEngine: TPasTreeContainer; - const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule; + const FPCCommandLine, OSTarget, CPUTarget: String; + UseStreams : Boolean = False): TPasModule; var FileResolver: TFileResolver; Parser: TPasParser; @@ -352,7 +355,6 @@ var 'S': // -S mode if (length(s)>2) and (s[3]='d') then begin // -Sd mode delphi - Scanner.Options:=Scanner.Options+[po_delphi]; Parser.Options:=Parser.Options+[po_delphi]; end; end; @@ -372,6 +374,7 @@ begin Parser := nil; try FileResolver := TFileResolver.Create; + FileResolver.UseStreams:=UseStreams; Scanner := TPascalScanner.Create(FileResolver); Scanner.Defines.Append('FPK'); Scanner.Defines.Append('FPC'); @@ -504,7 +507,7 @@ begin end; constructor TPasParser.Create(AScanner: TPascalScanner; - AFileResolver: TFileResolver; AEngine: TPasTreeContainer); + AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer); begin inherited Create; FScanner := AScanner; @@ -903,7 +906,7 @@ begin tkRecord: Result := ParseRecordDecl(Parent,TypeName,PM); else UngetToken; - Result:=ParseRangeType(Parent,''); + Result:=ParseRangeType(Parent,TypeName); end; if CH then CheckHint(Result,True); @@ -2013,7 +2016,9 @@ begin Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent)); try ExpectToken(tkEqual); - Result.Value := ParseExpression(Result); + NextToken; // skip tkEqual + Result.Expr:=DoParseConstValueExpression(Result); + UngetToken; CheckHint(Result,True); except Result.Free; @@ -2041,13 +2046,23 @@ end; // Starts after the type name Function TPasParser.ParseRangeType(AParent : TPasElement; Const TypeName : String) : TPasRangeType; +Var + PE : TPasExpr; + begin Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, AParent)); try - TPasRangeType(Result).RangeStart := ParseExpression(Result); - ExpectToken(tkDotDot); - TPasRangeType(Result).RangeEnd := ParseExpression(Result); - // CheckHint(Result,True); + If not (CurToken=tkEqual) then + ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkEqual]])); + NextToken; + PE:=DoParseExpression(Result,Nil); + if not ((PE is TBinaryExpr) and (TBinaryExpr(PE).Kind=pekRange)) then + begin + FreeAndNil(PE); + ParseExc(SRangeExpressionExpected); + end; + Result.RangeExpr:=PE as TBinaryExpr; + UngetToken; except FreeAndNil(Result); raise; @@ -3463,7 +3478,8 @@ begin ExpectIdentifier; UngetToken; // Only names are allowed as following type TPasClassOfType(Result).DestType := ParseType(Result); - ExpectToken(tkSemicolon); + CheckHint(Result,true); +// ExpectToken(tkSemicolon); exit; end;