-- file: HUnitAug.hs -- Haskell bindings for the Augeas library -- Copyright (c) 2009, Jude Nagurney -- -- This program is free software; you can redistribute it and/or modify it -- under the terms of the GNU General Public License as published by the Free -- Software Foundation; either version 2 of the License, or (at your option) -- any later version. -- -- 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 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 -- -- Contact the author at -- jude@pwan.org module Main where import Test.HUnit import System.Augeas -- import AugeasHsc import Data.ByteString.Char8 import Foreign import Foreign.ForeignPtr import Directory import Data.List (isInfixOf) import IO -- constants 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 func = do cwd <- getCurrentDirectory maybe_aug_ptr <- aug_init (Data.ByteString.Char8.pack (cwd++"/testroot")) empty [save_newfile] 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) -- ------------- -- aug_get tests -- ------------- 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" (Left invalid_match) ret_get ) -- ------------- -- aug_set tests -- ------------- 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 ) -- ---------------- -- aug_insert tests -- ---------------- 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 ) 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 ) 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_insert <- 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_insert (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 ) -- ------------ -- aug_rm tests -- ------------ testRmBadPath :: Test testRmBadPath = TestCase ( with_augptr $ \aug_ptr -> do ret_rm <- aug_rm aug_ptr bs_BadPath assertEqual "Bad path in rm" 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 ) -- ------------ -- aug_mv tests -- ------------ 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 ) 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_get <- aug_get aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000/canonical") assertEqual "get 1000 OK" (Left no_match) ret_get ) -- --------------- -- aug_match tests -- --------------- 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 ) -- TODO: Test that forces -1 return value from aug_match -- -------- -- aug_save -- -------- testSave :: Test testSave = TestCase ( with_augptr $ \aug_ptr -> do ret_save <- aug_save aug_ptr assertEqual "save good" success ret_save ) 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_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_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 ret_rm <- aug_rm aug_ptr (Data.ByteString.Char8.pack "/files/etc/hosts/1000") assertEqual "Bad path in rm" 3 ret_rm ret_save <- aug_save aug_ptr assertEqual "save good" success ret_save contents <- Prelude.readFile (cwd++"/testroot/etc/hosts.augnew") assertEqual "Check augnew" (Data.List.isInfixOf "192.168.1.234\thaskell-augeas.org" contents) False ) -- --------- -- aug_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") 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") ) main :: IO Counts main = runTestTT $ TestList [ -- testBadRoot, -- aug_get tests testGetBadPath, testGetPartialPath, testGetStillPartialPath, testGetBadLabel, testGetGoodLabel, testGetMultipleLabel, testGetBadMultipleLabel, -- aug_set tests testSetLabel, testSetMultiMatch, -- aug_insert tests testInsertBadPath, testInsertMultiMatch, testInsertBeforeAfter, -- aug_rm tests testRmBadPath, testRmOne, testRmTwo, -- aug_mv tests testMvBadSrc, testMvNewDest, -- aug_match tests testMatchBadSrc, testMatchOne, testMatchMultiple, -- aug_save tests testSave, testSaveNewLabel, -- aug_print tests testPrint -- aug_close already handled in ForeignPtr, so there's no need to surface it to Haskell users at all. ]