[commit: ghc] master: GHC doesn't handle ./ prefixed paths correctly (#12674) (a7c8acd)

git at git.haskell.org git at git.haskell.org
Mon Jul 30 20:39:01 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a7c8acda5c7ad99fa983bbd5e59480ab5e633c54/ghc

>---------------------------------------------------------------

commit a7c8acda5c7ad99fa983bbd5e59480ab5e633c54
Author: roland <rsx at bluewin.ch>
Date:   Mon Jul 30 21:34:20 2018 +0100

    GHC doesn't handle ./ prefixed paths correctly (#12674)
    
    Summary: If a filename starts with a hypen, GHC keeps the prefixed "./" path.
    
    Test Plan: make test TEST=T12674
    
    Reviewers: Phyx, nomeata, bgamari, erikd
    
    Reviewed By: Phyx
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #12674
    
    Differential Revision: https://phabricator.haskell.org/D5009


>---------------------------------------------------------------

a7c8acda5c7ad99fa983bbd5e59480ab5e633c54
 ghc/Main.hs                                  | 20 +++++++++++++++++---
 testsuite/tests/driver/T12674/-T12674.hs     | 10 ++++++++++
 testsuite/tests/driver/T12674/-T12674c.c     |  6 ++++++
 testsuite/tests/driver/T12674/T12674.stdout  |  1 +
 testsuite/tests/driver/T12674/T12674w.stdout |  1 +
 testsuite/tests/driver/T12674/all.T          |  5 +++++
 6 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/ghc/Main.hs b/ghc/Main.hs
index ea80910..03ac60d 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -213,9 +213,23 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   let
      -- To simplify the handling of filepaths, we normalise all filepaths right
-     -- away - e.g., for win32 platforms, backslashes are converted
-     -- into forward slashes.
-    normal_fileish_paths = map (normalise . unLoc) fileish_args
+     -- away. Note the asymmetry of FilePath.normalise:
+     --    Linux:   p/q -> p/q; p\q -> p\q
+     --    Windows: p/q -> p\q; p\q -> p\q
+     -- #12674: Filenames starting with a hypen get normalised from ./-foo.hs
+     -- to -foo.hs. We have to re-prepend the current directory.
+    normalise_hyp fp
+        | strt_dot_sl && "-" `isPrefixOf` nfp = cur_dir ++ nfp
+        | otherwise                           = nfp
+        where
+#if defined(mingw32_HOST_OS)
+          strt_dot_sl = "./" `isPrefixOf` fp || ".\\" `isPrefixOf` fp
+#else
+          strt_dot_sl = "./" `isPrefixOf` fp
+#endif
+          cur_dir = '.' : [pathSeparator]
+          nfp = normalise fp
+    normal_fileish_paths = map (normalise_hyp . unLoc) fileish_args
     (srcs, objs)         = partition_args normal_fileish_paths [] []
 
     dflags5 = dflags4 { ldInputs = map (FileOption "") objs
diff --git a/testsuite/tests/driver/T12674/-T12674.hs b/testsuite/tests/driver/T12674/-T12674.hs
new file mode 100644
index 0000000..11a7c54
--- /dev/null
+++ b/testsuite/tests/driver/T12674/-T12674.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+import Foreign.C
+foreign import ccall unsafe "test" test :: CInt -> IO ()
+
+main :: IO ()
+-- Use conditional language to test passing a file with a filename
+-- starting with a hyphen to the preprocessor.
+#if defined(__GLASGOW_HASKELL__)
+main = test 3
+#endif
diff --git a/testsuite/tests/driver/T12674/-T12674c.c b/testsuite/tests/driver/T12674/-T12674c.c
new file mode 100644
index 0000000..3b38c58
--- /dev/null
+++ b/testsuite/tests/driver/T12674/-T12674c.c
@@ -0,0 +1,6 @@
+#include <stdio.h>
+void test(int arg
+)
+{
+   printf("Result %i\n", arg );
+}
diff --git a/testsuite/tests/driver/T12674/T12674.stdout b/testsuite/tests/driver/T12674/T12674.stdout
new file mode 100644
index 0000000..76239dd
--- /dev/null
+++ b/testsuite/tests/driver/T12674/T12674.stdout
@@ -0,0 +1 @@
+Result 3
diff --git a/testsuite/tests/driver/T12674/T12674w.stdout b/testsuite/tests/driver/T12674/T12674w.stdout
new file mode 100644
index 0000000..76239dd
--- /dev/null
+++ b/testsuite/tests/driver/T12674/T12674w.stdout
@@ -0,0 +1 @@
+Result 3
diff --git a/testsuite/tests/driver/T12674/all.T b/testsuite/tests/driver/T12674/all.T
new file mode 100644
index 0000000..0f9e205
--- /dev/null
+++ b/testsuite/tests/driver/T12674/all.T
@@ -0,0 +1,5 @@
+test('T12674', [extra_files(['-T12674.hs', '-T12674c.c'])],
+                multi_compile, ['./-T12674.hs', [('././-T12674c.c', '')], '-v0'])
+test('T12674w', [extra_files(['-T12674.hs', '-T12674c.c']),
+                unless(opsys('mingw32'), skip)],
+                multi_compile, ['.\\\-T12674.hs', [('.\\\.\\\-T12674c.c', '')], '-v0'])



More information about the ghc-commits mailing list