From 2865164d2b8f68cd66b377a5ee529bf9bcb78e33 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 7 Dec 2020 23:16:54 +0000 Subject: [PATCH] fcl-passrc: Includefile also must set basename --- compiler/packages/fcl-passrc/src/pscanner.pp | 59 ++++++++++++++----- .../packages/fcl-passrc/tests/tcscanner.pas | 27 ++++++++- 2 files changed, 68 insertions(+), 18 deletions(-) diff --git a/compiler/packages/fcl-passrc/src/pscanner.pp b/compiler/packages/fcl-passrc/src/pscanner.pp index be9cf27..228924a 100644 --- a/compiler/packages/fcl-passrc/src/pscanner.pp +++ b/compiler/packages/fcl-passrc/src/pscanner.pp @@ -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); diff --git a/compiler/packages/fcl-passrc/tests/tcscanner.pas b/compiler/packages/fcl-passrc/tests/tcscanner.pas index 59d16c3..8e8ea2e 100644 --- a/compiler/packages/fcl-passrc/tests/tcscanner.pas +++ b/compiler/packages/fcl-passrc/tests/tcscanner.pas @@ -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');