From c67404c73dc5c41d885c2665d4d4fd76e22547b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Mon, 18 Jun 2018 00:23:41 +0200 Subject: [PATCH] lib: Fix compile errors in tests --- hledger-lib/Hledger/Data/Journal.hs | 2 - hledger-lib/Hledger/Read.hs | 1 + hledger-lib/Hledger/Read/Common.hs | 26 +++-- hledger-lib/Hledger/Read/JournalReader.hs | 95 ++++++++----------- .../Hledger/Read/LedgerReader.hs.disabled | 4 - 5 files changed, 58 insertions(+), 70 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 314fd9ea9..d47dd2bc2 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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. diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 462f8eab3..c3b78d214 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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, diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index d454ed26e..0cc917d17 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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] diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 773454a72..fa32a79ae 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/LedgerReader.hs.disabled b/hledger-lib/Hledger/Read/LedgerReader.hs.disabled index c5498a598..32282c4c2 100644 --- a/hledger-lib/Hledger/Read/LedgerReader.hs.disabled +++ b/hledger-lib/Hledger/Read/LedgerReader.hs.disabled @@ -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