Pārlūkot izejas kodu

pastojs: fixed search include file mode objfpc in dir of current include file

git-svn-id: trunk@47493 -
Mattias Gaertner 4 gadi atpakaļ
vecāks
revīzija
45e2c837b8

+ 39 - 12
packages/pastojs/src/pas2jsfilecache.pp

@@ -259,7 +259,7 @@ type
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
     function FindResourceFileName(const aFilename, ModuleDir: string): String; override;
-    function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
+    function FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -1832,25 +1832,52 @@ begin
     UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath);
 end;
 
-function TPas2jsFilesCache.FindIncludeFileName(const aFilename,
-  ModuleDir: string): String;
+function TPas2jsFilesCache.FindIncludeFileName(const aFilename, SrcDir,
+  ModuleDir: string; Mode: TModeSwitch): String;
 
   function SearchCasedInIncPath(const Filename: string): string;
+  var
+    SearchedDir: array of string;
+
+    function SearchDir(Dir: string): boolean;
+    var
+      i: Integer;
+      CurFile: String;
+    begin
+      Dir:=IncludeTrailingPathDelimiter(Dir);
+      for i:=0 to length(SearchedDir)-1 do
+        if SearchedDir[i]=Dir then exit;
+      CurFile:=Dir+Filename;
+      //writeln('SearchDir aFilename=',aFilename,' SrcDir=',SrcDir,' ModDir=',ModuleDir,' Mode=',Mode,' CurFile=',CurFile);
+      Result:=SearchLowUpCase(CurFile);
+      if Result then
+        SearchCasedInIncPath:=CurFile
+      else begin
+        i:=length(SearchedDir);
+        SetLength(SearchedDir,i+1);
+        SearchedDir[i]:=Dir;
+      end;
+    end;
+
   var
     i: Integer;
   begin
     // file name is relative
-    // first search in the same directory as the unit
+    SearchedDir:=nil;
+
+    // first search in the same directory as the include file
+    if not (Mode in [msDelphi,msDelphiUnicode])
+        and (SrcDir<>'') then
+      if SearchDir(SrcDir) then exit;
+
+    // then search in the same directory as the unit
     if ModuleDir<>'' then
-      begin
-      Result:=IncludeTrailingPathDelimiter(ModuleDir)+Filename;
-      if SearchLowUpCase(Result) then exit;
-      end;
+      if SearchDir(ModuleDir) then exit;
+
     // then search in include path
-    for i:=0 to IncludePaths.Count-1 do begin
-      Result:=IncludeTrailingPathDelimiter(IncludePaths[i])+Filename;
-      if SearchLowUpCase(Result) then exit;
-    end;
+    for i:=0 to IncludePaths.Count-1 do
+      if SearchDir(IncludePaths[i]) then exit;
+
     Result:='';
   end;
 

+ 3 - 3
packages/pastojs/src/pas2jsfs.pp

@@ -98,7 +98,7 @@ Type
   Public
     // Public Abstract. Must be overridden
     function FindResourceFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
-    function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
+    function FindIncludeFileName(const aFilename, SrcDir, ModuleDir: string; Mode: TModeSwitch): String; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
@@ -421,7 +421,7 @@ var
   Filename: String;
 begin
   Result:=nil;
-  Filename:=FS.FindIncludeFileName(aFilename,BaseDirectory);
+  Filename:=FS.FindIncludeFileName(aFilename,BaseDirectory,ModuleDirectory,Mode);
   if Filename='' then exit;
   try
     Result:=FindSourceFile(Filename);
@@ -444,7 +444,7 @@ end;
 function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
 
 begin
-  Result:=FS.FindIncludeFileName(aFilename,BaseDirectory);
+  Result:=FS.FindIncludeFileName(aFilename,BaseDirectory,ModuleDirectory,Mode);
 end;
 
 

+ 1 - 1
packages/pastojs/tests/tcmodules.pas

@@ -233,7 +233,7 @@ type
   Published
     Procedure TestReservedWords;
 
-    // program/units
+    // program, units, includes
     Procedure TestEmptyProgram;
     Procedure TestEmptyProgramUseStrict;
     Procedure TestEmptyUnit;

+ 52 - 0
packages/pastojs/tests/tcunitsearch.pas

@@ -143,7 +143,11 @@ type
     procedure TestUS_Program_FU;
     procedure TestUS_Program_FU_o;
     procedure TestUS_Program_FE_o;
+
+    // include files
     procedure TestUS_IncludeSameDir;
+    Procedure TestUS_Include_NestedDelphi;
+    Procedure TestUS_Include_NestedObjFPC;
 
     // uses 'in' modifier
     procedure TestUS_UsesInFile;
@@ -728,6 +732,54 @@ begin
   Compile(['test1.pas','-Fusub','-FElib','-ofoo.js']);
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_Include_NestedDelphi;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('sub/inc1.inc',[
+    'type number = longint;',
+    '{$I sub/deep/inc2.inc}',
+    '']);
+  AddFile('sub/deep/inc2.inc',[
+    'type numero = number;',
+    '{$I sub/inc3.inc}',
+    '']);
+  AddFile('sub/inc3.inc',[
+    'type nummer = numero;',
+    '']);
+  AddFile('test1.pas',[
+  '{$mode delphi}',
+  '{$i sub/inc1.inc}',
+  'var',
+  '  n: nummer;',
+  'begin',
+  'end.']);
+  Compile(['test1.pas','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestUS_Include_NestedObjFPC;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddFile('sub/inc1.inc',[
+    'type number = longint;',
+    '{$I deep/inc2.inc}',
+    '']);
+  AddFile('sub/deep/inc2.inc',[
+    'type numero = number;',
+    '{$I ../inc3.inc}',
+    '']);
+  AddFile('sub/inc3.inc',[
+    'type nummer = numero;',
+    '']);
+  AddFile('test1.pas',[
+  '{$mode objfpc}',
+  '{$i sub/inc1.inc}',
+  'var',
+  '  n: nummer;',
+  'begin',
+  'end.']);
+  Compile(['test1.pas','-Jc']);
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
 begin
   AddUnit('system.pp',[''],['']);