From 37be0713e482b5aeccfe5896fe205cfaa6f5d0a7 Mon Sep 17 00:00:00 2001
From: Kevin Buhr <buhr@asaurus.net>
Date: Fri, 3 May 2019 18:15:44 -0500
Subject: [PATCH] Handle trailing path separator in package DB names (#16360)
Package DB directories with trailing separator (provided via
GHC_PACKAGE_PATH or via -package-db) resulted in incorrect calculation of
${pkgroot} substitution variable. Keep the trailing separator while
resolving as directory or file, but remove it before dropping the last
path component with takeDirectory.
Closes #16360.
---
compiler/main/Packages.hs | 6 ++++--
testsuite/tests/driver/T16360/Hello.hs | 3 +++
testsuite/tests/driver/T16360/Makefile | 17 +++++++++++++++++
testsuite/tests/driver/T16360/all.T | 1 +
testsuite/tests/driver/T16360/test/Test.hs | 4 ++++
testsuite/tests/driver/T16360/test/test.pkg | 8 ++++++++
6 files changed, 37 insertions(+), 2 deletions(-)
create mode 100644 testsuite/tests/driver/T16360/Hello.hs
create mode 100644 testsuite/tests/driver/T16360/Makefile
create mode 100644 testsuite/tests/driver/T16360/all.T
create mode 100644 testsuite/tests/driver/T16360/test/Test.hs
create mode 100644 testsuite/tests/driver/T16360/test/test.pkg
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 2275267d14c..dd12101bcb0 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -559,13 +559,15 @@ readPackageConfig dflags conf_file = do
"can't find a package database at " ++ conf_file
let
+ -- Fix #16360: remove trailing slash from conf_file before calculting pkgroot
+ conf_file' = dropTrailingPathSeparator conf_file
top_dir = topDir dflags
- pkgroot = takeDirectory conf_file
+ pkgroot = takeDirectory conf_file'
pkg_configs1 = map (mungePackageConfig top_dir pkgroot)
proto_pkg_configs
pkg_configs2 = setBatchPackageFlags dflags pkg_configs1
--
- return (conf_file, pkg_configs2)
+ return (conf_file', pkg_configs2)
where
readDirStylePackageConfig conf_dir = do
let filename = conf_dir </> "package.cache"
diff --git a/testsuite/tests/driver/T16360/Hello.hs b/testsuite/tests/driver/T16360/Hello.hs
new file mode 100644
index 00000000000..56109fa8bfa
--- /dev/null
+++ b/testsuite/tests/driver/T16360/Hello.hs
@@ -0,0 +1,3 @@
+import Test
+
+main = print test
diff --git a/testsuite/tests/driver/T16360/Makefile b/testsuite/tests/driver/T16360/Makefile
new file mode 100644
index 00000000000..67dcf80ba82
--- /dev/null
+++ b/testsuite/tests/driver/T16360/Makefile
@@ -0,0 +1,17 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+LOCAL_PKGCONF=package.conf.d
+
+clean:
+ rm -f test/*.o test/*.hi *.o *.hi
+ rm -rf $(LOCAL_PKGCONF)
+
+.PHONY: T16360
+T16360:
+ @rm -rf $(LOCAL_PKGCONF)
+ "$(TEST_HC)" $(TEST_HC_OPTS) -this-unit-id test-1.0 -c test/Test.hs
+ "$(GHC_PKG)" init $(LOCAL_PKGCONF)
+ "$(GHC_PKG)" --no-user-package-db -f $(LOCAL_PKGCONF) register test/test.pkg -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) -package-db $(LOCAL_PKGCONF)/ -c Hello.hs
diff --git a/testsuite/tests/driver/T16360/all.T b/testsuite/tests/driver/T16360/all.T
new file mode 100644
index 00000000000..1cc19459f92
--- /dev/null
+++ b/testsuite/tests/driver/T16360/all.T
@@ -0,0 +1 @@
+test('T16360', [extra_files(['Hello.hs', 'test/'])], makefile_test, [])
diff --git a/testsuite/tests/driver/T16360/test/Test.hs b/testsuite/tests/driver/T16360/test/Test.hs
new file mode 100644
index 00000000000..b4d7f27dce7
--- /dev/null
+++ b/testsuite/tests/driver/T16360/test/Test.hs
@@ -0,0 +1,4 @@
+module Test where
+
+test :: Int
+test = 42
diff --git a/testsuite/tests/driver/T16360/test/test.pkg b/testsuite/tests/driver/T16360/test/test.pkg
new file mode 100644
index 00000000000..f925cfe2d99
--- /dev/null
+++ b/testsuite/tests/driver/T16360/test/test.pkg
@@ -0,0 +1,8 @@
+name: test
+version: 1.0
+id: test-1.0
+key: test-1.0
+exposed-modules: Test
+import-dirs: ${pkgroot}/test
+library-dirs: ${pkgroot}/test
+exposed: True
--
GitLab