-- file: HUnitAug.hs -- Haskell bindings for the Augeas library -- Copyright (c) 2009-2012, Jude Nagurney -- This library is free software; you can redistribute it and/or modify it -- under the terms of the GNU Lesser General Public License as published by -- the Free Software Foundation; either version 3 of the License, or -- (at your option) any later version. -- This library 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 Lesser General Public -- License for more details. -- You should have received a copy of the GNU Lesser General Public License -- along with this library; if not, write to the Free Software Foundation, -- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- Contact the author at -- jude@pwan.org {-# LANGUAGE CPP #-} #ifndef _config_h #include "Config.h" #define _config_h #endif module Main where import Foreign import Test.HUnit import System.Augeas import Data.ByteString.Char8 import System.Directory import Data.List (isInfixOf) import System.IO as IO -- constants bs_BadPath :: ByteString bs_BadPath = (Data.ByteString.Char8.pack "/files/bad/path") -- testBadRoot :: Test -- testBadRoot = TestCase (do -- aug_ptr <- aug_init (Data.ByteString.Char8.pack "./bad_testroot") empty [] -- assertEqual "Should get Nothing after a bad root" Nothing aug_ptr) with_augptr :: (Ptr Augeas -> IO ()) -> IO () with_augptr func = do cwd <- getCurrentDirectory maybe_aug_ptr <- aug_init (Data.ByteString.Char8.pack (cwd++"/testroot")) empty [save_newfile, enable_span] case maybe_aug_ptr of Nothing -> assertFailure "aug_ptr shouldn't be nothing in with_augptr" Just aug_fp -> (withForeignPtr aug_fp $ \aug_ptr -> func aug_ptr) testFirst :: Test testFirst = TestCase ( assertEqual "keep the test list from complaining about a leading comma" True True ) -- ---------------- -- aug_defvar tests -- ---------------- #ifdef HAS_AUGEAS_DEFVAR testBadDefVar :: Test testBadDefVar = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "$undefined")) assertEqual "testBadDefVar " System.Augeas.error ret_defvar ret_error <- aug_error aug_ptr assertEqual "testBadDefVar error" err_bad_path ret_error ) testGoodDefVar :: Test testGoodDefVar = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "/files/etc/hosts")) assertEqual "testGoodDefVar (1)" one ret_defvar ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var/1/canonical") assertEqual "testGoodDefVar: Should have gotten localhost" (Right (Just "localhost")) ret_get ) testReplaceDefVar :: Test testReplaceDefVar = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical")) assertEqual "testReplaceDefVar" one ret_defvar ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var") assertEqual "testReplaceDefVar: Should have gotten localhost" (Right (Just "localhost")) ret_get ret_defvar2 <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "/files/etc/hosts/1/ipaddr")) assertEqual "testReplaceDefVar (2)" one ret_defvar2 ret_get2 <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var") assertEqual "testReplaceDefVar: Should have gotten 127.0.0.1" (Right (Just "127.0.0.1")) ret_get2 ) testNullValueDefVar ::Test testNullValueDefVar = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical")) assertEqual "testNullDefVar (1)" one ret_defvar ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var") assertEqual "testNullDefVar: Should have gotten localhost (1)" (Right (Just "localhost")) ret_get ret_defvar2 <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") Nothing assertEqual "testNullDefVar (2)" success ret_defvar2 ret_get2 <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var") assertEqual "testNullDefVar: Should have gotten localhost (2)" (Left invalid_match) ret_get2 ) testNonZeroDefVar :: Test testNonZeroDefVar = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "/files/etc/hosts/*")) assertEqual "testGoodDefVar (1)" (AugRet 12) ret_defvar ) #endif -- ----------------- -- aug_defnode tests -- ----------------- #ifdef HAS_AUGEAS_DEFNODE testBadDefNode :: Test testBadDefNode = TestCase ( with_augptr $ \aug_ptr -> do ret_defnode <- aug_defnode aug_ptr (Data.ByteString.Char8.pack "var") (Data.ByteString.Char8.pack "$undefined") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "testBadDefNode" (System.Augeas.error, Nothing) ret_defnode ret_error <- aug_error aug_ptr assertEqual "testBadDefNode error" err_bad_path ret_error ) testDefNode :: Test testDefNode = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defnode aug_ptr (Data.ByteString.Char8.pack "var") (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "defnode (1)" ((AugRet 1),(Just True)) ret_defvar ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "$var") assertEqual "defnode (2)" (Right (Just "haskell-augeas.org")) ret_get -- The node already exists, so it should not be set to the new value ret_defvar2 <- aug_defnode aug_ptr (Data.ByteString.Char8.pack "bar") (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas2.org") assertEqual "defnode (3)" ((AugRet 1),(Just False)) ret_defvar2 ret_get2 <- aug_get aug_ptr (Data.ByteString.Char8.pack "$bar") assertEqual "defnode(4)" (Right (Just "haskell-augeas.org")) ret_get2 ) --testNonZeroDefNode :: Test --testNonZeroDefNode = TestCase ( with_augptr $ \aug_ptr -> do -- ret_defnode <- aug_defnode aug_ptr (Data.ByteString.Char8.pack "var") (Data.ByteString.Char8.pack "/files/etc/hosts") (Data.ByteString.Char8.pack "unset") -- assertEqual "testNonZeroDefVar (1)" ((AugRet 12),(Just False)) ret_defnode -- ) #endif -- ------------- -- aug_get tests -- ------------- #ifdef HAS_AUGEAS_GET testGetBadPath :: Test testGetBadPath = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr bs_BadPath assertEqual "Bad path in get" (Left no_match) ret_get ) testGetPartialPath :: Test testGetPartialPath = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts") assertEqual "Partial path returns none" (Right Nothing) ret_get ) testGetStillPartialPath :: Test testGetStillPartialPath = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1") assertEqual "Partial path returns none" (Right Nothing) ret_get ) testGetBadLabel :: Test testGetBadLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1/invalid") assertEqual "Bad label in get" (Left no_match) ret_get ) testGetGoodLabel :: Test testGetGoodLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical") assertEqual "Should have gotten localhost" (Right (Just "localhost")) ret_get ) testGetMultipleLabel :: Test testGetMultipleLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/*/canonical") assertEqual "Get should return a negative on multiple matches" (Left invalid_match) ret_get ) testGetBadMultipleLabel :: Test testGetBadMultipleLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/*/invalid") assertEqual "Get should return a negative on multiple matches (2)" (Left no_match) ret_get ) #endif -- ------------- -- aug_set tests -- ------------- #ifdef HAS_AUGEAS_SET testSetLabel :: Test testSetLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") assertEqual "set OK" (Right (Just "haskell-augeas.org")) ret_get ) testSetMultiMatch :: Test testSetMultiMatch = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/*/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" System.Augeas.error ret_set ret_error <- aug_error aug_ptr -- assertEqual "testSetMultiMatch error" no_error ret_error assertEqual "testSetMultiMatch error" err_multi_matches ret_error ) #endif -- -------------- -- aug_setm tests -- -------------- #ifdef HAS_AUGEAS_SETM testBadBaseSetm :: Test testBadBaseSetm = TestCase ( with_augptr $ \aug_ptr -> do ret_setm <- aug_setm aug_ptr (Data.ByteString.Char8.pack "badbase") (Just (Data.ByteString.Char8.pack "sub")) (Data.ByteString.Char8.pack "value") assertEqual "testBadBaseSetm (1)" (AugRet 0) ret_setm ) testBadPathSetm :: Test testBadPathSetm = TestCase ( with_augptr $ \aug_ptr -> do ret_setm <- aug_setm aug_ptr (Data.ByteString.Char8.pack "/") (Just (Data.ByteString.Char8.pack "/blah/*/blah/**")) (Data.ByteString.Char8.pack "value") assertEqual "testBadPathSetm (1)" (AugRet (-1)) ret_setm ) testSetm :: Test testSetm = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set ret_setm <- aug_setm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Just (Data.ByteString.Char8.pack "sub/1")) (Data.ByteString.Char8.pack "value") assertEqual "testSetm (1)" (AugRet 1) ret_setm ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/1") assertEqual "set OK" (Right (Just "value")) ret_get ret_setm2 <- aug_setm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/1") Nothing (Data.ByteString.Char8.pack "value2") assertEqual "testSetm (2)" (AugRet 1) ret_setm2 ret_get2 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/1") assertEqual "set OK" (Right (Just "value2")) ret_get2 ret_setm3 <- aug_setm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Just (Data.ByteString.Char8.pack "sub/2")) (Data.ByteString.Char8.pack "value3") assertEqual "testSetm (3)" (AugRet 1) ret_setm3 ret_get3 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/2") assertEqual "set OK" (Right (Just "value3")) ret_get3 ret_setm4 <- aug_setm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/*") Nothing (Data.ByteString.Char8.pack "value4") assertEqual "testSetm (4)" (AugRet 2) ret_setm4 ret_get4 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/1") assertEqual "set OK" (Right (Just "value4")) ret_get4 ret_get5 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical/sub/2") assertEqual "set OK" (Right (Just "value4")) ret_get5 ) #endif -- -------------- -- aug_span tests -- -------------- #ifdef HAS_AUGEAS_SPAN testSpanNoFile :: Test testSpanNoFile = TestCase (with_augptr $ \aug_ptr -> do ret_span <- aug_span aug_ptr (Data.ByteString.Char8.pack "/files/etc/missing") assertEqual "Missing file span test" Nothing ret_span ) testSpan :: Test testSpan = TestCase (with_augptr $ \aug_ptr -> do cwd <- getCurrentDirectory ret_span <- aug_span aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts") assertEqual "Normal span test" (Just (cwd ++ "/testroot/etc/hosts", 0, 0, 0, 0, 0, 290)) ret_span ) #endif -- ---------------- -- aug_insert tests -- ---------------- #ifdef HAS_AUGEAS_INSERT testInsertBadPath :: Test testInsertBadPath = TestCase ( with_augptr $ \aug_ptr -> do ret_insert <- aug_insert aug_ptr bs_BadPath (Data.ByteString.Char8.pack "label") just_after assertEqual "Bad path in insert" System.Augeas.error ret_insert ret_error <- aug_error aug_ptr assertEqual "testInsertBadPath error" err_no_match ret_error ) testInsertMultiMatch :: Test testInsertMultiMatch = TestCase ( with_augptr $ \aug_ptr -> do ret_insert <- aug_insert aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/*/canonical") (Data.ByteString.Char8.pack "label") just_after assertEqual "No multimatches on insert" System.Augeas.error ret_insert ret_error <- aug_error aug_ptr assertEqual "testInsertMultiMatch error" err_multi_matches ret_error ) testInsertBeforeAfter :: Test testInsertBeforeAfter = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set ret_insert <- aug_insert aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "after") just_after assertEqual "Insert after success" success ret_insert ret_insert2 <- aug_insert aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "before") just_before assertEqual "Insert before success" success ret_insert2 (match_count, (Just matches)) <- aug_match aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/*") assertEqual "Should be 3 matches" 3 match_count assertEqual "insert matches" ["/files/etc/hosts/1000/before","/files/etc/hosts/1000/canonical","/files/etc/hosts/1000/after"] matches ) #endif -- ------------ -- aug_rm tests -- ------------ #ifdef HAS_AUGEAS_RM testRmBadPath :: Test testRmBadPath = TestCase ( with_augptr $ \aug_ptr -> do ret_rm <- aug_rm aug_ptr bs_BadPath assertEqual "Bad path in rm 1" 0 ret_rm ) testRmOne :: Test testRmOne = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set ret_rm <- aug_rm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") assertEqual "rm 1" 1 ret_rm ) testRmTwo :: Test testRmTwo = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set success" success ret_set ret_insert <- aug_insert aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "after") just_after assertEqual "insert success" success ret_insert ret_rm <- aug_rm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/*") assertEqual "rm 2" 2 ret_rm ) #endif -- ------------ -- aug_mv tests -- ------------ #ifdef HAS_AUGEAS_MV testMvBadSrc :: Test testMvBadSrc = TestCase ( with_augptr $ \aug_ptr -> do ret_mv <- aug_mv aug_ptr bs_BadPath (Data.ByteString.Char8.pack "/files/etc/hosts/1/badpath") assertEqual "mv bad src" System.Augeas.error ret_mv ret_error <- aug_error aug_ptr assertEqual "testMvBadSrc error" err_no_match ret_error ) testMvNewDest :: Test testMvNewDest = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set ret_mv <- aug_mv aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "/files/etc/hosts/1001/canonical") assertEqual "mv 1000-> 1001 OK" success ret_mv ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1001/canonical") assertEqual "get 1001 OK" (Right (Just "haskell-augeas.org")) ret_get ret_get2 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") assertEqual "get 1000 OK" (Left no_match) ret_get2 ) #endif -- --------------- -- aug_match tests -- --------------- #ifdef HAS_AUGEAS_MATCH testMatchBadSrc :: Test testMatchBadSrc = TestCase ( with_augptr $ \aug_ptr -> do (match_count, matches) <- aug_match aug_ptr bs_BadPath assertEqual "match count bad src" 0 match_count assertEqual "matches bad src" (Just []) matches ) testMatchOne :: Test testMatchOne = TestCase ( with_augptr $ \aug_ptr -> do (match_count, matches) <- aug_match aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical") assertEqual "match count good label" 1 match_count assertEqual "match good label" (Just ["/files/etc/hosts/1/canonical"]) matches ) testMatchMultiple :: Test testMatchMultiple = TestCase ( with_augptr $ \aug_ptr -> do (match_count, matches) <- aug_match aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/*/canonical") assertEqual "match count good label" 9 match_count case matches of (Just ms) -> assertEqual "match len equals match_count" (Prelude.length(ms)) match_count Nothing -> fail "matches should not bbe Nothing" ) -- TODO: Test that forces -1 return value from aug_match #endif -- -------- -- aug_save -- -------- #ifdef HAS_AUGEAS_SAVE testSave :: Test testSave = TestCase ( with_augptr $ \aug_ptr -> do ret_save <- aug_save aug_ptr assertEqual "save good" success ret_save ) testSaveNewLabel :: Test testSaveNewLabel = TestCase ( with_augptr $ \aug_ptr -> do ret_set <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/ipaddr") (Data.ByteString.Char8.pack "192.168.1.234") assertEqual "set OK" success ret_set ret_set2 <- aug_set aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") (Data.ByteString.Char8.pack "haskell-augeas.org") assertEqual "set OK" success ret_set2 ret_save <- aug_save aug_ptr assertEqual "save good" success ret_save cwd <- getCurrentDirectory contents <- Prelude.readFile (cwd++"/testroot/etc/hosts.augnew") assertEqual "Check augnew" (Data.List.isInfixOf "192.168.1.234\thaskell-augeas.org" contents) True removeFile (cwd++"/testroot/etc/hosts.augnew") ret_rm <- aug_rm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000") assertEqual "Bad path in rm 2" 3 ret_rm ret_save2 <- aug_save aug_ptr assertEqual "save good" success ret_save2 -- removing the /file/etc/hosts/10 entry will put /etc/hosts back to its original state, so nothing will be written out -- so the augnew file shouldn't exist b_AugnewExists <- doesFileExist (cwd++"/testroot/etc/hosts.augnew") assertEqual "No augnew" b_AugnewExists False ) #endif -- -------------- -- aug_load tests -- -------------- #ifdef HAS_AUGEAS_LOAD testLoad :: Test testLoad = TestCase ( with_augptr $ \aug_ptr -> do cwd <- getCurrentDirectory renameFile (cwd++"/testroot/etc/hosts") (cwd++"/testroot/etc/hosts.orig") renameFile (cwd++"/testroot/etc/hosts.reload") (cwd++"/testroot/etc/hosts") contents <- Prelude.readFile (cwd++"/testroot/etc/hosts") assertEqual "tesstLoad(1)" (Data.List.isInfixOf "192.168.0.203 testload.haskell-augeas.org" contents) True -- Force all of contents to be read, so readFile will really close the file Prelude.length contents `seq` Prelude.appendFile (cwd++"/testroot/etc/hosts") "\n$ force mtime update" ret_load <- aug_load aug_ptr assertEqual "testLoad (2)" success ret_load ret_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/augeas/error") assertEqual "testLoad (3)" (Left no_match) ret_get ret_get11 <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/4/ipaddr") assertEqual "testLoad (4)" (Right (Just "192.168.0.203")) ret_get11 Prelude.writeFile (cwd++"/testroot/etc/hosts") contents renameFile (cwd++"/testroot/etc/hosts") (cwd++"/testroot/etc/hosts.reload") renameFile (cwd++"/testroot/etc/hosts.orig") (cwd++"/testroot/etc/hosts") ) #endif -- --------------- -- aug_print tests -- --------------- #ifdef HAS_AUGEAS_PRINT testPrint :: Test testPrint = TestCase ( with_augptr $ \aug_ptr -> do cwd <- getCurrentDirectory fptr_Output <- openFile (cwd++"/HUnitAug.txt") WriteMode ret_print <- aug_print aug_ptr fptr_Output (Data.ByteString.Char8.pack "/files/etc/hosts") assertEqual "testPrint ret_print" success ret_print IO.hPutStr fptr_Output "That's all folks" hFlush fptr_Output hClose fptr_Output contents <- IO.readFile (cwd++"/HUnitAug.txt") assertEqual ("check aug_print") (Data.List.isInfixOf "/files/etc/hosts\n" contents) True assertEqual ("check after aug_print") (Data.List.isInfixOf "That's all folks" contents) True removeFile (cwd++"/HUnitAug.txt") ) #endif -- -------------- -- aug_srun tests -- -------------- #ifdef HAS_AUGEAS_SRUN testSrunHelp :: Test testSrunHelp = TestCase ( with_augptr $ \aug_ptr -> do cwd <- getCurrentDirectory fptr_Output <- openFile (cwd++"/HUnitAug.txt") WriteMode ret_srun <- aug_srun aug_ptr fptr_Output (Data.ByteString.Char8.pack "help\n") assertEqual "testSrun ret_srun" (AugRet 1) ret_srun hFlush fptr_Output hClose fptr_Output contents <- IO.readFile (cwd++"/HUnitAug.txt") assertEqual "check aug_srun_help" (Data.List.isInfixOf "Commands:" contents) True assertEqual "check aug_srun_help" (Data.List.isInfixOf "Type 'help ' for more information on a command" contents) True removeFile (cwd++"/HUnitAug.txt") ) testSrunQuit :: Test testSrunQuit = TestCase ( with_augptr $ \aug_ptr -> do cwd <- getCurrentDirectory fptr_Output <- openFile (cwd++"/HUnitAug.txt") WriteMode ret_srun <- aug_srun aug_ptr fptr_Output (Data.ByteString.Char8.pack "quit\n") assertEqual "testSrun ret_srun_quit" (AugRet (-2)) ret_srun hFlush fptr_Output hClose fptr_Output contents <- IO.readFile (cwd++"/HUnitAug.txt") assertEqual "check aug_srun_quit_contents" (contents == "") True -- removeFile (cwd++"/HUnitAug.txt") ) #endif -- --------------- -- aug_error tests -- --------------- #ifndef HAS_AUGEAS_ERROR testError :: Test testError = TestCase ( with_augptr $ \aug_ptr -> do ret_err <- aug_error aug_ptr assertEqual ("testError") no_error ret_err ) #endif -- ---------------- -- aug_error* tests -- ---------------- #ifdef HAS_AUGEAS_ERROR_MESSAGE testErrMessage :: Test testErrMessage = TestCase ( with_augptr $ \aug_ptr -> do ret_defvar <- aug_defvar aug_ptr (Data.ByteString.Char8.pack "var") (Just (Data.ByteString.Char8.pack "$undefined")) assertEqual "testErrMessage (1)" System.Augeas.error ret_defvar ret_error <- aug_error aug_ptr assertEqual "testErrMessage (2)" err_bad_path ret_error err_message <- aug_error_message aug_ptr assertEqual "testErrMessage (3)" (Data.ByteString.Char8.pack "Invalid path expression") err_message #ifdef HAS_AUGEAS_ERROR_MINOR_MESSAGE err_minor_message <- aug_error_minor_message aug_ptr assertEqual "testErrMessage (4)" (Data.ByteString.Char8.pack "undefined variable") err_minor_message #endif #ifdef HAS_AUGEAS_ERROR_DETAILS err_details <- aug_error_details aug_ptr assertEqual "testErrMessage (4)" (Data.ByteString.Char8.pack "$undefined|=|") err_details #endif ) #endif -- ---------------- -- aug_to_xml tests -- ---------------- #ifdef HAS_AUGEAS_TO_XML testToXml :: Test testToXml = TestCase ( with_augptr $ \aug_ptr -> do -- test success (ret==0, AugeasXmlNode != NULL) ret_toxml <- aug_to_xml aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical") [none] assertEqual "testGoodToXml" success (fst ret_toxml) assertBool "testGoodToXmlJustPtr" ((snd ret_toxml) /= Nothing) ret_toxml2 <- aug_to_xml aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1/canonical") [save_backup] assertEqual "testFlagsNotZero" System.Augeas.error (fst ret_toxml2) err_message <- aug_error_message aug_ptr assertEqual "testFlagsNotZeroErr" (Data.ByteString.Char8.pack "Invalid argument in function call") err_message err_details <- aug_error_details aug_ptr assertEqual "testFlagsNotZeroErrDetails" (Data.ByteString.Char8.pack "aug_to_xml: FLAGS must be 0") err_details assertEqual "testFlagsNotZeroNode" Nothing (snd ret_toxml2) ) #endif main :: IO Counts main = runTestTT $ TestList [ -- testBadRoot, testFirst #ifdef HAS_AUGEAS_DEFVAR ,testBadDefVar ,testGoodDefVar ,testReplaceDefVar ,testNullValueDefVar ,testNonZeroDefVar #endif #ifdef HAS_AUGEAS_DEFNODE ,testBadDefNode ,testDefNode -- ,testNonZeroDefNode #endif #ifdef HAS_AUGEAS_GET ,testGetBadPath ,testGetPartialPath ,testGetStillPartialPath ,testGetBadLabel ,testGetGoodLabel ,testGetMultipleLabel ,testGetBadMultipleLabel #endif #ifdef HAS_AUGEAS_SET ,testSetLabel ,testSetMultiMatch #endif #ifdef HAS_AUGEAS_SETM ,testBadBaseSetm ,testBadPathSetm ,testSetm #endif #ifdef HAS_AUGEAS_SPAN ,testSpanNoFile ,testSpan #endif #ifdef HAS_AUGEAS_INSERT ,testInsertBadPath ,testInsertMultiMatch ,testInsertBeforeAfter #endif #ifdef HAS_AUGEAS_RM ,testRmBadPath ,testRmOne ,testRmTwo #endif #ifdef HAS_AUGEAS_MV ,testMvBadSrc ,testMvNewDest #endif #ifdef HAS_AUGEAS_MATCH ,testMatchBadSrc ,testMatchOne ,testMatchMultiple #endif #ifdef HAS_AUGEAS_SAVE ,testSave ,testSaveNewLabel #endif #ifdef HAS_AUGEAS_LOAD ,testLoad #endif #ifdef HAS_AUGEAS_PRINT ,testPrint #endif #ifdef HAS_AUGEAS_SRUN ,testSrunHelp ,testSrunQuit #endif #ifndef HAS_AUGEAS_ERROR ,testError #endif #ifdef HAS_AUGEAS_ERROR_MESSAGE ,testErrMessage #endif #ifdef HAS_AUGEAS_TO_XML ,testToXml #endif -- aug_close already handled in ForeignPtr, so there's no need to surface it to Haskell users at all. ]