Use our own (Haskell) pwd to find the tree root

4 files changed, 59 insertions, 4 deletions

diff --git a/aclocal.m4 b/aclocal.m4
index ce8e58511e..3a55ec101c 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -1096,11 +1096,22 @@ AC_REQUIRE([AC_PROG_CC])
 AC_DEFUN([FP_FIND_ROOT],[
 AC_MSG_CHECKING(for path to top of build tree)
 
-hardtop=`pwd`
+dnl This would be
+dnl     make -C utils/pwd clean && make -C utils/pwd
+dnl except we don't want to have to know what make is called. Sigh.
+cd utils/pwd
+rm -f *.o
+rm -f *.hi
+rm -f pwd
+rm -f pwd.exe
+$WithGhc -v0 --make pwd
+cd ../..
+
+hardtop=`utils/pwd/pwd forwardslash`
 
 dnl Remove common automounter nonsense
 dnl
-hardtop=`echo $hardtop | sed 's|^/tmp_mnt.*\(/local/.*\)$|\1|' | sed 's|^/tmp_mnt/|/|' | sed 's|^//\(.\)/|\1:/|' `
+hardtop=`echo $hardtop | sed 's|^/tmp_mnt.*\(/local/.*\)$|\1|' | sed 's|^/tmp_mnt/|/|'`
 
 dnl Find 'hardtop_plat', the native format for 'hardtop'
 dnl (i.e., right kind of \dnl slashes on a Win32 box, but with b-slashes
diff --git a/configure.ac b/configure.ac
index 8f7b0ab17f..e37972124c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -609,8 +609,6 @@ AC_SUBST(TargetVendor_CPP)
 
 AC_SUBST(exeext)
 
-FP_FIND_ROOT
-
 dnl --------------------------------------------------------------
 dnl * Project specific configuration options
 dnl --------------------------------------------------------------
@@ -632,6 +630,8 @@ AC_ARG_WITH([ghc],
   WithGhc="$GHC"])
 AC_SUBST([WithGhc])
 
+FP_FIND_ROOT
+
 AC_ARG_WITH(hc,
 [AC_HELP_STRING([--with-hc=ARG],
         [Use ARG as the path to the compiler for compiling ordinary
diff --git a/utils/pwd/Makefile b/utils/pwd/Makefile
new file mode 100644
index 0000000000..326c707641
--- /dev/null
+++ b/utils/pwd/Makefile
@@ -0,0 +1,18 @@
+
+# We don't include any of the boilerplate Makefiles as we are used
+# by configure. GHC should be overridden on the command line to the
+# GHC that you want to use.
+
+GHC=ghc
+
+.PHONY: all clean
+
+all:
+	$(GHC) --make pwd
+
+clean:
+	rm -f *.o
+	rm -f *.hi
+	rm -f pwd
+	rm -f pwd.exe
+
diff --git a/utils/pwd/pwd.hs b/utils/pwd/pwd.hs
new file mode 100644
index 0000000000..264cc982e9
--- /dev/null
+++ b/utils/pwd/pwd.hs
@@ -0,0 +1,26 @@
+
+module Main where
+
+import System.Directory
+import System.Environment
+
+main :: IO ()
+main = do args <- getArgs
+          let escape = case args of
+                       ["quadruple-backslash"] -> escape_quadruple_backslash
+                       ["forwardslash"] -> escape_forwardslash
+                       _ -> error ("pwd: Bad args: " ++ show args)
+          d <- getCurrentDirectory
+          putStr $ concatMap escape d
+
+-- In prog006 we have to escape \ twice, once to get through sed and
+-- again to get through parsing pkg.conf
+escape_quadruple_backslash :: Char -> String
+escape_quadruple_backslash '\\' = "\\\\\\\\"
+escape_quadruple_backslash c = [c]
+
+-- Normally we can get away with just replacing backslashes with forwardslashes
+escape_forwardslash :: Char -> String
+escape_forwardslash '\\' = "/"
+escape_forwardslash c = [c]
+