Przeglądaj źródła

* fixed unitdir directive for relative paths in case the current module's
path is not set, broken by r43312 (mantis #37095)

git-svn-id: trunk@45410 -

Jonas Maebe 5 lat temu
rodzic
commit
a88eee4080

+ 2 - 0
.gitattributes

@@ -18289,6 +18289,8 @@ tests/webtbs/tw37013.pp svneol=native#text/plain
 tests/webtbs/tw37060.pp svneol=native#text/plain
 tests/webtbs/tw37062.pp svneol=native#text/pascal
 tests/webtbs/tw3708.pp svneol=native#text/plain
+tests/webtbs/tw37095.pp svneol=native#text/plain
+tests/webtbs/tw37095d/uw37095.pp svneol=native#text/plain
 tests/webtbs/tw3719.pp svneol=native#text/plain
 tests/webtbs/tw3721.pp svneol=native#text/plain
 tests/webtbs/tw3742.pp svneol=native#text/plain

+ 9 - 5
compiler/scandir.pas

@@ -1503,15 +1503,19 @@ unit scandir;
       end;
 
     procedure dir_unitpath;
+      var
+        unitpath: TPathStr;
       begin
         if not current_module.in_global then
          Message(scan_w_switch_is_global)
         else
-          with current_scanner,current_module,localunitsearchpath do
-            begin
-              skipspace;
-              AddPath(path+source_info.DirSep+readcomment,false);
-            end;
+          begin
+            current_scanner.skipspace;
+            unitpath:=current_scanner.readcomment;
+            if current_module.path<>'' then
+             unitpath:=current_module.path+source_info.DirSep+unitpath;
+            current_module.localunitsearchpath.AddPath(unitpath,false);
+          end;
       end;
 
     procedure dir_varparacopyoutcheck;

+ 10 - 0
tests/webtbs/tw37095.pp

@@ -0,0 +1,10 @@
+{ %norun }
+{ %recompile }
+
+program test;
+{$UNITPATH tw37095d}
+uses uw37095;
+begin
+  writeln('Say hello, unit!');
+  UnitHello;
+end.

+ 10 - 0
tests/webtbs/tw37095d/uw37095.pp

@@ -0,0 +1,10 @@
+ unit uw37095;
+interface
+  procedure UnitHello;
+implementation
+  procedure UnitHello;
+  begin
+    writeln('"Hello, unit."');
+  end;
+begin
+end.