* Split resolver in baseresolver & resolver

git-svn-id: trunk@40426 -
This commit is contained in:
michael 2018-12-01 18:59:31 +00:00
parent 67fe756642
commit 4d165e542d
3 changed files with 90 additions and 34 deletions

View File

@ -285,7 +285,10 @@ interface
uses uses
{$ifdef pas2js} {$ifdef pas2js}
js, NodeJSFS, js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
{$endif} {$endif}
Classes, SysUtils, Math, Types, contnrs, Classes, SysUtils, Math, Types, contnrs,
PasTree, PScanner, PParser, PasResolveEval; PasTree, PScanner, PParser, PasResolveEval;

View File

@ -31,7 +31,7 @@ unit PParser;
interface interface
uses uses
{$ifdef pas2js} {$ifdef NODEJS}
NodeJSFS, NodeJSFS,
{$endif} {$endif}
SysUtils, Classes, PasTree, PScanner; SysUtils, Classes, PasTree, PScanner;
@ -94,6 +94,7 @@ const
nParserResourcestringsMustBeGlobal = 2054; nParserResourcestringsMustBeGlobal = 2054;
nParserOnlyOneVariableCanBeAbsolute = 2055; nParserOnlyOneVariableCanBeAbsolute = 2055;
nParserXNotAllowedInY = 2056; nParserXNotAllowedInY = 2056;
nFileSystemsNotSupported = 2057;
// resourcestring patterns of messages // resourcestring patterns of messages
resourcestring resourcestring
@ -153,6 +154,7 @@ resourcestring
SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global'; SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global';
SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute'; SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute';
SParserXNotAllowedInY = '%s is not allowed in %s'; SParserXNotAllowedInY = '%s is not allowed in %s';
SErrFileSystemNotSupported = 'No support for filesystems enabled';
type type
TPasScopeType = ( TPasScopeType = (
@ -472,6 +474,10 @@ Type
{$endif} {$endif}
poSkipDefaultDefs); poSkipDefaultDefs);
TParseSourceOptions = set of TParseSourceOption; TParseSourceOptions = set of TParseSourceOption;
Var
DefaultFileResolverClass : TBaseFileResolverClass = Nil;
function ParseSource(AEngine: TPasTreeContainer; function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule; const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
{$ifdef HasStreams} {$ifdef HasStreams}
@ -597,8 +603,9 @@ end;
function ParseSource(AEngine: TPasTreeContainer; function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String; const FPCCommandLine, OSTarget, CPUTarget: String;
Options : TParseSourceOptions): TPasModule; Options : TParseSourceOptions): TPasModule;
var var
FileResolver: TFileResolver; FileResolver: TBaseFileResolver;
Parser: TPasParser; Parser: TPasParser;
Start, CurPos: integer; // in FPCCommandLine Start, CurPos: integer; // in FPCCommandLine
Filename: String; Filename: String;
@ -648,7 +655,7 @@ var
end; end;
end else end else
if Filename <> '' then if Filename <> '' then
raise Exception.Create(SErrMultipleSourceFiles) raise ENotSupportedException.Create(SErrMultipleSourceFiles)
else else
Filename := s; Filename := s;
end; end;
@ -656,14 +663,17 @@ var
var var
s: String; s: String;
begin begin
if DefaultFileResolverClass=Nil then
raise ENotImplemented.Create(SErrFileSystemNotSupported);
Result := nil; Result := nil;
FileResolver := nil; FileResolver := nil;
Scanner := nil; Scanner := nil;
Parser := nil; Parser := nil;
try try
FileResolver := TFileResolver.Create; FileResolver := DefaultFileResolverClass.Create;
{$ifdef HasStreams} {$ifdef HasStreams}
FileResolver.UseStreams:=poUseStreams in Options; if FileResolver is TFileResolver then
TFileResolver(FileResolver).UseStreams:=poUseStreams in Options;
{$endif} {$endif}
Scanner := TPascalScanner.Create(FileResolver); Scanner := TPascalScanner.Create(FileResolver);
Scanner.LogEvents:=AEngine.ScannerLogEvents; Scanner.LogEvents:=AEngine.ScannerLogEvents;
@ -733,7 +743,9 @@ begin
if Filename = '' then if Filename = '' then
raise Exception.Create(SErrNoSourceGiven); raise Exception.Create(SErrNoSourceGiven);
{$IFDEF HASFS}
FileResolver.AddIncludePath(ExtractFilePath(FileName)); FileResolver.AddIncludePath(ExtractFilePath(FileName));
{$ENDIF}
Scanner.OpenFile(Filename); Scanner.OpenFile(Filename);
Parser.ParseMain(Result); Parser.ParseMain(Result);
finally finally
@ -6989,4 +7001,8 @@ begin
Result.Kind:=pekListOfExp; Result.Kind:=pekListOfExp;
end; end;
initialization
{$IFDEF HASFS}
DefaultFileResolverClass:=TFileResolver;
{$ENDIF}
end. end.

View File

@ -26,13 +26,22 @@ unit PScanner;
{$IF FPC_FULLVERSION<30101} {$IF FPC_FULLVERSION<30101}
{$define EmulateArrayInsert} {$define EmulateArrayInsert}
{$endif} {$endif}
{$define HasFS}
{$endif} {$endif}
{$IFDEF NODEJS}
{$define HasFS}
{$ENDIF}
interface interface
uses uses
{$ifdef pas2js} {$ifdef pas2js}
js, NodeJSFS, Types, js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
Types,
{$endif} {$endif}
SysUtils, Classes; SysUtils, Classes;
@ -479,7 +488,6 @@ type
Protected Protected
procedure SetBaseDirectory(AValue: string); virtual; procedure SetBaseDirectory(AValue: string); virtual;
procedure SetStrictFileCase(AValue: Boolean); virtual; procedure SetStrictFileCase(AValue: Boolean); virtual;
Function FindIncludeFileName(const AName: string): String;
Property IncludePaths: TStringList Read FIncludePaths; Property IncludePaths: TStringList Read FIncludePaths;
public public
constructor Create; virtual; constructor Create; virtual;
@ -490,7 +498,9 @@ type
Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase; Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
end; end;
TBaseFileResolverClass = Class of TBaseFileResolver;
{$IFDEF HASFS}
{ TFileResolver } { TFileResolver }
TFileResolver = class(TBaseFileResolver) TFileResolver = class(TBaseFileResolver)
@ -499,6 +509,7 @@ type
FUseStreams: Boolean; FUseStreams: Boolean;
{$endif} {$endif}
Protected Protected
Function FindIncludeFileName(const AName: string): String;
Function CreateFileReader(Const AFileName : String) : TLineReader; virtual; Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
Public Public
function FindSourceFile(const AName: string): TLineReader; override; function FindSourceFile(const AName: string): TLineReader; override;
@ -507,6 +518,7 @@ type
Property UseStreams : Boolean Read FUseStreams Write FUseStreams; Property UseStreams : Boolean Read FUseStreams Write FUseStreams;
{$endif} {$endif}
end; end;
{$ENDIF}
{$ifdef fpc} {$ifdef fpc}
{ TStreamResolver } { TStreamResolver }
@ -1144,6 +1156,7 @@ function FilenameIsAbsolute(const TheFilename: string):boolean;
function FilenameIsWinAbsolute(const TheFilename: string): boolean; function FilenameIsWinAbsolute(const TheFilename: string): boolean;
function FilenameIsUnixAbsolute(const TheFilename: string): boolean; function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean; function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
Function ExtractFilenameOnly(Const AFileName : String) : String;
procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}); procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
function SafeFormat(const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): string; function SafeFormat(const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): string;
@ -1159,6 +1172,13 @@ Var
SortedTokens : array of TToken; SortedTokens : array of TToken;
LowerCaseTokens : Array[ttoken] of String; LowerCaseTokens : Array[ttoken] of String;
Function ExtractFilenameOnly(Const AFileName : String) : String;
begin
Result:=ChangeFileExt(ExtractFileName(aFileName),'');
end;
Procedure SortTokenInfo; Procedure SortTokenInfo;
Var Var
@ -2378,7 +2398,45 @@ begin
FStrictFileCase:=AValue; FStrictFileCase:=AValue;
end; end;
function TBaseFileResolver.FindIncludeFileName(const AName: string): String;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
Var
FP : String;
begin
if (APath='') then
FIncludePaths.Add('./')
else
begin
{$IFDEF HASFS}
FP:=IncludeTrailingPathDelimiter(ExpandFileName(APath));
{$ELSE}
FP:=APath;
{$ENDIF}
FIncludePaths.Add(FP);
end;
end;
{$IFDEF HASFS}
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.FindIncludeFileName(const AName: string): String;
function SearchLowUpCase(FN: string): string; function SearchLowUpCase(FN: string): string;
@ -2432,30 +2490,6 @@ begin
end; end;
end; end;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
begin
if (APath='') then
FIncludePaths.Add('./')
else
FIncludePaths.Add(IncludeTrailingPathDelimiter(ExpandFileName(APath)));
end;
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.CreateFileReader(const AFileName: String): TLineReader; function TFileResolver.CreateFileReader(const AFileName: String): TLineReader;
begin begin
{$ifdef HasStreams} {$ifdef HasStreams}
@ -2494,6 +2528,7 @@ begin
Result:=Nil; Result:=Nil;
end; end;
end; end;
{$ENDIF}
{$ifdef fpc} {$ifdef fpc}
{ TStreamResolver } { TStreamResolver }
@ -2648,7 +2683,7 @@ begin
// Dont' free the first element, because it is CurSourceFile // Dont' free the first element, because it is CurSourceFile
while FIncludeStack.Count > 1 do while FIncludeStack.Count > 1 do
begin begin
TFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif}; TBaseFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
FIncludeStack.Delete(1); FIncludeStack.Delete(1);
end; end;
FIncludeStack.Clear; FIncludeStack.Clear;
@ -2684,7 +2719,9 @@ begin
FCurSourceFile := FileResolver.FindSourceFile(AFilename); FCurSourceFile := FileResolver.FindSourceFile(AFilename);
FCurFilename := AFilename; FCurFilename := AFilename;
AddFile(FCurFilename); AddFile(FCurFilename);
{$IFDEF HASFS}
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename)); FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
{$ENDIF}
if LogEvent(sleFile) then if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True); DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
end; end;