paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 18:17:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: Includefile also must set basename

Browse Source
This commit is contained in:
mattias 2020-12-07 23:16:54 +00:00
parent 87f91b9db0
commit 2865164d2b
2 changed files with 68 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
compiler/packages/fcl-passrc/src/pscanner.pp
View File

@ -821,6 +821,7 @@ type
procedure HandleWarn(Param: String); virtual;
procedure HandleWarnIdentifier(Identifier, Value: String); virtual;
procedure PushStackItem; virtual;
procedure PopStackItem; virtual;
function DoFetchTextToken: TToken;
function DoFetchToken: TToken;
procedure ClearFiles;
@ -2757,6 +2758,8 @@ begin
Inc(J);
end;
end;
if (I=-1) and (BaseDirectory<>'') then
I:=FStreams.IndexOf(IncludeTrailingPathDelimiter(BaseDirectory)+aName);
If (I<>-1) then
Result:=FStreams.Objects[i] as TStream;
end;
@ -2914,13 +2917,20 @@ begin
end;
procedure TPascalScanner.OpenFile(AFilename: string);
Var
aPath : String;
begin
Clearfiles;
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
FCurFilename := AFilename;
AddFile(FCurFilename);
{$IFDEF HASFS}
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
aPath:=ExtractFilePath(FCurFilename);
if (aPath<>'') then
aPath:=IncludeTrailingPathDelimiter(aPath);
FileResolver.BaseDirectory := aPath;
{$ENDIF}
if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
@ -2970,9 +2980,31 @@ begin
Result:=tkoperator;
end;
function TPascalScanner.FetchToken: TToken;
Procedure TPascalScanner.PopStackItem;
var
IncludeStackItem: TIncludeStackItem;
aFileName : String;
begin
IncludeStackItem :=
TIncludeStackItem(FIncludeStack[FIncludeStack.Count - 1]);
FIncludeStack.Delete(FIncludeStack.Count - 1);
CurSourceFile.{$ifdef pas2js}Destroy{$else}Free{$endif};
FCurSourceFile := IncludeStackItem.SourceFile;
FCurFilename := IncludeStackItem.Filename;
FileResolver.BaseDirectory:=ExtractFilePath(FCurFilename);
FCurToken := IncludeStackItem.Token;
FCurTokenString := IncludeStackItem.TokenString;
FCurLine := IncludeStackItem.Line;
FCurRow := IncludeStackItem.Row;
FCurColumnOffset := IncludeStackItem.ColumnOffset;
FTokenPos := IncludeStackItem.TokenPos;
IncludeStackItem.Free;
end;
function TPascalScanner.FetchToken: TToken;
begin
FPreviousToken:=FCurToken;
while true do
@ -2983,19 +3015,7 @@ begin
begin
if FIncludeStack.Count > 0 then
begin
IncludeStackItem :=
TIncludeStackItem(FIncludeStack[FIncludeStack.Count - 1]);
FIncludeStack.Delete(FIncludeStack.Count - 1);
CurSourceFile.{$ifdef pas2js}Destroy{$else}Free{$endif};
FCurSourceFile := IncludeStackItem.SourceFile;
FCurFilename := IncludeStackItem.Filename;
FCurToken := IncludeStackItem.Token;
FCurTokenString := IncludeStackItem.TokenString;
FCurLine := IncludeStackItem.Line;
FCurRow := IncludeStackItem.Row;
FCurColumnOffset := IncludeStackItem.ColumnOffset;
FTokenPos := IncludeStackItem.TokenPos;
IncludeStackItem.Free;
PopStackitem;
Result := FCurToken;
end
else
@ -3330,6 +3350,8 @@ procedure TPascalScanner.HandleIncludeFile(Param: String);
var
NewSourceFile: TLineReader;
aFileName : string;
begin
Param:=Trim(Param);
if Length(Param)>1 then
@ -3345,11 +3367,16 @@ begin
if not Assigned(NewSourceFile) then
Error(nErrIncludeFileNotFound, SErrIncludeFileNotFound, [Param]);
PushStackItem;
FCurSourceFile:=NewSourceFile;
FCurFilename := Param;
if FCurSourceFile is TFileLineReader then
FCurFilename := TFileLineReader(FCurSourceFile).Filename; // nicer error messages
begin
aFileName:=TFileLineReader(FCurSourceFile).Filename;
FileResolver.BaseDirectory := ExtractFilePath(aFileName);
FCurFilename := aFileName; // nicer error messages
end;
AddFile(FCurFilename);
If LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(FCurFileName)],True);

27
compiler/packages/fcl-passrc/tests/tcscanner.pas
View File

@ -57,6 +57,7 @@ type
FResolver : TStreamResolver;
FDoCommentCalled : Boolean;
FComment: string;
FPathPrefix : String;
protected
procedure DoComment(Sender: TObject; aComment: String);
procedure SetUp; override;
@ -65,12 +66,15 @@ type
Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload;
Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload;
Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitches); overload;
// creates a virtual source file with name 'afile.pp', prepended with PathPrefix
procedure NewSource(Const Source : string; DoClear : Boolean = True);
Procedure DoTestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
Procedure TestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
Procedure TestTokens(t : array of TToken; Const ASource : String; Const CheckEOF : Boolean = True;Const DoClear : Boolean = True);
Property LastIDentifier : String Read FLI Write FLi;
Property Scanner : TPascalScanner Read FScanner;
// Path for source filename.
Property PathPrefix : String Read FPathPrefix Write FPathPrefix;
published
Procedure TestEmpty;
procedure TestEOF;
@ -235,6 +239,7 @@ type
Procedure TestDefine14;
Procedure TestInclude;
Procedure TestInclude2;
Procedure TestInclude3;
Procedure TestUnDefine1;
Procedure TestMacro1;
procedure TestMacro2;
@ -444,17 +449,25 @@ begin
end;
procedure TTestScanner.NewSource(const Source: string; DoClear : Boolean = True);
Var
aFile : String;
begin
aFile:='';
if DoClear then
FResolver.Clear;
FResolver.AddStream('afile.pp',TStringStream.Create(Source));
if (FPathPrefix<>'') then
aFile:=IncludeTrailingPathDelimiter(FPathPrefix);
aFile:=aFile+'afile.pp';
FResolver.AddStream(aFile,TStringStream.Create(Source));
{$ifndef NOCONSOLE} // JC: To get the tests to run with GUI
Writeln('// '+TestName);
Writeln(Source);
{$EndIf}
// FreeAndNil(FScanner);
// FScanner:=TTestingPascalScanner.Create(FResolver);
FScanner.OpenFile('afile.pp');
FScanner.OpenFile(aFile);
end;
procedure TTestScanner.DoTestToken(t: TToken; const ASource: String;
@ -1625,6 +1638,16 @@ begin
TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I myinclude.inc} else',True,False);
end;
procedure TTestScanner.TestInclude3;
begin
PathPrefix:='src';
FResolver.AddStream('src/myinclude2.inc',TStringStream.Create(' true '));
FResolver.AddStream('src/myinclude1.inc',TStringStream.Create('if {$i myinclude2.inc} then '));
FScanner.SkipWhiteSpace:=True;
FScanner.SkipComments:=True;
TestTokens([tkIf,tkTrue,tkThen,tkElse],'{$I src/myinclude1.inc} else',True,False);
end;
procedure TTestScanner.TestUnDefine1;
begin
FSCanner.Defines.Add('ALWAYS');