Skip to content

Commit bf74351

Browse files
GuillaumeGenGuillaumeGen
committed
All the functions used in Paths modules are defined
The functions `splitFileNAme` and `minusFileName` are now defined in the same conditional block, ensuring that they cannot be used without being defined. This fix a bug occurring when generating a Paths_ module with --enable-relocatable.
1 parent 9ed8599 commit bf74351

File tree

8 files changed

+105
-47
lines changed

8 files changed

+105
-47
lines changed

‎Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs‎

Lines changed: 27 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,29 @@ render z_root = execWriter $ do
104104
tell "\n"
105105
tell "getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"
106106
tell "\n"
107+
let
108+
z_var0_function_defs = do
109+
tell "minusFileName :: FilePath -> String -> FilePath\n"
110+
tell "minusFileName dir \"\" = dir\n"
111+
tell "minusFileName dir \".\" = dir\n"
112+
tell "minusFileName dir suffix =\n"
113+
tell " minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))\n"
114+
tell "\n"
115+
tell "splitFileName :: FilePath -> (String, String)\n"
116+
tell "splitFileName p = (reverse (path2++drive), reverse fname)\n"
117+
tell " where\n"
118+
tell " (path,drive) = case p of\n"
119+
tell " (c:':':p') -> (reverse p',[':',c])\n"
120+
tell " _ -> (reverse p ,\"\")\n"
121+
tell " (fname,path1) = break isPathSeparator path\n"
122+
tell " path2 = case path1 of\n"
123+
tell " [] -> \".\"\n"
124+
tell " [_] -> path1 -- don't remove the trailing slash if\n"
125+
tell " -- there is only one character\n"
126+
tell " (c:path') | isPathSeparator c -> path'\n"
127+
tell " _ -> path1\n"
128+
return ()
129+
tell "\n"
107130
tell "\n"
108131
if (zRelocatable z_root)
109132
then do
@@ -147,6 +170,8 @@ render z_root = execWriter $ do
147170
tell (zSysconfdir z_root)
148171
tell ")\n"
149172
tell "\n"
173+
z_var0_function_defs
174+
tell "\n"
150175
return ()
151176
else do
152177
if (zAbsolute z_root)
@@ -237,6 +262,8 @@ render z_root = execWriter $ do
237262
tell ") `joinFileName` dirRel)\n"
238263
tell " | otherwise -> try_size (size * 2)\n"
239264
tell "\n"
265+
z_var0_function_defs
266+
tell "\n"
240267
if (zIsI386 z_root)
241268
then do
242269
tell "foreign import stdcall unsafe \"windows.h GetModuleFileNameW\"\n"
@@ -266,31 +293,6 @@ render z_root = execWriter $ do
266293
return ()
267294
tell "\n"
268295
tell "\n"
269-
if (zNot z_root (zAbsolute z_root))
270-
then do
271-
tell "minusFileName :: FilePath -> String -> FilePath\n"
272-
tell "minusFileName dir \"\" = dir\n"
273-
tell "minusFileName dir \".\" = dir\n"
274-
tell "minusFileName dir suffix =\n"
275-
tell " minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))\n"
276-
tell "\n"
277-
tell "splitFileName :: FilePath -> (String, String)\n"
278-
tell "splitFileName p = (reverse (path2++drive), reverse fname)\n"
279-
tell " where\n"
280-
tell " (path,drive) = case p of\n"
281-
tell " (c:':':p') -> (reverse p',[':',c])\n"
282-
tell " _ -> (reverse p ,\"\")\n"
283-
tell " (fname,path1) = break isPathSeparator path\n"
284-
tell " path2 = case path1 of\n"
285-
tell " [] -> \".\"\n"
286-
tell " [_] -> path1 -- don't remove the trailing slash if\n"
287-
tell " -- there is only one character\n"
288-
tell " (c:path') | isPathSeparator c -> path'\n"
289-
tell " _ -> path1\n"
290-
return ()
291-
else do
292-
return ()
293-
tell "\n"
294296
tell "joinFileName :: String -> String -> FilePath\n"
295297
tell "joinFileName \"\" fname = fname\n"
296298
tell "joinFileName \".\" fname = fname\n"

‎cabal-testsuite/PackageTests/PathsModule/Executable-Relocatable/Main.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
module Main where
2+
3+
import Paths_PathsModule (getBinDir)
4+
5+
main :: IO ()
6+
main = do
7+
_ <- getBinDir
8+
return ()

‎cabal-testsuite/PackageTests/PathsModule/Executable-Relocatable/my.cabal‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
name: PathsModule
2+
version: 0.1
3+
license: BSD3
4+
author: Johan Tibell
5+
stability: stable
6+
category: PackageTests
7+
build-type: Simple
8+
Cabal-version: >= 1.2
9+
10+
description:
11+
Check that the generated paths module compiles.
12+
13+
Executable TestPathsModule
14+
main-is: Main.hs
15+
other-modules: Paths_PathsModule
16+
build-depends: base

‎cabal-testsuite/PackageTests/PathsModule/Executable-Relocatable/setup.cabal.out‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Setup configure
2+
Configuring PathsModule-0.1...
3+
# Setup build
4+
Preprocessing executable 'TestPathsModule' for PathsModule-0.1..
5+
Building executable 'TestPathsModule' for PathsModule-0.1..

‎cabal-testsuite/PackageTests/PathsModule/Executable-Relocatable/setup.out‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Setup configure
2+
Configuring PathsModule-0.1...
3+
# Setup build
4+
Preprocessing executable 'TestPathsModule' for PathsModule-0.1..
5+
Building executable 'TestPathsModule' for PathsModule-0.1..

‎cabal-testsuite/PackageTests/PathsModule/Executable-Relocatable/setup.test.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
import Test.Cabal.Prelude
2+
-- Test that Paths module is generated and usable when relocatable is turned on.
3+
4+
main = setupAndCabalTest $ do
5+
skipIfWindows
6+
setup_build ["--enable-relocatable"]

‎changelog.d/pr-8220‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
synopsis: Fix generation of Path_ modules with relocatable
2+
packages: Cabal
3+
prs: #8220
4+
issues: #8219
5+
description: {
6+
7+
The generation of the functions `minusFileName` and `splitFileName`
8+
are now in the same conditional block as their call,
9+
preventing generation of inconsistent Paths_ files
10+
where those functions are used but not defined.
11+
12+
}

‎templates/Paths_pkg.template.hs‎

Lines changed: 26 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,28 @@ getDataFileName name = do
5858

5959
getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
6060

61+
{% defblock function_defs %}
62+
minusFileName :: FilePath -> String -> FilePath
63+
minusFileName dir "" = dir
64+
minusFileName dir "." = dir
65+
minusFileName dir suffix =
66+
minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))
67+
68+
splitFileName :: FilePath -> (String, String)
69+
splitFileName p = (reverse (path2++drive), reverse fname)
70+
where
71+
(path,drive) = case p of
72+
(c:':':p') -> (reverse p',[':',c])
73+
_ -> (reverse p ,"")
74+
(fname,path1) = break isPathSeparator path
75+
path2 = case path1 of
76+
[] -> "."
77+
[_] -> path1 -- don't remove the trailing slash if
78+
-- there is only one character
79+
(c:path') | isPathSeparator c -> path'
80+
_ -> path1
81+
{% endblock %}
82+
6183
{# body #}
6284
{# ######################################################################### #}
6385

@@ -76,6 +98,8 @@ getDataDir = catchIO (getEnv "{{ manglePkgName packageName }}_datadir") (\
7698
getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> getPrefixDirReloc $ {{ libexecdir }})
7799
getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> getPrefixDirReloc $ {{ sysconfdir }})
78100

101+
{% useblock function_defs %}
102+
79103
{% elif absolute %}
80104

81105
bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
@@ -118,6 +142,8 @@ getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
118142
return ((bindir `minusFileName` {{ bindir}}) `joinFileName` dirRel)
119143
| otherwise -> try_size (size * 2)
120144

145+
{% useblock function_defs %}
146+
121147
{% if isI386 %}
122148
foreign import stdcall unsafe "windows.h GetModuleFileNameW"
123149
c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
@@ -140,28 +166,6 @@ notRelocAbsoluteOrWindows = _
140166
{# filename stuff #}
141167
{# ######################################################################### #}
142168

143-
{% if not absolute %}
144-
minusFileName :: FilePath -> String -> FilePath
145-
minusFileName dir "" = dir
146-
minusFileName dir "." = dir
147-
minusFileName dir suffix =
148-
minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))
149-
150-
splitFileName :: FilePath -> (String, String)
151-
splitFileName p = (reverse (path2++drive), reverse fname)
152-
where
153-
(path,drive) = case p of
154-
(c:':':p') -> (reverse p',[':',c])
155-
_ -> (reverse p ,"")
156-
(fname,path1) = break isPathSeparator path
157-
path2 = case path1 of
158-
[] -> "."
159-
[_] -> path1 -- don't remove the trailing slash if
160-
-- there is only one character
161-
(c:path') | isPathSeparator c -> path'
162-
_ -> path1
163-
{% endif %}
164-
165169
joinFileName :: String -> String -> FilePath
166170
joinFileName "" fname = fname
167171
joinFileName "." fname = fname

0 commit comments

Comments
 (0)