Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
70b4d9ae
Commit
70b4d9ae
authored
Mar 10, 2008
by
Duncan Coutts
Browse files
Rearange unit tests some more add extract more tests from the other modules
parent
481c4214
Changes
6
Hide whitespace changes
Inline
Side-by-side
tests/
u
nitTest
s/ModuleTest
.hs
→
tests/
U
nitTest.hs
View file @
70b4d9ae
-----------------------------------------------------------------------------
-- |
-- Module :
Distribution.Module
Test
-- Module :
Unit
Test
-- Copyright : Isaac Jones 2003-2004
--
-- Maintainer : Isaac Jones <ijones@syntaxpolice.org>
...
...
@@ -43,8 +43,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module
Main
where
-- Import everything, since we want to test the compilation of them:
import
qualified
Distribution.Version
as
D.V
(
hunitTests
)
import
qualified
PackageDescription
Tests
as
D.PD
(
hunitTests
)
import
qualified
UnitTest.
Distribution.Version
as
D.V
(
hunitTests
)
import
qualified
UnitTest.Distribution.
PackageDescription
as
D.PD
(
hunitTests
)
import
qualified
Distribution.Simple.Configure
as
D.S.C
(
localBuildInfoFile
)
import
qualified
Distribution.Simple.Register
as
D.S.R
(
installedPkgConfigFile
)
...
...
tests/
u
nitTest
s
/PackageDescription
Tests
.hs
→
tests/
U
nitTest
/Distribution
/PackageDescription.hs
View file @
70b4d9ae
File moved
tests/UnitTest/Distribution/PackageDescription/Configuration.hs
0 → 100644
View file @
70b4d9ae
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Configuration
-- Copyright : Thomas Schilling, 2007
--
-- Maintainer : Isaac Jones <ijones@syntaxpolice.org>
-- Stability : alpha
-- Portability : portable
--
-- Configurations
{- All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module
UnitTest.Distribution.PackageDescription.Configuration
where
import
Distribution.PackageDescription.Configuration
import
Distribution.Package
(
Package
)
import
Distribution.PackageDescription
(
GenericPackageDescription
(
..
),
PackageDescription
(
..
)
,
Library
(
..
),
Executable
(
..
),
BuildInfo
(
..
)
,
Flag
(
..
),
CondTree
(
..
),
ConfVar
(
..
),
ConfFlag
(
..
),
Condition
(
..
)
)
import
Distribution.Simple.PackageIndex
(
PackageIndex
)
import
qualified
Distribution.Simple.PackageIndex
as
PackageIndex
import
Distribution.Version
(
Version
(
..
),
Dependency
(
..
),
VersionRange
(
..
)
,
withinRange
,
parseVersionRange
)
import
Distribution.Compiler
(
CompilerFlavor
,
parseCompilerFlavor
)
import
Distribution.System
(
OS
,
readOS
,
Arch
,
readArch
)
import
Distribution.Simple.Utils
(
currentDir
)
import
Distribution.Compat.ReadP
as
ReadP
hiding
(
char
)
import
qualified
Distribution.Compat.ReadP
as
ReadP
(
char
)
import
Data.Char
(
isAlphaNum
,
toLower
)
import
Data.Maybe
(
catMaybes
,
maybeToList
)
import
Data.List
(
nub
)
import
Data.Monoid
import
Data.List
(
(
\\
)
)
import
Distribution.ParseUtils
------------------------------------------------------------------------------
-- Testing
tstTree
::
CondTree
ConfVar
[
Int
]
String
tstTree
=
CondNode
"A"
[
0
]
[
(
CNot
(
Var
(
Flag
(
ConfFlag
"a"
))),
CondNode
"B"
[
1
]
[]
,
Nothing
)
,
(
CAnd
(
Var
(
Flag
(
ConfFlag
"b"
)))
(
Var
(
Flag
(
ConfFlag
"c"
))),
CondNode
"C"
[
2
]
[]
,
Just
$
CondNode
"D"
[
3
]
[
(
Lit
True
,
CondNode
"E"
[
4
]
[]
,
Just
$
CondNode
"F"
[
5
]
[]
)
])
]
test_simplify
=
simplifyWithSysParams
i386
darwin
(
"ghc"
,
Version
[
6
,
6
]
[]
)
tstCond
where
tstCond
=
COr
(
CAnd
(
Var
(
Arch
ppc
))
(
Var
(
OS
darwin
)))
(
CAnd
(
Var
(
Flag
(
ConfFlag
"debug"
)))
(
Var
(
OS
darwin
)))
[
ppc
,
i386
]
=
[
"ppc"
,
"i386"
]
[
darwin
,
windows
]
=
[
"darwin"
,
"windows"
]
test_parseCondition
=
map
(
runP
1
"test"
parseCondition
)
testConditions
where
testConditions
=
[
"os(darwin)"
,
"arch(i386)"
,
"!os(linux)"
,
"! arch(ppc)"
,
"os(windows) && arch(i386)"
,
"os(windows) && arch(i386) && flag(debug)"
,
"true && false || false && true"
-- should be same
,
"(true && false) || (false && true)"
-- as this
,
"(os(darwin))"
,
" ( os ( darwin ) ) "
,
"true && !(false || os(plan9))"
,
"flag( foo_bar )"
,
"flag( foo_O_-_O_bar )"
,
"impl ( ghc )"
,
"impl( ghc >= 6.6.1 )"
]
test_ppCondTree
=
render
$
ppCondTree
tstTree
(
text
.
show
)
test_simpCondTree
=
simplifyCondTree
env
tstTree
where
env
x
=
maybe
(
Left
x
)
Right
(
lookup
x
flags
)
flags
=
[(
mkFlag
"a"
,
False
),
(
mkFlag
"b"
,
False
),
(
mkFlag
"c"
,
True
)]
mkFlag
=
Flag
.
ConfFlag
test_resolveWithFlags
=
resolveWithFlags
dom
"os"
"arch"
(
"ghc"
,
Version
[
6
,
6
]
[]
)
[
tstTree
]
check
where
dom
=
[(
"a"
,
[
False
,
True
]),
(
"b"
,
[
True
,
False
]),
(
"c"
,
[
True
,
False
])]
check
ds
=
let
missing
=
ds
\\
avail
in
case
missing
of
[]
->
DepOk
_
->
MissingDeps
missing
avail
=
[
0
,
1
,
3
,
4
]
test_ignoreConditions
=
ignoreConditions
tstTree
tests/UnitTest/Distribution/ParseUtils.hs
0 → 100644
View file @
70b4d9ae
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.ParseUtils
-- Copyright : (c) The University of Glasgow 2004
--
-- Maintainer : libraries@haskell.org
-- Stability : alpha
-- Portability : portable
--
-- Utilities for parsing PackageDescription and InstalledPackageInfo.
{- All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of the University nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module
UnitTest.Distribution.ParseUtils
where
import
Distribution.ParseUtils
import
Distribution.Compiler
(
CompilerFlavor
,
parseCompilerFlavorCompat
)
import
Distribution.License
(
License
)
import
Distribution.Version
import
Distribution.Package
(
parsePackageName
)
import
Distribution.Compat.ReadP
as
ReadP
hiding
(
get
)
import
Distribution.Simple.Utils
(
intercalate
)
import
Language.Haskell.Extension
(
Extension
)
import
Text.PrettyPrint.HughesPJ
hiding
(
braces
)
import
Data.Char
(
isSpace
,
isUpper
,
toLower
,
isAlphaNum
,
isSymbol
,
isDigit
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Tree
as
Tree
(
Tree
(
..
),
flatten
)
import
Test.HUnit
(
Test
(
..
),
assertBool
,
Assertion
,
runTestTT
,
Counts
,
assertEqual
)
import
IO
import
System.Environment
(
getArgs
)
import
Control.Monad
(
zipWithM_
)
------------------------------------------------------------------------------
-- TESTING
test_readFields
=
case
readFields
testFile
of
ParseOk
_
x
->
x
==
expectedResult
_
->
False
where
testFile
=
unlines
$
[
"Cabal-version: 3"
,
""
,
"Description: This is a test file "
,
" with a description longer than two lines. "
,
"if os(windows) {"
,
" License: You may not use this software"
,
" ."
,
" If you do use this software you will be seeked and destroyed."
,
"}"
,
"if os(linux) {"
,
" Main-is: foo1 "
,
"}"
,
""
,
"if os(vista) {"
,
" executable RootKit {"
,
" Main-is: DRMManager.hs"
,
" }"
,
"} else {"
,
" executable VistaRemoteAccess {"
,
" Main-is: VCtrl"
,
"}}"
,
""
,
"executable Foo-bar {"
,
" Main-is: Foo.hs"
,
"}"
]
expectedResult
=
[
F
1
"cabal-version"
"3"
,
F
3
"description"
"This is a test file
\n
with a description longer than two lines."
,
IfBlock
5
"os(windows) "
[
F
6
"license"
"You may not use this software
\n\n
If you do use this software you will be seeked and destroyed."
]
[]
,
IfBlock
10
"os(linux) "
[
F
11
"main-is"
"foo1"
]
[ ]
,
IfBlock
14
"os(vista) "
[
Section
15
"executable"
"RootKit "
[
F
16
"main-is"
"DRMManager.hs"
]
]
[
Section
19
"executable"
"VistaRemoteAccess "
[
F
20
"main-is"
"VCtrl"
]
]
,
Section
23
"executable"
"Foo-bar "
[
F
24
"main-is"
"Foo.hs"
]
]
test_readFieldsCompat'
=
case
test_readFieldsCompat
of
ParseOk
_
fs
->
mapM_
(
putStrLn
.
show
)
fs
x
->
putStrLn
$
"Failed: "
++
show
x
test_readFieldsCompat
=
readFields
testPkgDesc
where
testPkgDesc
=
unlines
[
"-- Required"
,
"Name: Cabal"
,
"Version: 0.1.1.1.1-rain"
,
"License: LGPL"
,
"License-File: foo"
,
"Copyright: Free Text String"
,
"Cabal-version: >1.1.1"
,
"-- Optional - may be in source?"
,
"Author: Happy Haskell Hacker"
,
"Homepage: http://www.haskell.org/foo"
,
"Package-url: http://www.haskell.org/foo"
,
"Synopsis: a nice package!"
,
"Description: a really nice package!"
,
"Category: tools"
,
"buildable: True"
,
"CC-OPTIONS: -g -o"
,
"LD-OPTIONS: -BStatic -dn"
,
"Frameworks: foo"
,
"Tested-with: GHC"
,
"Stability: Free Text String"
,
"Build-Depends: haskell-src, HUnit>=1.0.0-rain"
,
"Other-Modules: Distribution.Package, Distribution.Version,"
,
" Distribution.Simple.GHCPackageConfig"
,
"Other-files: file1, file2"
,
"Extra-Tmp-Files: file1, file2"
,
"C-Sources: not/even/rain.c, such/small/hands"
,
"HS-Source-Dirs: src, src2"
,
"Exposed-Modules: Distribution.Void, Foo.Bar"
,
"Extensions: OverlappingInstances, TypeSynonymInstances"
,
"Extra-Libraries: libfoo, bar, bang"
,
"Extra-Lib-Dirs:
\"
/usr/local/libs
\"
"
,
"Include-Dirs: your/slightest, look/will"
,
"Includes: /easily/unclose, /me,
\"
funky, path
\\\\
name
\"
"
,
"Install-Includes: /easily/unclose, /me,
\"
funky, path
\\\\
name
\"
"
,
"GHC-Options: -fTH -fglasgow-exts"
,
"Hugs-Options: +TH"
,
"Nhc-Options: "
,
"Jhc-Options: "
,
""
,
"-- Next is an executable"
,
"Executable: somescript"
,
"Main-is: SomeFile.hs"
,
"Other-Modules: Foo1, Util, Main"
,
"HS-Source-Dir: scripts"
,
"Extensions: OverlappingInstances"
,
"GHC-Options: "
,
"Hugs-Options: "
,
"Nhc-Options: "
,
"Jhc-Options: "
]
{-
test' = do h <- openFile "../Cabal.cabal" ReadMode
s <- hGetContents h
let r = readFields s
case r of
ParseOk _ fs -> mapM_ (putStrLn . show) fs
x -> putStrLn $ "Failed: " ++ show x
putStrLn "==================="
mapM_ (putStrLn . show) $
merge . zip [1..] . lines $ s
hClose h
-}
-- ghc -DDEBUG --make Distribution/ParseUtils.hs -o test
main
::
IO
()
main
=
do
inputFiles
<-
getArgs
ok
<-
mapM
checkResult
inputFiles
zipWithM_
summary
inputFiles
ok
putStrLn
$
show
(
length
(
filter
not
ok
))
++
" out of "
++
show
(
length
ok
)
++
" failed"
where
summary
f
True
=
return
()
summary
f
False
=
putStrLn
$
f
++
" failed :-("
checkResult
::
FilePath
->
IO
Bool
checkResult
inputFile
=
do
file
<-
readTextFile
inputFile
case
readFields
file
of
ParseOk
_
result
->
do
hPutStrLn
stderr
$
inputFile
++
" parses ok :-)"
return
True
ParseFailed
err
->
do
hPutStrLn
stderr
$
inputFile
++
" parse failed:"
hPutStrLn
stderr
$
show
err
return
False
tests/
u
nitTests/UnlitTest.hs
→
tests/
U
nitTest
/Distribution/Simple/PreProces
s/UnlitTest.hs
View file @
70b4d9ae
module
Un
l
itTest
where
module
UnitTest
.Distribution.Simple.PreProcess.Unlit
where
import
Distribution.Simple.PreProcess.Unlit
import
Control.Exception
...
...
tests/UnitTest/Distribution/Version.hs
0 → 100644
View file @
70b4d9ae
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Version
-- Copyright : Isaac Jones, Simon Marlow 2003-2004
--
-- Maintainer : Isaac Jones <ijones@syntaxpolice.org>
-- Stability : alpha
-- Portability : portable
--
-- Versions for packages, based on the 'Version' datatype.
{- Copyright (c) 2003-2004, Isaac Jones
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module
UnitTest.Distribution.Version
(
hunitTests
)
where
import
Distribution.Version
import
Data.Version
(
Version
(
..
),
showVersion
)
import
Control.Monad
(
liftM
)
import
Data.Char
(
isSpace
,
isDigit
,
isAlphaNum
)
import
Data.Maybe
(
listToMaybe
)
import
Distribution.Compat.ReadP
import
Test.HUnit
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
-- |Simple version parser wrapper
doVersionParse
::
String
->
Either
String
Version
doVersionParse
input
=
case
results
of
[
y
]
->
Right
y
[]
->
Left
"No parse"
_
->
Left
"Ambigous parse"
where
results
=
[
x
|
(
x
,
""
)
<-
readP_to_S
parseVersion
input
]
branch1
::
[
Int
]
branch1
=
[
1
]
branch2
::
[
Int
]
branch2
=
[
1
,
2
]
branch3
::
[
Int
]
branch3
=
[
1
,
2
,
3
]
release1
::
Version
release1
=
Version
{
versionBranch
=
branch1
,
versionTags
=
[]
}
release2
::
Version
release2
=
Version
{
versionBranch
=
branch2
,
versionTags
=
[]
}
release3
::
Version
release3
=
Version
{
versionBranch
=
branch3
,
versionTags
=
[]
}
hunitTests
::
[
Test
]
hunitTests
=
[
"released version 1"
~:
"failed"
~:
(
Right
$
release1
)
~=?
doVersionParse
"1"
,
"released version 3"
~:
"failed"
~:
(
Right
$
release3
)
~=?
doVersionParse
"1.2.3"
,
"range comparison LaterVersion 1"
~:
"failed"
~:
True
~=?
release3
`
withinRange
`
(
LaterVersion
release2
),
"range comparison LaterVersion 2"
~:
"failed"
~:
False
~=?
release2
`
withinRange
`
(
LaterVersion
release3
),
"range comparison EarlierVersion 1"
~:
"failed"
~:
True
~=?
release3
`
withinRange
`
(
LaterVersion
release2
),
"range comparison EarlierVersion 2"
~:
"failed"
~:
False
~=?
release2
`
withinRange
`
(
LaterVersion
release3
),
"range comparison orLaterVersion 1"
~:
"failed"
~:
True
~=?
release3
`
withinRange
`
(
orLaterVersion
release3
),
"range comparison orLaterVersion 2"
~:
"failed"
~:
True
~=?
release3
`
withinRange
`
(
orLaterVersion
release2
),
"range comparison orLaterVersion 3"
~:
"failed"
~:
False
~=?
release2
`
withinRange
`
(
orLaterVersion
release3
),
"range comparison orEarlierVersion 1"
~:
"failed"
~:
True
~=?
release2
`
withinRange
`
(
orEarlierVersion
release2
),
"range comparison orEarlierVersion 2"
~:
"failed"
~:
True
~=?
release2
`
withinRange
`
(
orEarlierVersion
release3
),
"range comparison orEarlierVersion 3"
~:
"failed"
~:
False
~=?
release3
`
withinRange
`
(
orEarlierVersion
release2
)
]
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment