Skip to content

Commit c30b8f3

Browse files
philderbeastphilderbeast
committed
Include cabal-testsuite/src for formatting
- Apply make style with cabal-testsuite/src included - Satisfy -Wunused-imports
1 parent 8e8a839 commit c30b8f3

File tree

13 files changed

+2274
-1949
lines changed

13 files changed

+2274
-1949
lines changed

‎Makefile‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ FORMAT_DIRS := \
3232
Cabal \
3333
Cabal-syntax \
3434
cabal-install \
35+
cabal-testsuite/src \
3536
cabal-validate
3637

3738
FORMAT_DIRS_TODO := \
@@ -46,7 +47,6 @@ FORMAT_DIRS_TODO := \
4647
cabal-dev-scripts \
4748
cabal-install-solver \
4849
cabal-testsuite/main \
49-
cabal-testsuite/src \
5050
cabal-testsuite/static \
5151
solver-benchmarks
5252

‎cabal-testsuite/src/Test/Cabal/CheckArMetadata.hs‎

Lines changed: 43 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
11
----------------------------------------------------------------------------
2+
----------------------------------------------------------------------------
3+
{-# LANGUAGE OverloadedStrings #-}
4+
25
-- |
36
-- Module : Test.Cabal.CheckArMetadata
47
-- Created : 8 July 2017
@@ -7,10 +10,6 @@
710
-- One of the crucial properties of .a files is that they must be
811
-- deterministic - i.e. they must not include creation date as their
912
-- contents to facilitate deterministic builds.
10-
----------------------------------------------------------------------------
11-
12-
{-# LANGUAGE OverloadedStrings #-}
13-
1413
module Test.Cabal.CheckArMetadata (checkMetadata) where
1514

1615
import Test.Cabal.Prelude
@@ -20,22 +19,28 @@ import qualified Data.ByteString.Char8 as BS8
2019
import Data.Char (isSpace)
2120
import System.IO
2221

23-
import Distribution.Package (getHSLibraryName)
22+
import Distribution.Package (getHSLibraryName)
2423
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, localUnitId)
2524

2625
-- Almost a copypasta of Distribution.Simple.Program.Ar.wipeMetadata
2726
checkMetadata :: LocalBuildInfo -> FilePath -> IO ()
28-
checkMetadata lbi dir = withBinaryFile path ReadMode $ \ h ->
27+
checkMetadata lbi dir = withBinaryFile path ReadMode $ \h ->
2928
hFileSize h >>= checkArchive h
3029
where
3130
path = dir </> "lib" ++ getHSLibraryName (localUnitId lbi) ++ ".a"
3231

33-
checkError msg = assertFailure (
34-
"PackageTests.DeterministicAr.checkMetadata: " ++ msg ++
35-
" in " ++ path) >> undefined
32+
checkError msg =
33+
assertFailure
34+
( "PackageTests.DeterministicAr.checkMetadata: "
35+
++ msg
36+
++ " in "
37+
++ path
38+
)
39+
>> undefined
3640
archLF = "!<arch>\x0a" -- global magic, 8 bytes
3741
x60LF = "\x60\x0a" -- header magic, 2 bytes
38-
metadata = BS.concat
42+
metadata =
43+
BS.concat
3944
[ "0 " -- mtime, 12 bytes
4045
, "0 " -- UID, 6 bytes
4146
, "0 " -- GID, 6 bytes
@@ -46,36 +51,39 @@ checkMetadata lbi dir = withBinaryFile path ReadMode $ \ h ->
4651
-- http://en.wikipedia.org/wiki/Ar_(Unix)#File_format_details
4752
checkArchive :: Handle -> Integer -> IO ()
4853
checkArchive h archiveSize = do
49-
global <- BS.hGet h (BS.length archLF)
50-
unless (global == archLF) $ checkError "Bad global header"
51-
checkHeader (toInteger $ BS.length archLF)
52-
54+
global <- BS.hGet h (BS.length archLF)
55+
unless (global == archLF) $ checkError "Bad global header"
56+
checkHeader (toInteger $ BS.length archLF)
5357
where
5458
checkHeader :: Integer -> IO ()
5559
checkHeader offset = case compare offset archiveSize of
56-
EQ -> return ()
57-
GT -> checkError (atOffset "Archive truncated")
58-
LT -> do
59-
header <- BS.hGet h headerSize
60-
unless (BS.length header == headerSize) $
61-
checkError (atOffset "Short header")
62-
let magic = BS.drop 58 header
63-
unless (magic == x60LF) . checkError . atOffset $
64-
"Bad magic " ++ show magic ++ " in header"
65-
66-
unless (metadata == BS.take 32 (BS.drop 16 header))
67-
. checkError . atOffset $ "Metadata has changed"
60+
EQ -> return ()
61+
GT -> checkError (atOffset "Archive truncated")
62+
LT -> do
63+
header <- BS.hGet h headerSize
64+
unless (BS.length header == headerSize) $
65+
checkError (atOffset "Short header")
66+
let magic = BS.drop 58 header
67+
unless (magic == x60LF) . checkError . atOffset $
68+
"Bad magic " ++ show magic ++ " in header"
6869

69-
let size = BS.take 10 $ BS.drop 48 header
70-
objSize <- case reads (BS8.unpack size) of
71-
[(n, s)] | all isSpace s -> return n
72-
_ -> checkError (atOffset "Bad file size in header")
70+
unless (metadata == BS.take 32 (BS.drop 16 header))
71+
. checkError
72+
. atOffset
73+
$ "Metadata has changed"
7374

74-
let nextHeader = offset + toInteger headerSize +
75-
-- Odd objects are padded with an extra '\x0a'
76-
if odd objSize then objSize + 1 else objSize
77-
hSeek h AbsoluteSeek nextHeader
78-
checkHeader nextHeader
75+
let size = BS.take 10 $ BS.drop 48 header
76+
objSize <- case reads (BS8.unpack size) of
77+
[(n, s)] | all isSpace s -> return n
78+
_ -> checkError (atOffset "Bad file size in header")
7979

80+
let nextHeader =
81+
offset
82+
+ toInteger headerSize
83+
+
84+
-- Odd objects are padded with an extra '\x0a'
85+
if odd objSize then objSize + 1 else objSize
86+
hSeek h AbsoluteSeek nextHeader
87+
checkHeader nextHeader
8088
where
8189
atOffset msg = msg ++ " at offset " ++ show offset

‎cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs‎

Lines changed: 49 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,27 +1,28 @@
11
{-# LANGUAGE DeriveGeneric #-}
2-
{-# LANGUAGE RecordWildCards #-}
32
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE RecordWildCards #-}
4+
45
module Test.Cabal.DecodeShowBuildInfo where
56

6-
import Test.Cabal.Prelude
7-
import Test.Cabal.Plan
8-
import Distribution.Compat.Stack
9-
import Distribution.Text (display)
10-
import Distribution.Types.ComponentName
11-
import Distribution.Types.LibraryName
12-
import Distribution.Types.UnqualComponentName
13-
import Distribution.Package
14-
import Distribution.Pretty (prettyShow)
15-
import Control.Monad.Trans.Reader
16-
import Data.Aeson
17-
import GHC.Generics
18-
import System.Exit
7+
import Control.Monad.Trans.Reader
8+
import Data.Aeson
9+
import Distribution.Compat.Stack
10+
import Distribution.Package
11+
import Distribution.Pretty (prettyShow)
12+
import Distribution.Text (display)
13+
import Distribution.Types.ComponentName
14+
import Distribution.Types.LibraryName
15+
import Distribution.Types.UnqualComponentName
16+
import GHC.Generics
17+
import System.Exit
18+
import Test.Cabal.Plan
19+
import Test.Cabal.Prelude
1920

2021
-- | Execute 'cabal build --enable-build-info'.
2122
--
2223
-- Results can be read via 'withPlan', 'buildInfoFile' and 'decodeBuildInfoFile'.
2324
runShowBuildInfo :: [String] -> TestM ()
24-
runShowBuildInfo args = noCabalPackageDb $ cabal "build" ("--enable-build-info":args)
25+
runShowBuildInfo args = noCabalPackageDb $ cabal "build" ("--enable-build-info" : args)
2526

2627
-- | Read 'build-info.json' for a given package and component
2728
-- from disk and record the content. Helpful for defining test-cases
@@ -51,13 +52,15 @@ data BuildInfo = BuildInfo
5152
{ cabalLibVersion :: String
5253
, compiler :: CompilerInfo
5354
, components :: [ComponentInfo]
54-
} deriving (Generic, Show)
55+
}
56+
deriving (Generic, Show)
5557

5658
data CompilerInfo = CompilerInfo
5759
{ flavour :: String
5860
, compilerId :: String
5961
, path :: String
60-
} deriving (Generic, Show)
62+
}
63+
deriving (Generic, Show)
6164

6265
data ComponentInfo = ComponentInfo
6366
{ componentType :: String
@@ -68,22 +71,23 @@ data ComponentInfo = ComponentInfo
6871
, componentSrcFiles :: [FilePath]
6972
, componentHsSrcDirs :: [FilePath]
7073
, componentSrcDir :: FilePath
71-
} deriving (Generic, Show)
74+
}
75+
deriving (Generic, Show)
7276

7377
instance ToJSON BuildInfo where
7478
toEncoding = genericToEncoding defaultOptions
7579
instance FromJSON BuildInfo where
76-
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' }
80+
parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = camelTo2 '-'}
7781

7882
instance ToJSON CompilerInfo where
7983
toEncoding = genericToEncoding defaultOptions
8084
instance FromJSON CompilerInfo where
81-
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' }
85+
parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = camelTo2 '-'}
8286

8387
instance ToJSON ComponentInfo where
8488
toEncoding = genericToEncoding defaultOptions
8589
instance FromJSON ComponentInfo where
86-
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' }
90+
parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = drop 10 . camelTo2 '-'}
8791

8892
-- -----------------------------------------------------------
8993
-- Assertion Helpers to define succinct test cases
@@ -105,14 +109,15 @@ data ComponentAssertion = ComponentAssertion
105109
}
106110

107111
defCompAssertion :: ComponentAssertion
108-
defCompAssertion = ComponentAssertion
109-
{ unitIdPred = not . null
110-
, compilerArgsPred = not . null
111-
, modules = []
112-
, sourceFiles = []
113-
, sourceDirs = []
114-
, compType = ""
115-
}
112+
defCompAssertion =
113+
ComponentAssertion
114+
{ unitIdPred = not . null
115+
, compilerArgsPred = not . null
116+
, modules = []
117+
, sourceFiles = []
118+
, sourceDirs = []
119+
, compType = ""
120+
}
116121

117122
-- | Assert common build information, such as compiler location, compiler version
118123
-- and cabal library version.
@@ -128,8 +133,8 @@ assertCommonBuildInfo buildInfo = do
128133
assertComponentPure :: WithCallStack (ComponentInfo -> ComponentAssertion -> TestM ())
129134
assertComponentPure component ComponentAssertion{..} = do
130135
assertEqual "Component type" compType (componentType component)
131-
assertBool "Component Unit Id" (unitIdPred $ componentUnitId component)
132-
assertBool "Component compiler args" (compilerArgsPred $ componentCompilerArgs component)
136+
assertBool "Component Unit Id" (unitIdPred $ componentUnitId component)
137+
assertBool "Component compiler args" (compilerArgsPred $ componentCompilerArgs component)
133138
assertEqual "Component modules" modules (componentModules component)
134139
assertEqual "Component source files" sourceFiles (componentSrcFiles component)
135140
assertEqual "Component source directories" sourceDirs (componentHsSrcDirs component)
@@ -148,11 +153,11 @@ assertComponent pkgName cname assert = do
148153
assertCommonBuildInfo buildInfo
149154

150155
let component = findComponentInfo buildInfo
151-
let assertWithCompType = assert { compType = compTypeStr cname }
156+
let assertWithCompType = assert{compType = compTypeStr cname}
152157
assertComponentPure component assertWithCompType
153158
where
154159
compTypeStr :: ComponentName -> String
155-
compTypeStr (CLibName _) = "lib"
160+
compTypeStr (CLibName _) = "lib"
156161
compTypeStr (CFLibName _) = "flib"
157162
compTypeStr (CExeName _) = "exe"
158163
compTypeStr (CTestName _) = "test"
@@ -162,10 +167,17 @@ assertComponent pkgName cname assert = do
162167
findComponentInfo buildInfo =
163168
case filter (\c -> prettyShow cname == componentName c) (components buildInfo) of
164169
[x] -> x
165-
[] -> error $ "findComponentInfo: component " ++ prettyShow cname ++ " does not"
166-
++ " exist in build info-file"
167-
_ -> error $ "findComponentInfo: found multiple copies of component " ++ prettyShow cname
168-
++ " in build info plan"
170+
[] ->
171+
error $
172+
"findComponentInfo: component "
173+
++ prettyShow cname
174+
++ " does not"
175+
++ " exist in build info-file"
176+
_ ->
177+
error $
178+
"findComponentInfo: found multiple copies of component "
179+
++ prettyShow cname
180+
++ " in build info plan"
169181

170182
-- | Helper function to create an executable component name.
171183
exe :: String -> ComponentName

0 commit comments

Comments
 (0)