paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 12:29:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow streams as source

Browse Source 
* Improved range type parsing (handle deprecated etc.)
* Improvements in record type parsing type (handle deprecated etc.)

git-svn-id: trunk@19993 -
This commit is contained in:
michael 2012-01-07 15:20:43 +00:00
parent a0cc3b7611
commit 5c3b2e881a
2 changed files with 118 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
packages/fcl-passrc/src/pastree.pp
View File

@ -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;

44
packages/fcl-passrc/src/pparser.pp
View File

@ -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;