Skip to content

Commit 49cb62d

Browse files
luispedrohs-viktor
authored andcommitted
Improve errors for 2-argument ByteString functions
Same as done for FilePath versions in 484566b
1 parent 29c3f67 commit 49cb62d

File tree

3 files changed

+43
-14
lines changed

3 files changed

+43
-14
lines changed

System/Posix/ByteString/FilePath.hsc

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ module System.Posix.ByteString.FilePath (
2525
throwErrnoPathIf_,
2626
throwErrnoPathIfNull,
2727
throwErrnoPathIfMinus1,
28-
throwErrnoPathIfMinus1_
28+
throwErrnoPathIfMinus1_,
29+
throwErrnoTwoPathsIfMinus1_
2930
) where
3031

3132
import Foreign hiding ( void )
@@ -41,6 +42,9 @@ import Control.Monad
4142
import Data.ByteString
4243
import Data.ByteString.Char8 as BC
4344
import Prelude hiding (FilePath)
45+
#if !MIN_VERSION_base(4, 11, 0)
46+
import Data.Monoid ((<>))
47+
#endif
4448

4549
-- | A literal POSIX file path
4650
type RawFilePath = ByteString
@@ -121,3 +125,9 @@ throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
121125
--
122126
throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
123127
throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1)
128+
129+
-- | as 'throwErrnoTwoPathsIfMinus1_', but exceptions include two paths when appropriate.
130+
--
131+
throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> RawFilePath -> IO a -> IO ()
132+
throwErrnoTwoPathsIfMinus1_ loc path1 path2 =
133+
throwErrnoIfMinus1_ (loc <> " '" <> BC.unpack path1 <> "' to '" <> BC.unpack path2 <> "'")

System/Posix/Files/ByteString.hsc

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -234,7 +234,7 @@ createLink :: RawFilePath -> RawFilePath -> IO ()
234234
createLink name1 name2 =
235235
withFilePath name1 $ \s1 ->
236236
withFilePath name2 $ \s2 ->
237-
throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2)
237+
throwErrnoTwoPathsIfMinus1_ "createLink" name1 name2 (c_link s1 s2)
238238

239239
-- | @removeLink path@ removes the link named @path@.
240240
--
@@ -255,10 +255,10 @@ removeLink name =
255255
--
256256
-- Note: calls @symlink@.
257257
createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
258-
createSymbolicLink file1 file2 =
259-
withFilePath file1 $ \s1 ->
260-
withFilePath file2 $ \s2 ->
261-
throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2)
258+
createSymbolicLink name1 name2 =
259+
withFilePath name1 $ \s1 ->
260+
withFilePath name2 $ \s2 ->
261+
throwErrnoTwoPathsIfMinus1_ "createSymbolicLink" name1 name2 (c_symlink s1 s2)
262262

263263
foreign import ccall unsafe "symlink"
264264
c_symlink :: CString -> CString -> IO CInt
@@ -296,7 +296,7 @@ rename :: RawFilePath -> RawFilePath -> IO ()
296296
rename name1 name2 =
297297
withFilePath name1 $ \s1 ->
298298
withFilePath name2 $ \s2 ->
299-
throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2)
299+
throwErrnoTwoPathsIfMinus1_ "rename" name1 name2 (c_rename s1 s2)
300300

301301
foreign import ccall unsafe "rename"
302302
c_rename :: CString -> CString -> IO CInt

tests/FileStatusByteString.hs

Lines changed: 26 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -9,18 +9,21 @@ module FileStatusByteString (main) where
99
import System.Posix.ByteString
1010
import Control.Exception as E
1111
import Control.Monad
12+
import Test.Tasty.HUnit
1213

1314
main = do
1415
cleanup
1516
fs <- testRegular
1617
ds <- testDir
1718
testSymlink fs ds
19+
testLink
1820
cleanup
1921

20-
regular = "regular2"
21-
dir = "dir2"
22-
link_regular = "link-regular2"
23-
link_dir = "link-dir2"
22+
regular = "regular2"
23+
dir = "dir2"
24+
hlink_regular = "hlink-regular2"
25+
slink_regular = "slink-regular2"
26+
link_dir = "link-dir2"
2427

2528
testRegular = do
2629
_ <- createFile regular ownerReadMode
@@ -41,9 +44,9 @@ testDir = do
4144
return ds
4245

4346
testSymlink fs ds = do
44-
createSymbolicLink regular link_regular
47+
createSymbolicLink regular slink_regular
4548
createSymbolicLink dir link_dir
46-
(fs', ls) <- getStatus link_regular
49+
(fs', ls) <- getStatus slink_regular
4750
(ds', lds) <- getStatus link_dir
4851

4952
let expected = (False,False,False,False,False,True,False)
@@ -62,10 +65,26 @@ testSymlink fs ds = do
6265
when (statusElements ds /= statusElements ds') $
6366
fail "status for a directory does not match when it's accessed via a symlink"
6467

68+
testLink = do
69+
createLink regular hlink_regular
70+
(fs, _) <- getStatus regular -- we need to retrieve it again as creating the link causes it to change!
71+
(fs', ls) <- getStatus hlink_regular
72+
snd (statusElements ls) @?= (
73+
False, -- isBlockDevice
74+
False, -- isCharacterDevice
75+
False, -- isNamedPipe
76+
True, -- isRegularFile
77+
False, -- isDirectory
78+
False, -- isSymbolicLink
79+
False) -- isSocket
80+
linkCount fs' == 2 @? "Newly created hard link was expected to have a link count of 2"
81+
statusElements fs @?= statusElements fs' -- status for a file should match when accessed via a link
82+
83+
6584
cleanup = do
6685
ignoreIOExceptions $ removeDirectory dir
6786
mapM_ (ignoreIOExceptions . removeLink)
68-
[regular, link_regular, link_dir]
87+
[regular, hlink_regular, slink_regular, link_dir]
6988

7089
ignoreIOExceptions io = io `E.catch`
7190
((\_ -> return ()) :: IOException -> IO ())

0 commit comments

Comments
 (0)