* Includefile also must set basename

git-svn-id: trunk@47468 -

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

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');