lib: Fix compile errors in tests

This commit is contained in:
Jakub Zárybnický 2018-06-18 00:23:41 +02:00 committed by Simon Michael
parent 510b4c1b55
commit c67404c73d
5 changed files with 58 additions and 70 deletions

View File

@ -881,7 +881,6 @@ journalDateSpan secondary j
pdates = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts
ts = jtxns j
-- #ifdef TESTS
test_journalDateSpan = do
"journalDateSpan" ~: do
assertEqual "" (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
@ -894,7 +893,6 @@ test_journalDateSpan = do
,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}]
}
]}
-- #endif
-- | Apply the pivot transformation to all postings in a journal,
-- replacing their account name by their value for the given field or tag.

View File

@ -346,6 +346,7 @@ samplejournal = readJournal' $ T.unlines
tests_Hledger_Read = TestList $
tests_readJournal'
++ [
tests_Hledger_Read_Common,
JournalReader.tests_Hledger_Read_JournalReader,
-- LedgerReader.tests_Hledger_Read_LedgerReader,
TimeclockReader.tests_Hledger_Read_TimeclockReader,

View File

@ -89,7 +89,10 @@ module Hledger.Read.Common (
-- ** misc
singlespacedtextp,
singlespacep
singlespacep,
-- * tests
tests_Hledger_Read_Common
)
where
--- * imports
@ -114,6 +117,7 @@ import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import System.Time (getClockTime)
import Test.HUnit
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (decimal)
@ -496,19 +500,21 @@ spaceandamountormissingp =
lift $ skipSome spacenonewline
Mixed . (:[]) <$> amountp
#ifdef TESTS
assertParseEqual' :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) parse
assertParseEqual' ::
(Show a, Eq a)
=> Identity (Either (ParseError Char CustomErr) a)
-> a
-> Assertion
assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) (runIdentity parse)
is' :: (Eq a, Show a) => a -> a -> Assertion
a `is'` e = assertEqual e a
a `is'` e = assertEqual "values are equal" e a
test_spaceandamountormissingp = do
test_spaceandamountormissingp = TestCase $ do
assertParseEqual' (parseWithState mempty spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
assertParseEqual' (parseWithState mempty spaceandamountormissingp "$47.18") missingmixedamt
assertParseEqual' (parseWithState mempty spaceandamountormissingp " ") missingmixedamt
assertParseEqual' (parseWithState mempty spaceandamountormissingp "") missingmixedamt
#endif
-- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored)
@ -594,8 +600,7 @@ amountwithoutpricep = do
Right res -> pure res
#ifdef TESTS
test_amountp = do
test_amountp = TestCase $ do
assertParseEqual' (parseWithState mempty amountp "$47.18") (usd 47.18)
assertParseEqual' (parseWithState mempty amountp "$1.") (usd 1 `withPrecision` 0)
-- ,"amount with unit price" ~: do
@ -606,7 +611,6 @@ test_amountp = do
assertParseEqual'
(parseWithState mempty amountp "$10 @@ €5")
(usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
#endif
-- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount
@ -1256,3 +1260,5 @@ match' :: TextParser m a -> TextParser m (Text, a)
match' p = do
(!txt, p) <- match p
pure (txt, p)
tests_Hledger_Read_Common = TestList [test_spaceandamountormissingp, test_amountp]

View File

@ -76,6 +76,7 @@ import Control.Monad
import Control.Monad.Except (ExceptT(..))
import Control.Monad.State.Strict
import Data.Bifunctor (first)
import Data.Functor.Identity (Identity(..))
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Data.String
@ -85,10 +86,6 @@ import Data.Time.Calendar
import Data.Time.LocalTime
import Safe
import Test.HUnit
#ifdef TESTS
import Test.Framework
import Text.Megaparsec.Error
#endif
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char
import Text.Megaparsec.Custom
@ -545,24 +542,23 @@ transactionp = do
let sourcepos = journalSourcePos startpos endpos
return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
#ifdef TESTS
test_transactionp = do
test_transactionp = TestCase $ do
let s `gives` t = do
let p = parseWithState mempty transactionp s
assertBool $ isRight p
let p = runIdentity $ parseWithState mempty transactionp s
assertBool "Parse success" (isRight p)
let Right t2 = p
-- same f = assertEqual (f t) (f t2)
assertEqual (tdate t) (tdate t2)
assertEqual (tdate2 t) (tdate2 t2)
assertEqual (tstatus t) (tstatus t2)
assertEqual (tcode t) (tcode t2)
assertEqual (tdescription t) (tdescription t2)
assertEqual (tcomment t) (tcomment t2)
assertEqual (ttags t) (ttags t2)
assertEqual (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
assertEqual (show $ tpostings t) (show $ tpostings t2)
assertEqual "Equal date" (tdate t) (tdate t2)
assertEqual "Equal date2" (tdate2 t) (tdate2 t2)
assertEqual "Equal status" (tstatus t) (tstatus t2)
assertEqual "Equal code" (tcode t) (tcode t2)
assertEqual "Equal description" (tdescription t) (tdescription t2)
assertEqual "Equal comment" (tcomment t) (tcomment t2)
assertEqual "Equal tags" (ttags t) (ttags t2)
assertEqual "Equal preceding comments" (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
assertEqual "Equal postings" (show $ tpostings t) (show $ tpostings t2)
-- "0000/01/01\n\n" `gives` nulltransaction
unlines [
T.unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
" ; ttag1: val1",
@ -593,50 +589,45 @@ test_transactionp = do
],
tpreceding_comment_lines=""
}
unlines [
"2015/1/1",
]
T.unlines ["2015/1/1"]
`gives`
nulltransaction{
tdate=parsedate "2015/01/01",
}
nulltransaction{ tdate=parsedate "2015/01/01" }
assertRight $ parseWithState mempty transactionp $ unlines
assertBool "transactionp parses a well-formed transactionParse OK" $
isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
["2007/01/28 coopportunity"
," expenses:food:groceries $47.18"
," assets:checking $-47.18"
,""
]
-- transactionp should not parse just a date
assertLeft $ parseWithState mempty transactionp "2009/1/1\n"
assertBool "transactionp should not parse just a date" $
isLeft . runIdentity $ parseWithState mempty transactionp "2009/1/1\n"
-- transactionp should not parse just a date and description
assertLeft $ parseWithState mempty transactionp "2009/1/1 a\n"
assertBool "transactionp should not parse just a date and description" $
isLeft . runIdentity $ parseWithState mempty transactionp "2009/1/1 a\n"
-- transactionp should not parse a following comment as part of the description
let p = parseWithState mempty transactionp "2009/1/1 a ;comment\n b 1\n"
assertRight p
assertEqual "a" (let Right p' = p in tdescription p')
let p = runIdentity $ parseWithState mempty transactionp "2009/1/1 a ;comment\n b 1\n"
assertEqual "transactionp should not parse a following comment as part of the description"
(Right "a") (tdescription <$> p)
-- parse transaction with following whitespace line
assertRight $ parseWithState mempty transactionp $ unlines
assertBool "transactionp parses a following whitespace line" $
isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
["2012/1/1"
," a 1"
," b"
," "
]
let p = parseWithState mempty transactionp $ unlines
let p = runIdentity . parseWithState mempty transactionp $ T.unlines
["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment"
," ; posting 1 comment 2"
," b"
," ; posting 2 comment"
]
assertRight p
assertEqual 2 (let Right t = p in length $ tpostings t)
#endif
assertBool "transactionp parses parses comments anywhere" (isRight p)
assertEqual "Has 2 postings" 2 (let Right t = p in length $ tpostings t)
--- ** postings
@ -680,14 +671,12 @@ postingp mTransactionYear = do
, pbalanceassertion=massertion
}
#ifdef TESTS
test_postingp = do
test_postingp = TestCase $ do
let s `gives` ep = do
let parse = parseWithState mempty (postingp Nothing) s
assertBool -- "postingp parser"
$ isRight parse
let parse = runIdentity $ parseWithState mempty (postingp Nothing) s
assertBool "Example is parsed well" $ isRight parse
let Right ap = parse
same f = assertEqual (f ep) (f ap)
same f = assertEqual "Posting is parsed well" (f ep) (f ap)
same pdate
same pstatus
same paccount
@ -714,30 +703,28 @@ test_postingp = do
,ptags=[("a","a"), ("date","2012/11/28"), ("date2","2012/11/29"), ("b","b")]
,pdate=parsedateM "2012/11/28"}
assertBool -- "postingp parses a quoted commodity with numbers"
(isRight $ parseWithState mempty (postingp Nothing) " a 1 \"DE123\"\n")
assertBool "postingp parses a quoted commodity with numbers"
(isRight . runIdentity $ parseWithState mempty (postingp Nothing) " a 1 \"DE123\"\n")
-- ,"postingp parses balance assertions and fixed lot prices" ~: do
assertBool (isRight $ parseWithState mempty (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n")
assertBool "postingp parses balance assertions and fixed lot prices"
(isRight . runIdentity $ parseWithState mempty (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n")
-- let parse = parseWithState mempty postingp " a\n ;next-line comment\n"
-- assertRight parse
-- let Right p = parse
-- assertEqual "next-line comment\n" (pcomment p)
-- assertEqual (Just nullmixedamt) (pbalanceassertion p)
#endif
--- * more tests
tests_Hledger_Read_JournalReader = TestList $ concat [
-- test_numberp
[
tests_Hledger_Read_JournalReader = TestList [
test_transactionp,
test_postingp,
"showParsedMarketPrice" ~: do
let mp = parseWithState mempty marketpricedirectivep "P 2017/01/30 BTC $922.83\n"
mpString = (fmap . fmap) showMarketPrice mp
mpString `is` (Just (Right "P 2017/01/30 BTC $922.83"))
]
]
{- old hunit tests

View File

@ -21,10 +21,6 @@ import Data.Text (Text, pack)
import Data.Text.Encoding (encodeUtf8)
-- import Safe
import Test.HUnit
-- #ifdef TESTS
-- import Test.Framework
-- import Text.Megaparsec.Error
-- #endif
import Text.Megaparsec (eof)
-- import Text.Printf
import System.Time