From 921fb2f4ecfdf24f0513d377abe66e451ac3a095 Mon Sep 17 00:00:00 2001
From: marco <marco@freepascal.org>
Date: Mon, 18 May 2020 06:52:17 +0000
Subject: [PATCH] --- Merging r45410 into '.': U compiler/scandir.pas A
tests/webtbs/tw37095.pp A tests/webtbs/tw37095d A
tests/webtbs/tw37095d/uw37095.pp --- Recording mergeinfo for merge of r45410
into '.': U .
# revisions: 45410
r45410 | jonas | 2020-05-17 23:27:00 +0200 (Sun, 17 May 2020) | 2 lines
Changed paths:
M /trunk/compiler/scandir.pas
A /trunk/tests/webtbs/tw37095.pp
A /trunk/tests/webtbs/tw37095d
A /trunk/tests/webtbs/tw37095d/uw37095.pp
* fixed unitdir directive for relative paths in case the current module's
path is not set, broken by r43312 (mantis #37095)
git-svn-id: branches/fixes_3_2@45412 -
---
.gitattributes | 2 ++
compiler/scandir.pas | 14 +++++++++-----
tests/webtbs/tw37095.pp | 10 ++++++++++
tests/webtbs/tw37095d/uw37095.pp | 10 ++++++++++
4 files changed, 31 insertions(+), 5 deletions(-)
create mode 100644 tests/webtbs/tw37095.pp
create mode 100644 tests/webtbs/tw37095d/uw37095.pp
diff --git a/.gitattributes b/.gitattributes
index d490b6c00d..4eda0256cf 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -17629,6 +17629,8 @@ tests/webtbs/tw3695.pp svneol=native#text/plain
tests/webtbs/tw3697.pp svneol=native#text/plain
tests/webtbs/tw3700.pp svneol=native#text/plain
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
diff --git a/compiler/scandir.pas b/compiler/scandir.pas
index b7a061ac61..8728ac4f10 100644
--- a/compiler/scandir.pas
+++ b/compiler/scandir.pas
@@ -1486,15 +1486,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;
diff --git a/tests/webtbs/tw37095.pp b/tests/webtbs/tw37095.pp
new file mode 100644
index 0000000000..9aced5a364
--- /dev/null
+++ b/tests/webtbs/tw37095.pp
@@ -0,0 +1,10 @@
+{ %norun }
+{ %recompile }
+
+program test;
+{$UNITPATH tw37095d}
+uses uw37095;
+begin
+ writeln('Say hello, unit!');
+ UnitHello;
+end.
diff --git a/tests/webtbs/tw37095d/uw37095.pp b/tests/webtbs/tw37095d/uw37095.pp
new file mode 100644
index 0000000000..569f26e6bc
--- /dev/null
+++ b/tests/webtbs/tw37095d/uw37095.pp
@@ -0,0 +1,10 @@
+ unit uw37095;
+interface
+ procedure UnitHello;
+implementation
+ procedure UnitHello;
+ begin
+ writeln('"Hello, unit."');
+ end;
+begin
+end.