[ghc-pkg] Fix #5442 by using the flag db stack to modify packages.

Summary:
Previously, the full database stack was used for ghc-pkg to
modify packages, which meant that commands like
'ghc-pkg unregister --user' worked the same as 'ghc-pkg unregister'.
Since package modification is a "read and write" operation, we
should use the flag db stack (which is currently used for reads)
to determine which database to update.

There is also a new flag --user-package-db, which lets you explicitly
set the user database (as seen by --user).  This was mostly added
to aid in testing, but could be useful for end users as well.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonmar, hvr, austin

Subscribers: simonmar, relrod, carter

Differential Revision: https://phabricator.haskell.org/D84

9 files changed, 101 insertions, 0 deletions

diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile
index f0091bceeb..e8ed2bd817 100644
--- a/testsuite/tests/cabal/Makefile
+++ b/testsuite/tests/cabal/Makefile
@@ -165,6 +165,60 @@ shadow:
 	@echo "should SUCCEED:"
 	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW1) -package-db $(PKGCONFSHADOW2) -package-id shadowdep-1-XXX -c shadow.hs -fno-code
 
+# If we pass --global, we should ignore instances in the user database
+T5442a:
+	@rm -rf package.conf.T5442a.global package.conf.T5442a.user
+	'$(GHC_PKG)' init package.conf.T5442a.global
+	'$(GHC_PKG)' init package.conf.T5442a.user
+	'$(GHC_PKG)' -f package.conf.T5442a.global register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442a.user register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442a.global --user-package-db=package.conf.T5442a.user --global unregister testpkg
+	@echo "global (should be empty):"
+	'$(GHC_PKG)' -f package.conf.T5442a.global list --simple-output
+	@echo "user:"
+	'$(GHC_PKG)' -f package.conf.T5442a.user list --simple-output
+
+# If we pass --user, we should ignore instances in the global database
+T5442b:
+	@rm -rf package.conf.T5442b.global package.conf.T5442b.user
+	'$(GHC_PKG)' init package.conf.T5442b.global
+	'$(GHC_PKG)' init package.conf.T5442b.user
+	'$(GHC_PKG)' -f package.conf.T5442b.global register --force-files test.pkg 2>/dev/null
+	! '$(GHC_PKG)' --global-package-db=package.conf.T5442b.global --user-package-db=package.conf.T5442b.user --user unregister testpkg
+	@echo "global (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442b.global list --simple-output
+
+# If we pass -f, we should ignore the user and global databases
+T5442c:
+	@rm -rf package.conf.T5442c.global package.conf.T5442c.user package.conf.T5442c.extra
+	'$(GHC_PKG)' init package.conf.T5442c.global
+	'$(GHC_PKG)' init package.conf.T5442c.user
+	'$(GHC_PKG)' init package.conf.T5442c.extra
+	'$(GHC_PKG)' -f package.conf.T5442c.global register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442c.user register --force-files test.pkg 2>/dev/null
+	! '$(GHC_PKG)' --global-package-db=package.conf.T5442c.global --user-package-db=package.conf.T5442c.user -f package.conf.T5442c.extra unregister testpkg
+	@echo "global (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442c.global list --simple-output
+	@echo "use (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442c.user list --simple-output
+
+# If we pass --global and -f, we remove from the global database, but
+# warn about possible breakage in the full package stack
+T5442d:
+	@rm -rf package.conf.T5442d.global package.conf.T5442d.user package.conf.T5442d.extra
+	'$(GHC_PKG)' init package.conf.T5442d.global
+	'$(GHC_PKG)' init package.conf.T5442d.user
+	'$(GHC_PKG)' init package.conf.T5442d.extra
+	'$(GHC_PKG)' -f package.conf.T5442d.global register --force-files shadow1.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442d.user register --force-files shadow3.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442d.global -f package.conf.T5442d.extra register --force-files shadow2.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442d.global --user-package-db=package.conf.T5442d.user -f package.conf.T5442d.extra --global unregister shadow --force
+	@echo "global (should be empty):"
+	'$(GHC_PKG)' -f package.conf.T5442d.global list --simple-output
+	@echo "user:"
+	'$(GHC_PKG)' -f package.conf.T5442d.user list --simple-output
+	@echo "extra:"
+	'$(GHC_PKG)' -f package.conf.T5442d.extra list --simple-output
 
 # -----------------------------------------------------------------------------
 # Try piping the output of "ghc-pkg describe" into "ghc-pkg update" for
diff --git a/testsuite/tests/cabal/T5442a.stdout b/testsuite/tests/cabal/T5442a.stdout
new file mode 100644
index 0000000000..7bc64650e0
--- /dev/null
+++ b/testsuite/tests/cabal/T5442a.stdout
@@ -0,0 +1,5 @@
+Reading package info from "test.pkg" ... done.
+Reading package info from "test.pkg" ... done.
+global (should be empty):
+user:
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442b.stderr b/testsuite/tests/cabal/T5442b.stderr
new file mode 100644
index 0000000000..da7439820d
--- /dev/null
+++ b/testsuite/tests/cabal/T5442b.stderr
@@ -0,0 +1 @@
+ghc-pkg: cannot find package testpkg
diff --git a/testsuite/tests/cabal/T5442b.stdout b/testsuite/tests/cabal/T5442b.stdout
new file mode 100644
index 0000000000..42814de517
--- /dev/null
+++ b/testsuite/tests/cabal/T5442b.stdout
@@ -0,0 +1,3 @@
+Reading package info from "test.pkg" ... done.
+global (should have testpkg):
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442c.stderr b/testsuite/tests/cabal/T5442c.stderr
new file mode 100644
index 0000000000..da7439820d
--- /dev/null
+++ b/testsuite/tests/cabal/T5442c.stderr
@@ -0,0 +1 @@
+ghc-pkg: cannot find package testpkg
diff --git a/testsuite/tests/cabal/T5442c.stdout b/testsuite/tests/cabal/T5442c.stdout
new file mode 100644
index 0000000000..a183e595ba
--- /dev/null
+++ b/testsuite/tests/cabal/T5442c.stdout
@@ -0,0 +1,6 @@
+Reading package info from "test.pkg" ... done.
+Reading package info from "test.pkg" ... done.
+global (should have testpkg):
+testpkg-1.2.3.4
+use (should have testpkg):
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442d.stderr b/testsuite/tests/cabal/T5442d.stderr
new file mode 100644
index 0000000000..ae02fa783f
--- /dev/null
+++ b/testsuite/tests/cabal/T5442d.stderr
@@ -0,0 +1 @@
+unregistering shadow would break the following packages: shadowdep-1 (ignoring)
diff --git a/testsuite/tests/cabal/T5442d.stdout b/testsuite/tests/cabal/T5442d.stdout
new file mode 100644
index 0000000000..05c6619dde
--- /dev/null
+++ b/testsuite/tests/cabal/T5442d.stdout
@@ -0,0 +1,8 @@
+Reading package info from "shadow1.pkg" ... done.
+Reading package info from "shadow3.pkg" ... done.
+Reading package info from "shadow2.pkg" ... done.
+global (should be empty):
+user:
+shadow-1
+extra:
+shadowdep-1
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index d05d05fe1e..aa97f48209 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -57,6 +57,28 @@ test('T1750',
                   'localT1750.package.conf.old']),
      run_command, ['$MAKE -s --no-print-directory T1750'])
 
+test('T5442a',
+     [extra_clean(['package.conf.T5442a.global', 'package.conf.T5442a.user'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442a'])
+
+test('T5442b',
+     [extra_clean(['package.conf.T5442b.global', 'package.conf.T5442b.user'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442b'])
+
+test('T5442c',
+     [extra_clean(['package.conf.T5442c.global', 'package.conf.T5442c.user',
+                   'package.conf.T5442c.extra'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442c'])
+
+test('T5442d',
+     [extra_clean(['package.conf.T5442d.global', 'package.conf.T5442d.user',
+                   'package.conf.T5442d.extra'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442d'])
+
 test('shadow',
      extra_clean(['shadow.out', 'shadow.hs', 'shadow.hi',
                   'local1shadow1.package.conf',