tests: port all unit tests to tasty, first cut (#1090)

easytest is not actively maintained and requires an old version of
hedgehog which does not support base-compat 0.11 & ghc 8.8.

This is still using the old easytest helpers, and not displaying test
names properly.
This commit is contained in:
Simon Michael 2019-11-26 13:56:14 -08:00
parent 8952dc9a93
commit 13a3542464
17 changed files with 358 additions and 417 deletions

View File

@ -1324,16 +1324,16 @@ tests_Journal = tests "Journal" [
,tests "journalBalanceTransactions" [
test "balance-assignment" $ do
test "balance-assignment" $ testCaseSteps "sometests" $ \_step -> do
let ej = journalBalanceTransactions True $
--2019/01/01
-- (a) = 1
nulljournal{ jtxns = [
transaction "2019/01/01" [ vpost' "a" missingamt (balassert (num 1)) ]
]}
expectRight ej
assertRight ej
let Right j = ej
(jtxns j & head & tpostings & head & pamount) `is` Mixed [num 1]
(jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1]
,test "same-day-1" $ do
expectRight $ journalBalanceTransactions True $

View File

@ -18,7 +18,7 @@ import "base-compat-batteries" Prelude.Compat
import Numeric
import Data.Char (isPrint)
import Data.Maybe
import qualified Data.Text as T
-- import qualified Data.Text as T
import Text.Megaparsec
import Text.Megaparsec.Char
@ -157,7 +157,7 @@ tests_StringFormat = tests "StringFormat" [
]
,tests "parseStringFormat" $
let s `gives` expected = test (T.pack s) $ parseStringFormat s `is` Right expected
let s `gives` expected = test s $ parseStringFormat s `is` Right expected
in [
"" `gives` (defaultStringFormatStyle [])
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])

View File

@ -115,32 +115,31 @@ entryFromTimeclockInOut i o
-- tests
tests_Timeclock = tests "Timeclock" [
do
today <- io getCurrentDay
now' <- io getCurrentTime
tz <- io getCurrentTimeZone
let now = utcToLocalTime tz now'
nowstr = showtime now
yesterday = prevday today
clockin = TimeclockEntry nullsourcepos In
mktime d = LocalTime d . fromMaybe midnight .
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
step "gathering data"
today <- getCurrentDay
now' <- getCurrentTime
tz <- getCurrentTimeZone
let now = utcToLocalTime tz now'
nowstr = showtime now
yesterday = prevday today
clockin = TimeclockEntry nullsourcepos In
mktime d = LocalTime d . fromMaybe midnight .
#if MIN_VERSION_time(1,5,0)
parseTimeM True defaultTimeLocale "%H:%M:%S"
parseTimeM True defaultTimeLocale "%H:%M:%S"
#else
parseTime defaultTimeLocale "%H:%M:%S"
parseTime defaultTimeLocale "%H:%M:%S"
#endif
showtime = formatTime defaultTimeLocale "%H:%M"
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future
tests "timeclockEntriesToTransactions" [
test "started yesterday, split session at midnight" $
txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr]
,test "split multi-day sessions at each midnight" $
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] `is `["23:00-23:59","00:00-23:59","00:00-"++nowstr]
,test "auto-clock-out if needed" $
txndescs [clockin (mktime today "00:00:00") "" ""] `is` ["00:00-"++nowstr]
,test "use the clockin time for auto-clockout if it's in the future" $
txndescs [clockin future "" ""] `is` [printf "%s-%s" futurestr futurestr]
]
showtime = formatTime defaultTimeLocale "%H:%M"
txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now
future = utcToLocalTime tz $ addUTCTime 100 now'
futurestr = showtime future
step "started yesterday, split session at midnight"
txndescs [clockin (mktime yesterday "23:00:00") "" ""] @?= ["23:00-23:59","00:00-"++nowstr]
step "split multi-day sessions at each midnight"
txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" ""] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
step "auto-clock-out if needed"
txndescs [clockin (mktime today "00:00:00") "" ""] @?= ["00:00-"++nowstr]
step "use the clockin time for auto-clockout if it's in the future"
txndescs [clockin future "" ""] @?= [printf "%s-%s" futurestr futurestr]
]

View File

@ -596,7 +596,7 @@ tests_Transaction =
-- one missing amount, not the last one
t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]}
-- unbalanced amounts when precision is limited (#931)
t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
-- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
in tests
"postingsAsLines"
[ test "null-transaction" $
@ -635,10 +635,11 @@ tests_Transaction =
let t = t3
in postingsAsLines False (tpostings t) `is`
[" a $1.00", " b", " c $-1.00"]
, _test "ensure-visibly-balanced" $
let t = t4
in postingsAsLines False (tpostings t) `is`
[" a $-0.01", " b $0.005", " c $0.005"]
-- , _test "ensure-visibly-balanced" $
-- let t = t4
-- in postingsAsLines False (tpostings t) `is`
-- [" a $-0.01", " b $0.005", " c $0.005"]
]
, tests
"inferBalancingAmount"

View File

@ -723,7 +723,7 @@ tests_Query = tests "Query" [
,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23)
,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23)
,parseAmountQueryTerm "-0.23" `is` (Eq,(-0.23))
,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX
-- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX
]
,tests "matchesAccount" [

View File

@ -1363,7 +1363,7 @@ tests_Common = tests "Common" [
,tests "spaceandamountormissingp" [
test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])
,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt
,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
-- ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
-- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
]

View File

@ -63,8 +63,8 @@ module Hledger.Read.JournalReader (
)
where
--- * imports
import qualified Prelude (fail)
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
-- import qualified Prelude (fail)
-- import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import qualified Control.Exception as C
import Control.Monad (forM_, when, void)
@ -668,41 +668,43 @@ tests_JournalReader = tests "JournalReader" [
let p = lift accountnamep :: JournalParser IO AccountName in
tests "accountnamep" [
test "basic" $ expectParse p "a:b:c"
,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO
,_test "empty leading component" $ expectParseError p ":b:c" "x"
,_test "empty trailing component" $ expectParseError p "a:b:" "x"
-- ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO
-- ,_test "empty leading component" $ expectParseError p ":b:c" "x"
-- ,_test "empty trailing component" $ expectParseError p "a:b:" "x"
]
-- "Parse a date in YYYY/MM/DD format.
-- Hyphen (-) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted."
,test "datep" $ do
test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
test "YYYY-MM-DD" $ expectParse datep "2018-01-01"
test "YYYY.MM.DD" $ expectParse datep "2018.01.01"
test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"
test "yearless date with default year" $ do
,tests "datep" [
test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
,test "YYYY-MM-DD" $ expectParse datep "2018-01-01"
,test "YYYY.MM.DD" $ expectParse datep "2018.01.01"
,test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"
,testCaseSteps "yearless date with default year" $ \_step -> do
let s = "1/1"
ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s
either (Prelude.fail . ("parse error at "++) . customErrorBundlePretty) (const ok) ep
test "no leading zero" $ expectParse datep "2018/1/1"
,test "datetimep" $ do
let
good = expectParse datetimep
bad = (\t -> expectParseError datetimep t "")
good "2011/1/1 00:00"
good "2011/1/1 23:59:59"
bad "2011/1/1"
bad "2011/1/1 24:00:00"
bad "2011/1/1 00:60:00"
bad "2011/1/1 00:00:60"
bad "2011/1/1 3:5:7"
test "timezone is parsed but ignored" $ do
let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0))
expectParseEq datetimep "2018/1/1 00:00-0800" t
expectParseEq datetimep "2018/1/1 00:00+1234" t
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
,test "no leading zero" $ expectParse datep "2018/1/1"
]
,let
good = expectParse datetimep
bad = (\t -> expectParseError datetimep t "")
in tests "datetimep" [
good "2011/1/1 00:00"
,good "2011/1/1 23:59:59"
,bad "2011/1/1"
,bad "2011/1/1 24:00:00"
,bad "2011/1/1 00:60:00"
,bad "2011/1/1 00:00:60"
,bad "2011/1/1 3:5:7"
,let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0))
in tests "timezone is parsed but ignored" [
expectParseEq datetimep "2018/1/1 00:00-0800" t
,expectParseEq datetimep "2018/1/1 00:00+1234" t
]
]
,tests "periodictransactionp" [
@ -883,41 +885,46 @@ tests_JournalReader = tests "JournalReader" [
-- directives
,tests "directivep" [
test "supports !" $ do
expectParseE directivep "!account a\n"
expectParseE directivep "!D 1.0\n"
tests "supports !" [
expectParseE directivep "!account a\n"
,expectParseE directivep "!D 1.0\n"
]
]
,test "accountdirectivep" $ do
test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n"
test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" ""
test "account-type-code" $ expectParse accountdirectivep "account a:b A\n"
test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")]
,adideclarationorder = 1
})
,tests "accountdirectivep" [
test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n"
,test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" ""
,test "account-type-code" $ expectParse accountdirectivep "account a:b A\n"
,test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")]
,adideclarationorder = 1
})
]
]
,test "commodityconversiondirectivep" $ do
expectParse commodityconversiondirectivep "C 1h = $50.00\n"
,test "defaultcommoditydirectivep" $ do
expectParse defaultcommoditydirectivep "D $1,000.0\n"
expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
,tests "defaultcommoditydirectivep" [
expectParse defaultcommoditydirectivep "D $1,000.0\n"
,expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
]
,test "defaultyeardirectivep" $ do
test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number"
test "12345" $ expectParse defaultyeardirectivep "Y 12345"
,tests "defaultyeardirectivep" [
test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
,test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number"
,test "12345" $ expectParse defaultyeardirectivep "Y 12345"
]
,test "ignoredpricecommoditydirectivep" $ do
expectParse ignoredpricecommoditydirectivep "N $\n"
,test "includedirectivep" $ do
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
,tests "includedirectivep" [
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
,test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
]
,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
"P 2017/01/30 BTC $922.83\n"
@ -930,10 +937,10 @@ tests_JournalReader = tests "JournalReader" [
,test "tagdirectivep" $ do
expectParse tagdirectivep "tag foo \n"
,test "endtagdirectivep" $ do
expectParse endtagdirectivep "end tag \n"
expectParse endtagdirectivep "pop \n"
,tests "endtagdirectivep" [
expectParse endtagdirectivep "end tag \n"
,expectParse endtagdirectivep "pop \n"
]
,tests "journalp" [
test "empty file" $ expectParseEqE journalp "" nulljournal
@ -941,10 +948,10 @@ tests_JournalReader = tests "JournalReader" [
-- these are defined here rather than in Common so they can use journalp
,tests "parseAndFinaliseJournal" [
test "basic" $ do
ej <- io $ runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
testCaseSteps "basic" $ \_step -> do
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
let Right j = ej
expectEqPP [""] $ journalFilePaths j
assertEq [""] $ journalFilePaths j
]
]

View File

@ -248,16 +248,15 @@ Right samplejournal2 =
}
tests_BalanceReport = tests "BalanceReport" [
tests "balanceReport" $
let
(opts,journal) `gives` r = do
let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
(map showw eitems) `is` (map showw aitems)
(showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal)
usd0 = usd 0
in [
let
(opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
(map showw eitems) @?= (map showw aitems)
(showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal)
usd0 = usd 0
in tests "balanceReport" [
test "balanceReport with no args on null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt])

View File

@ -417,13 +417,13 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
tests_MultiBalanceReport = tests "MultiBalanceReport" [
let
(opts,journal) `gives` r = do
(opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do
let (eitems, etotal) = r
(MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal
showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) `is` (map showw eitems)
((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals
usd0 = usd 0
(map showw aitems) @?= (map showw eitems)
((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals
-- usd0 = usd 0
amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
in
tests "multiBalanceReport" [
@ -439,27 +439,27 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
],
Mixed [nullamt])
,_test "a valid history on an empty period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
(
[
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
],
Mixed [usd0])
-- ,_test "a valid history on an empty period" $
-- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- (
-- [
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
-- ],
-- Mixed [usd0])
,_test "a valid history on an empty period (more complex)" $
(defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
(
[
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])
,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
],
Mixed [usd0])
-- ,_test "a valid history on an empty period (more complex)" $
-- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- (
-- [
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
-- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
-- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])
-- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
-- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
-- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
-- ],
-- Mixed [usd0])
]
]

View File

@ -4,229 +4,225 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Utils.Test (
HasCallStack
,module EasyTest
,runEasytests
module Test.Tasty
,module Test.Tasty.HUnit
-- ,module QC
-- ,module SC
,tests
,_tests
,test
,_test
,it
,_it
,is
,expectEqPP
,expect
,assertEq
,expectEq
,assertLeft
,expectLeft
,assertRight
,expectRight
,expectParse
,expectParseE
,expectParseError
,expectParseErrorE
,expectParseEq
,expectParseEqE
,expectParseEqOn
,expectParseEqOnE
,expectParseError
,expectParseE
,expectParseEqE
,expectParseErrorE
,expectParseStateOn
)
where
import Control.Exception
import Test.Tasty
import Test.Tasty.HUnit
-- import Test.Tasty.QuickCheck as QC
-- import Test.Tasty.SmallCheck as SC
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.State.Strict (StateT, evalStateT, execStateT)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Data.CallStack
import Data.List
-- #if !(MIN_VERSION_base(4,11,0))
-- import Data.Monoid ((<>))
-- #endif
-- import Data.CallStack
import Data.List (isInfixOf)
import qualified Data.Text as T
import Safe
import System.Exit
import Text.Megaparsec
import Text.Megaparsec.Custom
import EasyTest hiding (char, char', tests) -- reexported
import qualified EasyTest as E -- used here
import Hledger.Utils.Debug (pshow)
import Hledger.Utils.UTF8IOCompat (error')
-- import Hledger.Utils.UTF8IOCompat (error')
-- * easytest helpers
-- * tasty helpers
-- | Name the given test(s). A readability synonym for easytest's "scope".
test :: T.Text -> E.Test a -> E.Test a
test = E.scope
-- | Name and group a list of tests.
tests :: String -> [TestTree] -> TestTree
tests = testGroup
-- | Name the given test(s).
-- test :: T.Text -> E.Test a -> E.Test a
-- test :: String -> Assertion -> TestTree
test :: String -> TestTree -> TestTree
test _name = id
-- | Skip the given test(s), with the same type signature as "test".
-- If called in a monadic sequence of tests, also skips following tests.
_test :: T.Text -> E.Test a -> E.Test a
_test _name = (E.skip >>)
-- If called in a monadic sequence of tests, also skips following tests. (?)
-- _test :: T.Text -> E.Test a -> E.Test a
-- _test _name = (E.skip >>)
-- | Name the given test(s). A synonym for "test".
it :: T.Text -> E.Test a -> E.Test a
it = test
-- | Short equality test constructor. Actual value on the left, expected on the right.
is :: (Eq a, Show a, HasCallStack) => a -> a -> TestTree
is actual expected = testCase "sometest" $ actual @?= expected
-- | Skip the given test(s), and any following tests in a monadic sequence.
-- A synonym for "_test".
_it :: T.Text -> E.Test a -> E.Test a
_it = _test
-- | Expect True.
expect :: HasCallStack => Bool -> TestTree
expect val = testCase "sometest" $ assertBool "was false" val
-- | Name and group a list of tests. Combines easytest's "scope" and "tests".
tests :: T.Text -> [E.Test ()] -> E.Test ()
tests name = E.scope name . E.tests
-- | Assert equality. Expected first, actual second.
assertEq :: (HasCallStack, Eq a, Show a) => a -> a -> Assertion
assertEq expected actual = assertEqual "was not equal" expected actual
-- | Skip the given list of tests, and any following tests in a monadic sequence,
-- with the same type signature as "group".
_tests :: T.Text -> [E.Test ()] -> E.Test ()
_tests _name = (E.skip >>) . E.tests
-- | Test for equality. Expected first, actual second.
expectEq :: (HasCallStack, Eq a, Show a) => a -> a -> TestTree
expectEq a b = testCase "sometest" $ assertEq a b
-- | Run some easytest tests, catching easytest's ExitCode exception,
-- returning True if there was a problem.
-- With arguments, runs only the scope (or single test) named by the first argument
-- (exact, case sensitive).
-- If there is a second argument, it should be an integer and will be used
-- as the seed for randomness.
runEasytests :: [String] -> E.Test () -> IO Bool
runEasytests args tests = (do
case args of
[] -> E.run tests
[a] -> E.runOnly (T.pack a) tests
a:b:_ -> do
case readMay b :: Maybe Int of
Nothing -> error' "the second argument should be an integer (a seed for easytest)"
Just seed -> E.rerunOnly seed (T.pack a) tests
return False
)
`catch` (\(_::ExitCode) -> return True)
-- | Assert any Left value.
assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Left _) = return ()
assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")"
-- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value)
-- but pretty-prints the values in the failure output.
expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test ()
expectEqPP expected actual = if expected == actual then E.ok else E.crash $
"\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n"
-- | Test for any Left value.
expectLeft :: (HasCallStack, Eq a, Show a) => Either e a -> TestTree
expectLeft = testCase "sometest" . assertLeft
-- | Shorter and flipped version of expectEqPP. The expected value goes last.
is :: (Eq a, Show a, HasCallStack) => a -> a -> Test ()
is = flip expectEqPP
-- | Assert any Right value.
assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Right _) = return ()
assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a ++ ")"
-- | Test for any Right value.
expectRight :: (HasCallStack, Eq a, Show a) => Either a b -> TestTree
expectRight = testCase "sometest" . assertRight
-- | Test that this stateful parser runnable in IO successfully parses
-- all of the given input text, showing the parse error if it fails.
-- Suitable for hledger's JournalParser parsers.
expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
expectParse parser input = do
ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const ok)
-- expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
-- StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
expectParse :: (HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> TestTree
expectParse parser input = testCaseSteps "sometest" $ \_step -> do
ep <- runParserT (evalStateT (parser <* eof) mempty) "" input
either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const $ return ())
ep
-- -- pretty-printing both if it fails.
-- | Like expectParse, but also test the parse result is an expected value.
expectParseEq :: (HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> TestTree
expectParseEq parser input expected = expectParseEqOn parser input id expected
-- | Like expectParseEq, but transform the parse result with the given function
-- before comparing it.
expectParseEqOn :: (HasCallStack, Eq b, Show b, Monoid st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> TestTree
expectParseEqOn parser input f expected = testCaseSteps "sometest" $ \_step -> do
ep <- runParserT (evalStateT (parser <* eof) mempty) "" input
either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
(assertEq expected . f)
ep
-- | Test that this stateful parser runnable in IO fails to parse
-- the given input text, with a parse error containing the given string.
expectParseError :: (HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> TestTree
expectParseError parser input errstr = testCaseSteps "sometest" $ \_step -> do
ep <- runParserT (evalStateT parser mempty) "" (T.pack input)
case ep of
Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
Left e -> do
let e' = customErrorBundlePretty e
if errstr `isInfixOf` e'
then return ()
else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
-- Suitable for hledger's ErroringJournalParser parsers.
expectParseE
:: (Monoid st, Eq a, Show a, HasCallStack)
:: (HasCallStack, Eq a, Show a, Monoid st)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text
-> E.Test ()
expectParseE parser input = do
-> TestTree
expectParseE parser input = testCaseSteps "sometest" $ \_step -> do
let filepath = ""
eep <- E.io $ runExceptT $
eep <- runExceptT $
runParserT (evalStateT (parser <* eof) mempty) filepath input
case eep of
Left finalErr ->
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
in fail $ "parse error at " <> prettyErr
in assertFailure $ "parse error at " <> prettyErr
Right ep ->
either (fail.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const ok)
either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty)
(const $ return ())
ep
-- | Test that this stateful parser runnable in IO fails to parse
-- the given input text, with a parse error containing the given string.
expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> E.Test ()
expectParseError parser input errstr = do
ep <- E.io (runParserT (evalStateT parser mempty) "" input)
case ep of
Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
Left e -> do
let e' = customErrorBundlePretty e
if errstr `isInfixOf` e'
then ok
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
expectParseErrorE
:: (Monoid st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text
-> String
-> E.Test ()
expectParseErrorE parser input errstr = do
let filepath = ""
eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input
case eep of
Left finalErr -> do
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
if errstr `isInfixOf` prettyErr
then ok
else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
Right ep -> case ep of
Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
Left e -> do
let e' = customErrorBundlePretty e
if errstr `isInfixOf` e'
then ok
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
-- | Like expectParse, but also test the parse result is an expected value,
-- pretty-printing both if it fails.
expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
expectParseEq parser input expected = expectParseEqOn parser input id expected
expectParseEqE
:: (Monoid st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text
-> a
-> E.Test ()
-> TestTree
expectParseEqE parser input expected = expectParseEqOnE parser input id expected
-- | Like expectParseEq, but transform the parse result with the given function
-- before comparing it.
expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test ()
expectParseEqOn parser input f expected = do
ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input
either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
(expectEqPP expected . f)
ep
expectParseEqOnE
:: (Monoid st, Eq b, Show b, HasCallStack)
:: (HasCallStack, Eq b, Show b, Monoid st)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text
-> (a -> b)
-> b
-> E.Test ()
expectParseEqOnE parser input f expected = do
-> TestTree
expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> do
let filepath = ""
eep <- E.io $ runExceptT $
runParserT (evalStateT (parser <* eof) mempty) filepath input
eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input
case eep of
Left finalErr ->
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
in fail $ "parse error at " <> prettyErr
in assertFailure $ "parse error at " <> prettyErr
Right ep ->
either (fail . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
(expectEqPP expected . f)
either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty)
(assertEq expected . f)
ep
expectParseErrorE
:: (Monoid st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
-> T.Text
-> String
-> TestTree
expectParseErrorE parser input errstr = testCaseSteps "sometest" $ \_step -> do
let filepath = ""
eep <- runExceptT $ runParserT (evalStateT parser mempty) filepath input
case eep of
Left finalErr -> do
let prettyErr = finalErrorBundlePretty $ attachSource filepath input finalErr
if errstr `isInfixOf` prettyErr
then return ()
else assertFailure $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
Right ep -> case ep of
Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
Left e -> do
let e' = customErrorBundlePretty e
if errstr `isInfixOf` e'
then return ()
else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
-- | Run a stateful parser in IO like expectParse, then compare the
-- final state (the wrapped state, not megaparsec's internal state),
-- transformed by the given function, with the given expected value.
expectParseStateOn :: (HasCallStack, Monoid st, Eq b, Show b) =>
expectParseStateOn :: (HasCallStack, Eq b, Show b, Monoid st) =>
StateT st (ParsecT CustomErr T.Text IO) a
-> T.Text
-> (st -> b)
-> b
-> E.Test ()
expectParseStateOn parser input f expected = do
es <- E.io $ runParserT (execStateT (parser <* eof) mempty) "" input
-> TestTree
expectParseStateOn parser input f expected = testCaseSteps "sometest" $ \_step -> do
es <- runParserT (execStateT (parser <* eof) mempty) "" input
case es of
Left err -> fail $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err
Right s -> expectEqPP expected $ f s
Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err
Right s -> assertEq expected $ f s

View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 4b32c89e49ba64c66ca8552bb3ac2d54099cff23f9950b7fe294a32297a9b01a
-- hash: f8ee8c9fd0412cc0a8cd5c6286b7ef4f9a33ae2a30989dfc0b99c3f79bd55622
name: hledger-lib
version: 1.15.99
@ -107,7 +107,7 @@ library
, Glob >=0.9
, ansi-terminal >=0.6.2.3
, array
, base >=4.9 && <4.13
, base >=4.9 && <4.14
, base-compat-batteries >=0.10.1 && <0.12
, blaze-markup >=0.5.1
, bytestring
@ -119,7 +119,6 @@ library
, data-default >=0.5
, deepseq
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, fgl >=5.5.4.0
, file-embed >=0.0.10
@ -136,6 +135,8 @@ library
, safe >=0.2
, split >=0.1
, tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
, template-haskell
, text >=1.2
, time >=1.5
@ -160,7 +161,7 @@ test-suite doctests
, Glob >=0.7
, ansi-terminal >=0.6.2.3
, array
, base >=4.9 && <4.13
, base >=4.9 && <4.14
, base-compat-batteries >=0.10.1 && <0.12
, blaze-markup >=0.5.1
, bytestring
@ -173,7 +174,6 @@ test-suite doctests
, deepseq
, directory
, doctest >=0.16
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, fgl >=5.5.4.0
, file-embed >=0.0.10
@ -190,6 +190,8 @@ test-suite doctests
, safe >=0.2
, split >=0.1
, tabular >=0.2
, tasty >=1.2.3
, tasty-hunit >=0.10.0.2
, template-haskell
, text >=1.2
, time >=1.5
@ -204,58 +206,3 @@ test-suite doctests
if (impl(ghc < 8.2))
buildable: False
default-language: Haskell2010
test-suite easytests
type: exitcode-stdio-1.0
main-is: easytests.hs
hs-source-dirs:
./.
test
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
build-depends:
Decimal
, Glob >=0.9
, ansi-terminal >=0.6.2.3
, array
, base >=4.9 && <4.13
, base-compat-batteries >=0.10.1 && <0.12
, blaze-markup >=0.5.1
, bytestring
, call-stack
, cassava
, cassava-megaparsec
, cmdargs >=0.10
, containers
, data-default >=0.5
, deepseq
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, fgl >=5.5.4.0
, file-embed >=0.0.10
, filepath
, hashtables >=1.2.3.1
, hledger-lib
, megaparsec >=7.0.0 && <8
, mtl
, mtl-compat
, old-time
, parsec >=3
, parser-combinators >=0.4.0
, pretty-show >=1.6.4
, regex-tdfa
, safe >=0.2
, split >=0.1
, tabular >=0.2
, template-haskell
, text >=1.2
, time >=1.5
, timeit
, transformers >=0.2
, uglymemo
, utf8-string >=0.3.5
buildable: True
if (!impl(ghc >= 8.0))
build-depends:
semigroups ==0.18.*
default-language: Haskell2010

View File

@ -39,7 +39,7 @@ extra-source-files:
#data-files:
dependencies:
- base >=4.9 && <4.13
- base >=4.9 && <4.14
- base-compat-batteries >=0.10.1 && <0.12
- ansi-terminal >=0.6.2.3
- array
@ -54,7 +54,6 @@ dependencies:
- Decimal
- deepseq
- directory
- easytest >= 0.2.1 && <0.3
- fgl >=5.5.4.0
- file-embed >=0.0.10
- filepath
@ -70,6 +69,8 @@ dependencies:
- safe >=0.2
- split >=0.1
- tabular >=0.2
- tasty >=1.2.3
- tasty-hunit >=0.10.0.2
- template-haskell
- text >=1.2
- time >=1.5
@ -186,10 +187,10 @@ tests:
buildable: false
easytests:
buildable: true
source-dirs: test
main: easytests.hs
other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188
dependencies:
- hledger-lib
# easytests:
# buildable: true
# source-dirs: test
# main: easytests.hs
# other-modules: [] # prevent double compilation, https://github.com/sol/hpack/issues/188
# dependencies:
# - hledger-lib

View File

@ -55,9 +55,8 @@ import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import qualified EasyTest
import System.Environment (withArgs)
import System.Console.CmdArgs.Explicit as C
import System.Exit
import Hledger
import Hledger.Cli.CliOptions
@ -267,19 +266,14 @@ testmode = hledgerCommandMode
-- not be used (and would raise an error).
testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _undefined = do
let args = words' $ query_ $ reportopts_ opts
-- workaround for https://github.com/joelburget/easytest/issues/11
-- import System.IO (hSetEncoding, stdout, stderr, utf8)
-- hSetEncoding stdout utf8
-- hSetEncoding stderr utf8
e <- runEasytests args $ EasyTest.tests [
tests_Hledger
,tests "Hledger.Cli" [
tests_Cli_Utils
,tests_Commands
withArgs (words' $ query_ $ reportopts_ opts) $
defaultMain $ tests "sometests" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests
tests_Hledger
,tests "Hledger.Cli" [
tests_Cli_Utils
,tests_Commands
]
]
]
if e then exitFailure else exitSuccess
tests_Commands = tests "Commands" [
@ -288,60 +282,62 @@ tests_Commands = tests "Commands" [
-- some more tests easiest to define here:
,test "apply account directive" $ do
let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
let sameParse str1 str2 = do j1 <- io $ readJournal def Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- io $ readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
j1 `is` j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <>
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
)
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <>
"2008/12/07 Five\n foo $-5\n bar $5\n"
)
,test "apply account directive" $ let
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do
j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos)
j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
in sameParse
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <>
"apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <>
"end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <>
"end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n"
)
("2008/12/07 One\n alpha $-1\n beta $1\n" <>
"2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <>
"2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <>
"2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <>
"2008/12/07 Five\n foo $-5\n bar $5\n"
)
,test "apply account directive should preserve \"virtual\" posting type" $ do
j <- io $ readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do
j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
paccount p `is` "test:from"
ptype p `is` VirtualPosting
paccount p @?= "test:from"
ptype p @?= VirtualPosting
,test "account aliases" $ do
j <- io $ readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
,testCaseSteps "account aliases" $ \_step -> do
j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j
paccount p `is` "equity:draw:personal:food"
paccount p @?= "equity:draw:personal:food"
,test "ledgerAccountNames" $
ledgerAccountNames ledger7 `is`
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
,testCase "ledgerAccountNames" $
(ledgerAccountNames ledger7)
@?=
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
-- ,test "journalCanonicaliseAmounts" ~:
-- "use the greatest precision" ~:
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2]
-- don't know what this should do
-- ,test "elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- `is` "aa:aa:aaaaaaaaaaaaaa")
-- @?= "aa:aa:aaaaaaaaaaaaaa")
,test "default year" $ do
j <- io $ readJournal def Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) `is` fromGregorian 2009 1 1
,testCaseSteps "default year" $ \_step -> do
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
,test "show dollars" $ showAmount (usd 1) `is` "$1.00"
,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00"
,test "show hours" $ showAmount (hrs 1) `is` "1.00h"
,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h"
]

View File

@ -640,10 +640,10 @@ balanceReportTableAsText ropts = tableAsText ropts showamt
tests_Balance = tests "Balance" [
tests "balanceReportAsText" [
test "unicode in balance layout" $ do
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
testCaseSteps "unicode in balance layout" $ \_step -> do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`
balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?=
unlines
[" -100 актив:наличные"
," 100 расходы:покупки"

View File

@ -194,10 +194,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
tests_Register = tests "Register" [
tests "postingsReportAsText" [
test "unicode in register layout" $ do
j <- io $ readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
testCaseSteps "unicode in register layout" $ \_step -> do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100"
," актив:наличные -100 0"]
]

View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 6bdd5e55ef3db9761bde530f23cd7fe97dc63e707e18129732a4d827505c6aa4
-- hash: a8cb399c2c97d23c9fc48e12709494216df3069cce7ec448277be8fde91f72d0
name: hledger
version: 1.15.99
@ -156,7 +156,6 @@ library
, containers
, data-default >=0.5
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, filepath
, hashable >=1.2.4
@ -208,7 +207,6 @@ executable hledger
, containers
, data-default >=0.5
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, filepath
, haskeline >=0.6
@ -260,7 +258,6 @@ test-suite test
, containers
, data-default >=0.5
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, filepath
, haskeline >=0.6
@ -312,7 +309,6 @@ benchmark bench
, criterion
, data-default >=0.5
, directory
, easytest >=0.2.1 && <0.3
, extra >=1.6.3
, filepath
, haskeline >=0.6

View File

@ -115,7 +115,6 @@ dependencies:
- data-default >=0.5
- Decimal
- directory
- easytest >= 0.2.1 && <0.3
- extra >=1.6.3
- filepath
- haskeline >=0.6