hark-0.2: test/DependParserTest.hs
{-----------------------------------------------------------------
this module tests the DEPEND parsing facility
(c) 2008 Markus Dittrich
This program is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public
License Version 3 as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License Version 3 for more details.
You should have received a copy of the GNU General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
--------------------------------------------------------------------}
module DependParserTest ( depend_tester
, depend_use_tester
) where
-- basic imports
import qualified Data.ByteString.Char8 as BC
import Prelude
import System.IO
-- local imports
import Helpers.PrettyPrint
import TestHelpers
import Drivers.Depend
import Parsers.Depend
------------------------------------------------------------------
-- beginning of section describing test and expected results
--
-- NOTE: To add a new test simply define a ref_<name>
-- ReferenceData structure with the expected values and add
-- the new test to dependTests with the search string supplied
-- as a String
------------------------------------------------------------------
--
-- general informatio needed to retrieve the test
-- database and its content
--
testCategory :: String
testCategory = "test-category"
testFile :: String
testFile = "test-package-1.0.0"
--
-- list of tuples containing the available tests performed by
-- depend test-suite. The tuples are in the form
-- [dependency name, reference dependencies), (..., ...), ...]
--
dependTests :: [(String,ReferenceData)]
dependTests = [("seamonkey",ref_seamonkey),
("www-client/seamonkey",ref_seamonkey),
("dbus-glib", ref_dbus_glib),
("dev-libs/dbus-glib", ref_dbus_glib),
("portage", ref_portage),
("sys-apps/portage", ref_portage),
("arphicfonts", ref_arphic_fonts),
("media-fonts/arphicfonts", ref_arphic_fonts),
("python", ref_python),
("dev-lang/python", ref_python)]
--
-- reference data to test the USE flag selective depend
-- routines. We use the same data as for the depend tests
-- Depend queries that should not return any results due to
-- non-present USE flags get passed an empty list
--
dependUseTests :: [(String,ReferenceData)]
dependUseTests = [("seamonkey",[]),
("www-client/seamonkey",[]),
("dbus-glib", ref_dbus_glib),
("dev-libs/dbus-glib", ref_dbus_glib),
("portage", []),
("sys-apps/portage", []),
("arphicfonts", []),
("media-fonts/arphicfonts", []),
("python", ref_python),
("dev-lang/python", ref_python)]
--
-- list of references for all dependencies to be tested
--
-- [!xulrunner? !firefox? seamonkey? =www-client/seamonkey-1*]
ref_seamonkey :: ReferenceData
ref_seamonkey = [entry1]
where
entry1 = defaultDepend
{
fullName = BC.pack "=www-client/seamonkey-1*"
, package = BC.pack "www-client/seamonkey"
, version = BC.pack "1*"
, qualifier = BC.pack "="
, useFlags = [ BC.pack "!xulrunner"
, BC.pack "!firefox"
, BC.pack "seamonkey"]
}
-- [dbus? >=dev-libs/dbus-glib-0.71]
ref_dbus_glib :: ReferenceData
ref_dbus_glib = [entry1]
where
entry1 = defaultDepend
{
fullName = BC.pack ">=dev-libs/dbus-glib-0.71"
, package = BC.pack "dev-libs/dbus-glib"
, version = BC.pack "0.71"
, qualifier = BC.pack ">="
, useFlags = [BC.pack "dbus"]
}
-- [java? >=sys-apps/portage-2.1.2.7]
ref_portage :: ReferenceData
ref_portage = [entry1]
where
entry1 = defaultDepend
{
fullName = BC.pack ">=sys-apps/portage-2.1.2.7"
, package = BC.pack "sys-apps/portage"
, version = BC.pack "2.1.2.7"
, qualifier = BC.pack ">="
, useFlags = [BC.pack "java"]
}
-- [linguas_zh_CN? >=media-fonts/arphicfonts-0.1-r2] [linguas_zh_TW? >=media-fonts/arphicfonts-0.1-r2]
ref_arphic_fonts :: ReferenceData
ref_arphic_fonts = [entry1,entry2]
where
entry1 = defaultDepend
{
fullName = BC.pack ">=media-fonts/arphicfonts-0.1-r2"
, package = BC.pack "media-fonts/arphicfonts"
, version = BC.pack "0.1-r2"
, qualifier = BC.pack ">="
, useFlags = [BC.pack "linguas_zh_CN"]
}
entry2 = defaultDepend
{
fullName = BC.pack ">=media-fonts/arphicfonts-0.1-r2"
, package = BC.pack "media-fonts/arphicfonts"
, version = BC.pack "0.1-r2"
, qualifier = BC.pack ">="
, useFlags = [BC.pack "linguas_zh_TW"]
}
-- [>=dev-lang/python-2.3.4]
ref_python :: ReferenceData
ref_python = [entry1]
where
entry1 = defaultDepend
{
fullName = BC.pack ">=dev-lang/python-2.3.4"
, package = BC.pack "dev-lang/python"
, version = BC.pack "2.3.4"
, qualifier = BC.pack ">="
, useFlags = []
}
------------------------------------------------------------------
-- end of section describing test and expected results
------------------------------------------------------------------
--
-- main driver to test parsing of dependencies
--
depend_tester :: IO Bool
depend_tester = do
-- retrieve database dir
dbDir <- get_test_dbDir
-- run all available tests
results <- mapM (\x -> check_depend False dbDir testCategory
testFile (fst x) (snd x)) dependTests
-- return status; if a single test failed False
-- otherwise true
return $ foldl (&&) True results
--
-- main driver to test parsing of dependencies when taking
-- use flags into account
--
depend_use_tester :: IO Bool
depend_use_tester = do
-- retrieve database dir
dbDir <- get_test_dbDir
-- run all available tests
result <- mapM (\x -> check_depend True dbDir testCategory
testFile (fst x) (snd x)) dependUseTests
-- return status; if a single test failed False
-- otherwise true
return $ foldl (&&) True result
--
-- retrieve the dependency info for a package from the test
-- database and compare it against the reference result
--
check_depend :: Bool -> FilePath -> String -> String -> String
-> ReferenceData -> IO Bool
check_depend withUse path category file packageName reference =
let
name = DependTarget {
pkgName = BC.pack packageName
, pkgSlot = BC.empty
}
baseDir = path ++ "/" ++ category
in
do
-- short message
putColorStr Cyan $ "Testing " ++ packageName ++ " depend ......"
-- parse DEPEND
depends <- parse_category name baseDir withUse [file]
-- if the reference data is empty we expect depends to be
-- empty also
if (null depends) && (not $ null reference)
then do
print_failure
else do
-- in case we didn't expect any dependencies we can
-- return successfully
if null depends
then do
print_success
else do
let PackageDep(_,dependResult) = head depends
let result = check dependResult reference
-- print difference in case there was no match
if result
then do
print_success
return result
else do
print_failure
print_differences dependResult reference
return result
--
-- print the differences in case the calculated dependencies
-- did not match our expectations
--
print_differences :: [Dependency] -> ReferenceData -> IO ()
print_differences actual target =
do
putColorStr Red $ "**** Error in DependTest: "
putColorStrLn Red $ "found non-matching results:"
putStrLn "Expected:"
mapM_ (putStrLn . show) target
putStrLn "Actual:"
mapM_ (putStrLn . show) actual
--
-- function testing a reference dependency list against
-- the actual result returning bool
--
check :: [Dependency] -> ReferenceData -> Bool
check actual target = foldl (&&) True resultList
where
resultList = zipWith compareDepend actual target
compareDepend :: Dependency -> Dependency -> Bool
compareDepend r t = (fullName r == fullName t)
&& (package r == package t)
&& (version r == version t)
&& (qualifier r == qualifier t)
&& (useFlags r == useFlags t)
--
-- covenience typedef
--
type ReferenceData = [Dependency]