Browse Source

* patch by Aleksa Todorovic: store relative include paths in PPUs, resolves #9961

git-svn-id: trunk@23897 -
florian 12 years ago
parent
commit
5a6e879248

+ 4 - 0
.gitattributes

@@ -13996,6 +13996,10 @@ tests/webtbs/tw9894a.pp svneol=native#text/plain
 tests/webtbs/tw9897.pp svneol=native#text/plain
 tests/webtbs/tw9897.pp svneol=native#text/plain
 tests/webtbs/tw9918.pp svneol=native#text/plain
 tests/webtbs/tw9918.pp svneol=native#text/plain
 tests/webtbs/tw9919.pp svneol=native#text/plain
 tests/webtbs/tw9919.pp svneol=native#text/plain
+tests/webtbs/tw9961.pp svneol=native#text/pascal
+tests/webtbs/tw9961/file1.inc svneol=native#text/plain
+tests/webtbs/tw9961a.pp svneol=native#text/pascal
+tests/webtbs/tw9961b.pp svneol=native#text/pascal
 tests/webtbs/tw9985.pp svneol=native#text/plain
 tests/webtbs/tw9985.pp svneol=native#text/plain
 tests/webtbs/tw9985a.pp svneol=native#text/plain
 tests/webtbs/tw9985a.pp svneol=native#text/plain
 tests/webtbs/u_uvmta.pp svneol=native#text/pascal
 tests/webtbs/u_uvmta.pp svneol=native#text/pascal

+ 2 - 0
compiler/finput.pas

@@ -38,6 +38,7 @@ interface
 
 
        tinputfile = class
        tinputfile = class
          path,name : TPathStr;       { path and filename }
          path,name : TPathStr;       { path and filename }
+         inc_path  : TPathStr;       { path if file was included with $I directive }
          next      : tinputfile;    { next file for reading }
          next      : tinputfile;    { next file for reading }
 
 
          is_macro,
          is_macro,
@@ -195,6 +196,7 @@ uses
       begin
       begin
         name:=ExtractFileName(fn);
         name:=ExtractFileName(fn);
         path:=ExtractFilePath(fn);
         path:=ExtractFilePath(fn);
+        inc_path:='';
         next:=nil;
         next:=nil;
         filetime:=-1;
         filetime:=-1;
       { file info }
       { file info }

+ 5 - 2
compiler/fppu.pas

@@ -493,7 +493,7 @@ var
             hp:=sourcefiles.files;
             hp:=sourcefiles.files;
             for i:=1 to j-1 do
             for i:=1 to j-1 do
               hp:=hp.ref_next;
               hp:=hp.ref_next;
-            ppufile.putstring(hp.name);
+            ppufile.putstring(hp.inc_path+hp.name);
             ppufile.putlongint(hp.getfiletime);
             ppufile.putlongint(hp.getfiletime);
             dec(j);
             dec(j);
          end;
          end;
@@ -711,6 +711,7 @@ var
     procedure tppumodule.readsourcefiles;
     procedure tppumodule.readsourcefiles;
       var
       var
         temp,hs       : string;
         temp,hs       : string;
+        inc_path      : string;
         temp_dir      : TCmdStr;
         temp_dir      : TCmdStr;
         main_dir      : TCmdStr;
         main_dir      : TCmdStr;
         found,
         found,
@@ -724,7 +725,8 @@ var
         main_dir:='';
         main_dir:='';
         while not ppufile.endofentry do
         while not ppufile.endofentry do
          begin
          begin
-           hs:=ppufile.getstring;
+           hs:=SetDirSeparators(ppufile.getstring);
+           inc_path:=ExtractFilePath(hs);
            orgfiletime:=ppufile.getlongint;
            orgfiletime:=ppufile.getlongint;
            temp_dir:='';
            temp_dir:='';
            if sources_avail then
            if sources_avail then
@@ -793,6 +795,7 @@ var
                       temp:=' not found';
                       temp:=' not found';
                     end;
                     end;
                   hp:=tdosinputfile.create(hs);
                   hp:=tdosinputfile.create(hs);
+                  hp.inc_path:=inc_path;
                   { the indexing is wrong here PM }
                   { the indexing is wrong here PM }
                   sourcefiles.register_file(hp);
                   sourcefiles.register_file(hp);
                 end;
                 end;

+ 9 - 0
tests/webtbs/tw9961.pp

@@ -0,0 +1,9 @@
+program test; {$mode objfpc} {$H+}
+
+uses
+  tw9961a;
+
+  {$I tw9961/file1}
+
+begin
+end.

+ 4 - 0
tests/webtbs/tw9961/file1.inc

@@ -0,0 +1,4 @@
+procedure testing;
+begin
+  writeln('test');
+end;

+ 10 - 0
tests/webtbs/tw9961a.pp

@@ -0,0 +1,10 @@
+unit tw9961a; {$mode objfpc} {$H+}
+
+interface
+  uses tw9961b;
+
+implementation
+
+  {$I tw9961/file1}
+
+end.

+ 9 - 0
tests/webtbs/tw9961b.pp

@@ -0,0 +1,9 @@
+unit tw9961b; {$mode objfpc} {$H+}
+
+interface
+
+implementation
+
+
+
+end.