diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index 6c59b4724..c0903adc4 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -115,12 +115,12 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs where rmsg | rsumok = "" - | not rsignsok = "real postings all have the same sign" - | otherwise = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost + | not rsignsok = "The real postings all have the same sign. Consider negating some of them." + | otherwise = "The real postings' sum should be 0 but is: " ++ showMixedAmountOneLine rsumcost bvmsg | bvsumok = "" - | not bvsignsok = "balanced virtual postings all have the same sign" - | otherwise = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost + | not bvsignsok = "The balanced virtual postings all have the same sign. Consider negating some of them." + | otherwise = "The balanced virtual postings' sum should be 0 but is: " ++ showMixedAmountOneLine bvsumcost -- | Legacy form of transactionCheckBalanced. isTransactionBalanced :: BalancingOpts -> Transaction -> Bool @@ -157,20 +157,36 @@ balanceTransactionHelper bopts t = do if infer_transaction_prices_ bopts then inferBalancingPrices t else t case transactionCheckBalanced bopts t' of [] -> Right (txnTieKnot t', inferredamtsandaccts) - errs -> Left $ transactionBalanceError t' errs + errs -> Left $ transactionBalanceError t' errs' + where + ismulticommodity = (length $ transactionCommodities t') > 1 + errs' = + [ "Automatic commodity conversion is not enabled." + | ismulticommodity && not (infer_transaction_prices_ bopts) + ] ++ + errs ++ + if ismulticommodity + then + [ "Consider adjusting this entry's amounts, adding missing postings," + , "or recording conversion price(s) with @, @@ or equity postings." + ] + else + [ "Consider adjusting this entry's amounts, or adding missing postings." + ] + +transactionCommodities :: Transaction -> S.Set CommoditySymbol +transactionCommodities t = mconcat $ map (maCommodities . pamount) $ tpostings t -- | Generate a transaction balancing error message, given the transaction -- and one or more suberror messages. transactionBalanceError :: Transaction -> [String] -> String -transactionBalanceError t errs = printf (unlines - [ "unbalanced transaction: %s:", - "%s", - "\n%s" - ]) +transactionBalanceError t errs = printf "%s:\n%s\n\nThis %stransaction is unbalanced.\n%s" (sourcePosPairPretty $ tsourcepos t) (textChomp ex) + (if ismulticommodity then "multi-commodity " else "" :: String) (chomp $ unlines errs) where + ismulticommodity = (length $ transactionCommodities t) > 1 (_f,_l,_mcols,ex) = makeTransactionErrorExcerpt t finderrcols where finderrcols _ = Nothing @@ -193,12 +209,12 @@ inferBalancingAmount :: inferBalancingAmount styles t@Transaction{tpostings=ps} | length amountlessrealps > 1 = Left $ transactionBalanceError t - ["can't have more than one real posting with no amount" - ,"(remember to put two or more spaces between account and amount)"] + ["There can't be more than one real posting with no amount." + ,"(Remember to put two or more spaces between account and amount.)"] | length amountlessbvps > 1 = Left $ transactionBalanceError t - ["can't have more than one balanced virtual posting with no amount" - ,"(remember to put two or more spaces between account and amount)"] + ["There can't be more than one balanced virtual posting with no amount." + ,"(Remember to put two or more spaces between account and amount.)"] | otherwise = let psandinferredamts = map inferamount ps inferredacctsandamts = [(paccount p, amt) | (p, Just amt) <- psandinferredamts] @@ -577,42 +593,45 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt aquantity -- traceWith (("actual:"++).showAmountDebug) actualbalincomm - errmsg = printf (unlines - [ "balance assertion: %s:", + errmsg = chomp $ printf (unlines + [ "%s:", "%s\n", + "This balance assertion failed.", -- "date: %s", - "account: %-30s%s", - "commodity: %-30s%s", + "In account: %s", + "and commodity: %s", -- "display precision: %d", - "asserted: %s", -- (at display precision: %s)", - "actual: %s", -- (at display precision: %s)", - "difference: %s" + "this balance was asserted: %s", -- (at display precision: %s)", + "but the actual balance is: %s", -- (at display precision: %s)", + "a difference of: %s", + "", + "Consider viewing this account's register to troubleshoot. Eg:", + "", + "hledger reg -I '%s'%s" ]) (sourcePosPretty pos) (textChomp ex) -- (showDate $ postingDate p) - (T.unpack $ paccount p) -- XXX pack - (if isinclusive then " (including subaccounts)" else "" :: String) - assertedcomm - (if istotal then " (no other commodity balance allowed)" else "" :: String) + (if isinclusive then printf "%-30s (including subaccounts)" acct else acct) + (if istotal then printf "%-30s (no other commodities allowed)" (T.unpack assertedcomm) else (T.unpack assertedcomm)) -- (asprecision $ astyle actualbalincommodity) -- should be the standard display precision I think - (show $ aquantity actualbalincomm) - -- (showAmount actualbalincommodity) (show $ aquantity assertedamt) -- (showAmount assertedamt) + (show $ aquantity actualbalincomm) + -- (showAmount actualbalincommodity) (show $ aquantity assertedamt - aquantity actualbalincomm) + (acct ++ if isinclusive then "" else "$") + (if istotal then "" else (" cur:'"++T.unpack assertedcomm++"'")) where + acct = T.unpack $ paccount p ass = fromJust $ pbalanceassertion p -- PARTIAL: fromJust won't fail, there is a balance assertion pos = baposition ass (_,_,_,ex) = makePostingErrorExcerpt p finderrcols where finderrcols p t trendered = Just (col, Just col2) where - -- col = unPos $ sourceColumn pos - -- col2 = col + (length $ wbUnpack $ showBalanceAssertion ass) - -- The saved parse position may not correspond to the rendering in the error message. - -- Instead, we analyse the rendering to find the columns: - tlines = length $ T.lines $ tcomment t -- transaction comment can generate extra lines + -- Analyse the rendering to find the columns to highlight. + tlines = dbg5 "tlines" $ max 1 $ length $ T.lines $ tcomment t -- transaction comment can generate extra lines (col, col2) = let def = (5, maximum (map T.length $ T.lines trendered)) -- fallback: underline whole posting. Shouldn't happen. in @@ -621,8 +640,8 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt Just idx -> fromMaybe def $ do let beforeps = take (idx-1) $ tpostings t - beforepslines = sum $ map (length . T.lines . pcomment) beforeps -- posting comment can generate extra lines (assume only one commodity shown) - assertionline <- headMay $ drop (tlines + beforepslines) $ T.lines trendered + beforepslines = dbg5 "beforepslines" $ sum $ map (max 1 . length . T.lines . pcomment) beforeps -- posting comment can generate extra lines (assume only one commodity shown) + assertionline <- dbg5 "assertionline" $ headMay $ drop (tlines + beforepslines) $ T.lines trendered let col2 = T.length assertionline l = dropWhile (/= '=') $ reverse $ T.unpack assertionline @@ -646,7 +665,7 @@ checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p = when (hasBalanceAssignment p && isJust (pdate p)) $ throwError $ chomp $ unlines [ - "can't use balance assignment with custom posting date" + "Balance assignments and custom posting dates may not be combined." ,"" ,chomp1 $ T.unpack $ maybe (T.unlines $ showPostingLines p) showTransaction $ ptransaction p ,"Balance assignments may not be used on postings with a custom posting date" @@ -662,7 +681,7 @@ checkBalanceAssignmentUnassignableAccountB p = do unassignable <- R.asks bsUnassignable when (hasBalanceAssignment p && paccount p `S.member` unassignable) $ throwError $ chomp $ unlines [ - "can't use balance assignment with auto postings" + "Balance assignments and auto postings may not be combined." ,"" ,chomp1 $ T.unpack $ maybe (T.unlines $ showPostingLines p) (showTransaction) $ ptransaction p ,"Balance assignments may not be used on accounts affected by auto posting rules" diff --git a/hledger-lib/Hledger/Data/Errors.hs b/hledger-lib/Hledger/Data/Errors.hs index eb871e6f9..c398b2544 100644 --- a/hledger-lib/Hledger/Data/Errors.hs +++ b/hledger-lib/Hledger/Data/Errors.hs @@ -26,6 +26,7 @@ import Hledger.Utils -- on the transaction line, and a column(s) marker. -- Returns the file path, line number, column(s) if known, -- and the rendered excerpt, or as much of these as is possible. +-- A limitation: columns will be accurate for the rendered error message but not for the original journal data. makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex) -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form @@ -58,6 +59,7 @@ decorateTransactionErrorExcerpt l mcols txt = -- on the problem posting's line, and a column indicator. -- Returns the file path, line number, column(s) if known, -- and the rendered excerpt, or as much of these as is possible. +-- A limitation: columns will be accurate for the rendered error message but not for the original journal data. makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) makePostingErrorExcerpt p findpostingerrorcolumns = case ptransaction p of diff --git a/hledger-lib/Hledger/Data/JournalChecks.hs b/hledger-lib/Hledger/Data/JournalChecks.hs index 7f2d0d918..5ca75f40a 100644 --- a/hledger-lib/Hledger/Data/JournalChecks.hs +++ b/hledger-lib/Hledger/Data/JournalChecks.hs @@ -40,12 +40,21 @@ journalCheckAccounts j = mapM_ checkacct (journalPostings j) where checkacct p@Posting{paccount=a} | a `elem` journalAccountNamesDeclared j = Right () - | otherwise = Left $ - printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a + | otherwise = Left $ printf (unlines [ + "%s:%d:" + ,"%s" + ,"Strict account checking is enabled, and" + ,"account %s has not been declared." + ,"Consider adding an account directive. Examples:" + ,"" + ,"account %s" + ,"account %s ; type:A ; (L,E,R,X,C,V)" + ]) f l ex (show a) a a where - (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols - col = maybe 0 fst mcols - col2 = maybe 0 (fromMaybe 0 . snd) mcols + (f,l,_mcols,ex) = makePostingErrorExcerpt p finderrcols + -- Calculate columns suitable for highlighting the excerpt. + -- We won't show these in the main error line as they aren't + -- accurate for the actual data. finderrcols p _ _ = Just (col, Just col2) where col = 5 + if isVirtual p then 1 else 0 @@ -60,11 +69,18 @@ journalCheckCommodities j = mapM_ checkcommodities (journalPostings j) case findundeclaredcomm p of Nothing -> Right () Just (comm, _) -> - Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm + Left $ printf (unlines [ + "%s:%d:" + ,"%s" + ,"Strict commodity checking is enabled, and" + ,"commodity %s has not been declared." + ,"Consider adding a commodity directive. Examples:" + ,"" + ,"commodity %s1000.00" + ,"commodity 1.000,00 %s" + ]) f l ex (show comm) comm comm where - (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols - col = maybe 0 fst mcols - col2 = maybe 0 (fromMaybe 0 . snd) mcols + (f,l,_mcols,ex) = makePostingErrorExcerpt p finderrcols where -- Find the first undeclared commodity symbol in this posting's amount -- or balance assertion amount, if any. The boolean will be true if @@ -83,6 +99,10 @@ journalCheckCommodities j = mapM_ checkcommodities (journalPostings j) assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]] findundeclared = find (`M.notMember` jcommodities j) + -- Calculate columns suitable for highlighting the excerpt. + -- We won't show these in the main error line as they aren't + -- accurate for the actual data. + -- Find the best position for an error column marker when this posting -- is rendered by showTransaction. -- Reliably locating a problem commodity symbol in showTransaction output @@ -119,13 +139,22 @@ journalCheckPayees j = mapM_ checkpayee (jtxns j) checkpayee t | payee `elem` journalPayeesDeclared j = Right () | otherwise = Left $ - printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee + printf (unlines [ + "%s:%d:" + ,"%s" + ,"Strict payee checking is enabled, and" + ,"payee %s has not been declared." + ,"Consider adding a payee directive. Examples:" + ,"" + ,"payee %s" + ]) f l ex (show payee) payee where payee = transactionPayee t - (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols - col = maybe 0 fst mcols - col2 = maybe 0 (fromMaybe 0 . snd) mcols + (f,l,_mcols,ex) = makeTransactionErrorExcerpt t finderrcols + -- Calculate columns suitable for highlighting the excerpt. + -- We won't show these in the main error line as they aren't + -- accurate for the actual data. finderrcols t = Just (col, Just col2) where - col = T.length (showTransactionLineFirstPart t) + 2 + col = T.length (showTransactionLineFirstPart t) + 2 col2 = col + T.length (transactionPayee t) - 1 diff --git a/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs b/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs index 08da33954..51bb271ef 100755 --- a/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs +++ b/hledger-lib/Hledger/Data/JournalChecks/Ordereddates.hs @@ -6,11 +6,12 @@ where import Control.Monad (forM) import Data.List (groupBy) import Text.Printf (printf) -import Data.Maybe (fromMaybe) +import qualified Data.Text as T (pack, unlines) import Hledger.Data.Errors (makeTransactionErrorExcerpt) import Hledger.Data.Transaction (transactionFile, transactionDateOrDate2) import Hledger.Data.Types +import Hledger.Utils (textChomp) journalCheckOrdereddates :: WhichDate -> Journal -> Either String () journalCheckOrdereddates whichdate j = do @@ -26,15 +27,17 @@ journalCheckOrdereddates whichdate j = do FoldAcc{fa_previous=Nothing} -> Right () FoldAcc{fa_error=Nothing} -> Right () FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf - "%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s" - f l col col2 ex datenum tprevdate + ("%s:%d:\n%s\nOrdered dates checking is enabled, and this transaction's\n" + ++ "date%s (%s) is out of order with the previous transaction.\n" + ++ "Consider moving this entry into date order, or adjusting its date.") + f l ex datenum (show $ getdate t) where - (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols - col = maybe 0 fst mcols - col2 = maybe 0 (fromMaybe 0 . snd) mcols + (_,_,_,ex1) = makeTransactionErrorExcerpt tprev (const Nothing) + (f,l,_,ex2) = makeTransactionErrorExcerpt t finderrcols + -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them + ex = T.unlines [textChomp ex1, T.pack " ", textChomp ex2] finderrcols _t = Just (1, Just 10) datenum = if whichdate==SecondaryDate then "2" else "" - tprevdate = show $ getdate tprev data FoldAcc a b = FoldAcc { fa_error :: Maybe a diff --git a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs index 545349654..2e78f8039 100755 --- a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs +++ b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs @@ -11,13 +11,13 @@ import Data.List (groupBy, sortBy) import Data.Text (Text) import qualified Data.Text as T import Text.Printf (printf) -import Data.Maybe (fromMaybe) import Hledger.Data.AccountName (accountLeafName) import Hledger.Data.Errors (makePostingErrorExcerpt) import Hledger.Data.Journal (journalPostings, journalAccountNamesUsed) import Hledger.Data.Posting (isVirtual) import Hledger.Data.Types +import Hledger.Utils (chomp, textChomp) -- | Check that all the journal's postings are to accounts with a unique leaf name. -- Otherwise, return an error message for the first offending posting. @@ -26,9 +26,33 @@ journalCheckUniqueleafnames j = do -- find all duplicate leafnames, and the full account names they appear in case finddupes $ journalLeafAndFullAccountNames j of [] -> Right () - dupes -> - -- report the first posting that references one of them (and its position), for now - mapM_ (checkposting dupes) $ journalPostings j + -- pick the first duplicated leafname and show the transactions of + -- the first two postings using it, highlighting the second as the error. + (leaf,fulls):_ -> + case filter ((`elem` fulls).paccount) $ journalPostings j of + ps@(p:p2:_) -> Left $ chomp $ printf + ("%s:%d:\n%s\nChecking for unique account leaf names is enabled, and\n" + ++"account leaf name %s is not unique.\n" + ++"It appears in these account names, which are used in %d places:\n%s" + ++"\nConsider changing these account names so their last parts are different." + ) + f l ex (show leaf) (length ps) accts + where + -- t = fromMaybe nulltransaction ptransaction -- XXX sloppy + (_,_,_,ex1) = makePostingErrorExcerpt p (\_ _ _ -> Nothing) + (f,l,_,ex2) = makePostingErrorExcerpt p2 finderrcols + -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them + ex = T.unlines [textChomp ex1, T.pack " ...", textChomp ex2] + finderrcols p _ _ = Just (col, Just col2) + where + a = paccount p + alen = T.length a + llen = T.length $ accountLeafName a + col = 5 + (if isVirtual p then 1 else 0) + alen - llen + col2 = col + llen - 1 + accts = T.unlines fulls + + _ -> Right () -- shouldn't happen finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])] finddupes leafandfullnames = zip dupLeafs dupAccountNames @@ -42,24 +66,3 @@ finddupes leafandfullnames = zip dupLeafs dupAccountNames journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)] journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUsed where leafAndAccountName a = (accountLeafName a, a) - -checkposting :: [(Text,[AccountName])] -> Posting -> Either String () -checkposting leafandfullnames p@Posting{paccount=a} = - case [lf | lf@(_,fs) <- leafandfullnames, a `elem` fs] of - [] -> Right () - (leaf,fulls):_ -> Left $ printf - "%s:%d:%d-%d:\n%saccount leaf name \"%s\" is not unique\nit is used in account names: %s" - f l col col2 ex leaf accts - where - -- t = fromMaybe nulltransaction ptransaction -- XXX sloppy - col = maybe 0 fst mcols - col2 = maybe 0 (fromMaybe 0 . snd) mcols - (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols - where - finderrcols p _ _ = Just (col, Just col2) - where - alen = T.length $ paccount p - llen = T.length $ accountLeafName a - col = 5 + (if isVirtual p then 1 else 0) + alen - llen - col2 = col + llen - 1 - accts = T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index b0a9fb821..4fb93e769 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -28,7 +28,6 @@ import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Posting -import Hledger.Data.Transaction instance Show TimeclockEntry where show t = printf "%s %s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t) @@ -65,10 +64,10 @@ timeclockEntriesToTransactions now [i] o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} timeclockEntriesToTransactions now (i:o:rest) - | tlcode i /= In = errorExpectedCodeButGot In i - | tlcode o /= Out =errorExpectedCodeButGot Out o - | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest) - | otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactions now rest + | tlcode i /= In = errorExpectedCodeButGot In i + | tlcode o /= Out = errorExpectedCodeButGot Out o + | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest) + | otherwise = entryFromTimeclockInOut i o : timeclockEntriesToTransactions now rest where (itime,otime) = (tldatetime i,tldatetime o) (idate,odate) = (localDay itime,localDay otime) @@ -76,10 +75,19 @@ timeclockEntriesToTransactions now (i:o:rest) i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} {- HLINT ignore timeclockEntriesToTransactions -} -errorExpectedCodeButGot expected actual = errorWithSourceLine line $ "expected timeclock code " ++ (show expected) ++ " but got " ++ show (tlcode actual) - where line = unPos . sourceLine $ tlsourcepos actual - -errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg +errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a +errorExpectedCodeButGot expected actual = error' $ printf + ("%s:\n%s\n%s\n\nExpected timeclock %s entry but got %s.\n" + ++"Only one session may be clocked in at a time.\n" + ++"Please alternate i and o, beginning with i.") + (sourcePosPretty $ tlsourcepos actual) + (l ++ " | " ++ show actual) + (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^") + (show expected) + (show $ tlcode actual) + where + l = show $ unPos $ sourceLine $ tlsourcepos actual + c = unPos $ sourceColumn $ tlsourcepos actual -- | Convert a timeclock clockin and clockout entry to an equivalent journal -- transaction, representing the time expenditure. Note this entry is not balanced, @@ -87,9 +95,23 @@ errorWithSourceLine line msg = error $ "line " ++ show line ++ ": " ++ msg entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction entryFromTimeclockInOut i o | otime >= itime = t - | otherwise = error' . T.unpack $ - "clock-out time less than clock-in time in:\n" <> showTransaction t -- PARTIAL: + | otherwise = + -- Clockout time earlier than clockin is an error. + -- (Clockin earlier than preceding clockin/clockout is allowed.) + error' $ printf + ("%s:\n%s\nThis clockout time (%s) is earlier than the previous clockin.\n" + ++"Please adjust it to be later than %s.") + (sourcePosPretty $ tlsourcepos o) + (unlines [ + replicate (length l) ' '++ " | " ++ show i, + l ++ " | " ++ show o, + (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ replicate 19 '^') + ]) + (show $ tldatetime o) + (show $ tldatetime i) where + l = show $ unPos $ sourceLine $ tlsourcepos o + c = (unPos $ sourceColumn $ tlsourcepos o) + 2 t = Transaction { tindex = 0, tsourcepos = (tlsourcepos i, tlsourcepos i), diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b464d4e6c..b1adbec0f 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -498,11 +498,12 @@ datep' mYear = do let dateStr = show year ++ [sep1] ++ show month ++ [sep2] ++ show day when (sep1 /= sep2) $ customFailure $ parseErrorAtRegion startOffset endOffset $ - "invalid date: separators are different, should be the same" + "This date is malformed because the separators are different.\n" + ++"Please use consistent separators." case fromGregorianValid year month day of Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ - "well-formed but invalid date: " ++ dateStr + "This date is invalid, please correct it: " ++ dateStr Just date -> pure $! date partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day @@ -512,12 +513,13 @@ datep' mYear = do Just year -> case fromGregorianValid year month day of Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ - "well-formed but invalid date: " ++ dateStr + "This date is invalid, please correct it: " ++ dateStr Just date -> pure $! date where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day Nothing -> customFailure $ parseErrorAtRegion startOffset endOffset $ - "partial date "++dateStr++" found, but the current year is unknown" + "The partial date "++dateStr++" can not be parsed because the current year is unknown.\n" + ++"Consider making it a full date, or add a default year directive.\n" where dateStr = show month ++ [sep] ++ show day {-# INLINABLE datep' #-} @@ -1389,10 +1391,10 @@ commenttagsanddatesp mYear = do -- Left ...not a bracketed date... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]" --- Left ...1:2:...well-formed but invalid date: 2016/1/32... +-- Left ...1:2:...This date is invalid... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]" --- Left ...1:2:...partial date 1/31 found, but the current year is unknown... +-- Left ...1:2:...The partial date 1/31 can not be parsed... -- -- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:13:...expecting month or day... diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e213650a0..b1994cc3d 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -797,7 +797,7 @@ makeHledgerClassyLenses ''ReportSpec -- >>> _rsQuery <$> setEither querystring ["assets"] defreportspec -- Right (Acct (RegexpCI "assets")) -- >>> _rsQuery <$> setEither querystring ["(assets"] defreportspec --- Left "this regular expression could not be compiled: (assets" +-- Left "This regular expression is malformed... -- >>> _rsQuery $ set querystring ["assets"] defreportspec -- Acct (RegexpCI "assets") -- >>> _rsQuery $ set querystring ["(assets"] defreportspec diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index e7c58e7dc..27bb5431d 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -134,7 +134,7 @@ toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultComp -- | Make a nice error message for a regexp error. mkRegexErr :: Text -> Maybe a -> Either RegexError a mkRegexErr s = maybe (Left errmsg) Right - where errmsg = T.unpack $ "this regular expression could not be compiled: " <> s + where errmsg = T.unpack $ "This regular expression is malformed, please correct it:\n" <> s -- Convert a Regexp string to a compiled Regex, throw an error toRegex' :: Text -> Regexp diff --git a/hledger-lib/Text/Megaparsec/Custom.hs b/hledger-lib/Text/Megaparsec/Custom.hs index c0230a951..72cc88b18 100644 --- a/hledger-lib/Text/Megaparsec/Custom.hs +++ b/hledger-lib/Text/Megaparsec/Custom.hs @@ -120,8 +120,10 @@ parseErrorAtRegion -> HledgerParseErrorData parseErrorAtRegion startOffset endOffset msg = if startOffset < endOffset - then ErrorFailAt startOffset endOffset msg - else ErrorFailAt startOffset (startOffset+1) msg + then ErrorFailAt startOffset endOffset msg' + else ErrorFailAt startOffset (startOffset+1) msg' + where + msg' = "\n" ++ msg --- * Re-parsing diff --git a/hledger/test/check-accounts.test b/hledger/test/check-accounts.test index a4f6153cf..cbe2da8d1 100644 --- a/hledger/test/check-accounts.test +++ b/hledger/test/check-accounts.test @@ -10,7 +10,7 @@ $ hledger -f- check accounts 2020-01-01 (a) 1 $ hledger -f- check accounts ->2 /undeclared account "a"/ +>2 /account "a" has not been declared/ >=1 # 3. also fails for forecast accounts @@ -20,12 +20,12 @@ account a a $1 b $ hledger -f- --today 2022-01-01 --forecast check accounts ->2 /undeclared account "b"/ +>2 /account "b" has not been declared/ >=1 # 4. also fails in --strict mode $ hledger -f- --today 2022-01-01 --forecast --strict bal ->2 /undeclared account "b"/ +>2 /account "b" has not been declared/ >=1 # 5. also fails for auto accounts @@ -40,10 +40,10 @@ account a 2022-02-01 $ hledger -f- --auto check accounts ->2 /undeclared account "b"/ +>2 /account "b" has not been declared/ >=1 # 6. also fails in --strict mode $ hledger -f- --auto --strict bal ->2 /undeclared account "b"/ +>2 /account "b" has not been declared/ >=1 diff --git a/hledger/test/check-balancednoautoconversion.test b/hledger/test/check-balancednoautoconversion.test index 780b8f80e..387cbbc91 100644 --- a/hledger/test/check-balancednoautoconversion.test +++ b/hledger/test/check-balancednoautoconversion.test @@ -4,5 +4,5 @@ a -10£ b 16$ $ hledger -f - check balancednoautoconversion ->2 /real postings' sum should be 0 but is: 16\$/ +>2 /real postings' sum should be 0 but is: 16\$, -10£/ >=1 diff --git a/hledger/test/check-commodities.test b/hledger/test/check-commodities.test index 51a22ec4c..d09faa30b 100644 --- a/hledger/test/check-commodities.test +++ b/hledger/test/check-commodities.test @@ -10,7 +10,7 @@ $ hledger -f- check commodities 2020-01-01 (a) $1 $ hledger -f- check commodities ->2 /undeclared commodity "\$"/ +>2 /commodity "\$" has not been declared/ >=1 # 3. But commodityless zero amounts will not fail @@ -27,5 +27,5 @@ $ hledger -f- check commodities (a) $0 $ hledger -f- check commodities ->2 /undeclared commodity "\$"/ +>2 /commodity "\$" has not been declared/ >=1 diff --git a/hledger/test/check-ordereddates.test b/hledger/test/check-ordereddates.test index a180a9053..8e3737498 100644 --- a/hledger/test/check-ordereddates.test +++ b/hledger/test/check-ordereddates.test @@ -12,7 +12,7 @@ $ hledger -f- check ordereddates 2020-01-01 (a) 1 $ hledger -f- check ordereddates ->2 /transaction date is out of order/ +>2 /date .*is out of order/ >=1 # With --date2, it checks secondary dates instead @@ -26,7 +26,7 @@ $ hledger -f- check ordereddates --date2 2020-01-01=2020-01-03 2020-01-02 $ hledger -f- check ordereddates --date2 ->2 /transaction date2 is out of order/ +>2 /date2 .*is out of order/ >=1 # XXX not supported: With a query, only matched transactions' dates are checked. diff --git a/hledger/test/check-payees.test b/hledger/test/check-payees.test index d71ca2e4f..b5fe538f3 100644 --- a/hledger/test/check-payees.test +++ b/hledger/test/check-payees.test @@ -9,7 +9,7 @@ $ hledger -f - check payees < 2020-01-01 foo $ hledger -f - check payees ->2 /undeclared payee "foo"/ +>2 /payee "foo" has not been declared/ >=1 # or: @@ -17,5 +17,5 @@ $ hledger -f - check payees payee foo 2020-01-01 the payee | foo $ hledger -f - check payees ->2 /undeclared payee "the payee"/ +>2 /payee "the payee" has not been declared/ >=1 diff --git a/hledger/test/csv.test b/hledger/test/csv.test index 05f688c44..0039e5e65 100644 --- a/hledger/test/csv.test +++ b/hledger/test/csv.test @@ -1039,7 +1039,7 @@ account1 assets:bank:checking fields date, description, account2, amount $ ./csvtest.sh ->2 /unbalanced transaction/ +>2 /transaction is unbalanced/ >=1 ## . diff --git a/hledger/test/errors/Makefile b/hledger/test/errors/Makefile index 3e6cc6e2c..084620236 100644 --- a/hledger/test/errors/Makefile +++ b/hledger/test/errors/Makefile @@ -1,44 +1,40 @@ -# Check error messages of hledger in $PATH against current error tests. -test: - @printf "Running error message tests with hledger $$(hledger --version | awk '{print $$2}'):\n" - shelltest *.test +HLEDGER ?= hledger -TESTJOURNALS=*.j +# Executable .j, .csv, .timeclock, and .timedot files are error example scripts. +# Some shenanigans here to order them nicely. +ERRORSCRIPTS := \ + $$(find -s . -name '*.j' -perm +rwx -exec basename {} \; | grep -v csv) \ + $$(find -s . -name '*.timeclock' -perm +rwx -exec basename {} \; ) \ + $$(find -s . -name '*.timedot' -perm +rwx -exec basename {} \; ) \ + $$(find -s . -name 'csv*' -perm +rwx -exec basename {} \; ) \ + $$(find -s . -name '*.sh' -perm +rwx -exec basename {} \; ) \ + +list: + @echo "Error example scripts detected:" + @for s in $(ERRORSCRIPTS); do echo $$s; done + +# Check error messages of $HLEDGER against current error tests. +# A few tests (csvstdinrules.sh) may use "hledger" in $PATH instead of $HLEDGER. +test: + @printf "Running error message tests with hledger $$($(HLEDGER) --version | awk '{print $$2}'):\n" + shelltest -w $(HLEDGER) *.test # Update error message tests and readme based on the latest test journals # and error output of hledger in $PATH. update: tests readme tests: - @printf "Updating *.test with the error messages of hledger $$(hledger --version | awk '{print $$2}')\n" + @printf "(Re)generating *.test with the error messages of hledger $$($(HLEDGER) --version | awk '{print $$2}')\n" @read -p "ok ? Press enter: " - for f in $(TESTJOURNALS); do make -s $$(basename $$f .j).test; done - make -s test + @for f in $(ERRORSCRIPTS); do echo "HLEDGER=$(HLEDGER) ./hledger2shelltest $$f"; HLEDGER=$(HLEDGER) ./hledger2shelltest $$f; done -# Generate a shelltest. Run the test script/journal to generate the error message. -# Since the error will contain an absolute file path, we must: -# 1. remove most of the file path -# 2. test with a (multiline) regex rather than literal text -# 3. backslash-quote most forward slashes in error messages -# 4. neutralise any remaining problematic error text (eg in parseable-regexps.test) -%.test: %.j - head -1 $< | sed -E 's%#!/usr/bin/env -S (.*)%$$$$$$ \1 $<%' >$@ - printf ">>>2 /" >>$@ - -./$< 2>&1 | sed -E \ - -e 's%(hledger: Error: ).*/\./(.*)%\1.*\2%' \ - -e 's%/%\\/%g' \ - -e 's%alias \\/\(\\/%alias \\/\\(\\/%' \ - -e 's%compiled: \(%compiled: \\(%' \ - >>$@ - printf "/\n>>>= 1" >>$@ - -readme: $(TESTJOURNALS) - @printf "Updating README.md with the error messages of hledger $$(hledger --version | awk '{print $$2}')\n" +readme: + @printf "Updating README.md with the error messages of hledger $$($(HLEDGER) --version)\n" @read -p "ok ? Press enter: " sed '//q' README.md.tmp - echo "$$(hledger --version | cut -d, -f1) error messages:" >>README.md.tmp - for f in $(TESTJOURNALS); do \ - printf '\n### %s\n```\n%s\n```\n\n' "$$(basename "$$f" .j)" "$$(./"$$f" 2>&1)"; \ + echo "$$($(HLEDGER) --version | cut -d, -f1) error messages:" >>README.md.tmp + for f in $(ERRORSCRIPTS); do \ + printf '\n### %s\n```\n%s\n```\n\n' "$$(echo "$$f" | sed -E 's/\.[^.]+$$//')" "$$(./"$$f" 2>&1)"; \ done >>README.md.tmp mv README.md.tmp README.md diff --git a/hledger/test/errors/README.md b/hledger/test/errors/README.md index 4cd33a3b8..36aae67a0 100644 --- a/hledger/test/errors/README.md +++ b/hledger/test/errors/README.md @@ -22,70 +22,41 @@ Some files contain extra declarations to ease flycheck testing. ## Goals -- [x] phase 1: update flycheck to detect journal errors of current hledger release (and keep a branch updated to detect errors of latest hledger master) -- [x] phase 2: survey/document current journal errors & status -- [x] phase 3: pick a new standard format -- [ ] **phase 4: implement standard format for all** -- [ ] phase 5: implement accurate lines for all -- [ ] phase 6: implement accurate columns for all -- [ ] phase 7: implement useful highlighted excerpts for all -- [ ] phase 8: implement accurate flycheck region for all -- [ ] phase 9: do likewise for timeclock errors -- [ ] phase 10: do likewise for timedot errors +- [x] ~~phase 1: update flycheck to detect journal errors of current hledger release (and keep a branch updated to detect errors of latest hledger master)~~ +- [x] ~~phase 2: survey/document current journal errors & status~~ +- [x] ~~phase 3: pick a new standard format~~ +- [x] ~~phase 4: implement standard format for all~~ +- [x] ~~phase 5: implement accurate lines for all~~ +- [x] ~~phase 6: implement accurate columns for all [where possible; we currently do not save the position of every part of the transaction, so most errors do not report columns]~~ +- [x] ~~phase 7: implement useful highlighted excerpts for all [we show imperfect but useful highlighted regions]~~ +- [x] ~~phase 8: implement accurate flycheck region for all [flycheck-detected regions are imperfect but useful]~~ +- [x] ~~phase 9: do likewise for timeclock errors~~ +- [x] ~~phase 10: do likewise for timedot errors~~ - [ ] phase 11: do likewise for csv errors - [ ] phase 12: do likewise for other command line errors -- [x] phase 13: decide/add error ids/explanations/web pages ? not needed +- [x] ~~phase 13: decide/add error ids/explanations/web pages ? not needed~~ - [ ] phase 14: support Language Server Protocol & Visual Code -## Current status - -Here is the current status -(hledger 1.26.99-gb7e6583a7-20220710, flycheck 87b275b9): - -| | std format | line | column | excerpt | flycheck | flycheck region | -|--------------------------|------------|------|-----------|---------|----------|-----------------| -| accounts | ✓ | ✓ | ✓ | ✓✓ | | | -| assertions | ✓ | ✓ | ✓ | ✓✓ | | | -| balanced | ✓ | ✓ | - | ✓ | | | -| balancednoautoconversion | ✓ | ✓ | - | ✓ | | | -| commodities | ✓ | ✓ | ✓(approx) | ✓✓ | | | -| ordereddates | ✓ | ✓ | ✓ | ✓✓ | | | -| parseable | ✓ | ✓ | ✓ | ✓✓ | | | -| parseable-dates | ✓ | ✓ | ✓ | ✓✓ | | | -| parseable-regexps | ✓ | ✓ | ✓ | ✓✓ | | | -| payees | ✓ | ✓ | ✓ | ✓✓ | | | -| uniqueleafnames | ✓ | ✓ | ✓ | ✓✓ | | | - -Key: -- std format - the error message follows a standard format (location on first line, megaparsec-like excerpt, description). -- line - the optimal line(s) are reported -- column - the optimal column(s) are reported -- excerpt - a useful excerpt is shown, ideally with the error highlighted (✓✓) -- flycheck - the current flycheck release recognises and reports the error, with no "suspicious state" warning -- flycheck region - flycheck highlights a reasonably accurate region containing the error - ## Preferred error format -Here is our preferred error message layout for now: +Here is our current standard error message layout. +It is similar to the parse error messages we get from megaparsec. +(Easier to follow that than change it.): ``` hledger: Error: FILE:LOCATION: EXCERPT -SUMMARY -[DETAILS] +EXPLANATION ``` Notes (see also [#1436][]): -- the "hledger: " prefix could be dropped later with a bit more effort -- includes the word "Error" and the error position on line 1 +- line 1 includes "hledger" (dropping this would require some effort), the word "Error", and the error position - FILE is the file path - LOCATION is `LINE[-ENDLINE][:COLUMN[-ENDCOLUMN]]` -- we may show 0 for LINE or COLUMN when unknown -- EXCERPT is a short visual snippet whenever possible, with the error region highlighted, line numbers, and colour when supported. This section must be easy for flycheck to ignore. -- SUMMARY is a one line description/explanation of the problem. - These are currently dynamic, they can include helpful contextual info. - ShellCheck uses static summaries. -- DETAILS is optional additional details/advice when needed. +- EXCERPT is a short visual snippet whenever possible, with the error region highlighted, line numbers, and colour when supported. + This section must be easy for flycheck to ignore. (All lines begin with a space or a digit.) +- EXPLANATION briefly explains the problem, and suggests remedies if possible. + It can be dynamic, showing context-sensitive info. (ShellCheck's summaries are static.) - this layout is based on megaparsec's. For comparison, rustc puts summary on line 1 and location on line 2: ``` Error[ID]: SUMMARY @@ -95,78 +66,164 @@ Notes (see also [#1436][]): ``` - try https://github.com/mesabloo/diagnose / https://hackage.haskell.org/package/errata / https://hackage.haskell.org/package/chapelure later -## Current journal errors +## Limitations + +Here are some current limitations of hledger's error messages: + +- We report only one error at a time. You have to fix (or bypass) the current error to see any others. + +- We currently don't save perfect position information when parsing, + so we sometimes report only line number(s), without column number(s). + +- For the same reason, the excerpts we show in error messages are not the original data. + Instead we show a synthetic rendering that is similar enough to be explanatory. + +## Current status + +Here is the current status as of +hledger 1.26.99-gaeae7232c-20220714, flycheck-hledger g1310cb518. +Click error names to see an example. Key: + +- std format - the error message follows a standard format (location on first line, megaparsec-like excerpt, explanation) +- line - correct line numbers are reported +- column - useful column numbers are reported +- excerpt - a useful excerpt is shown, ideally with the error highlighted (✓✓) +- flycheck - the current flycheck release (or a PR branch) recognises the error and highlights a useful region + +| error/check name | std format | line | column | excerpt | flycheck | +|-------------------------------------------------------|------------|------|--------|---------|----------| +| [accounts](#accounts) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [assertions](#assertions) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [balanced](#balanced) | ✓ | ✓ | - | ✓ | ✓ | +| [balancednoautoconversion](#balancednoautoconversion) | ✓ | ✓ | - | ✓ | ✓ | +| [commodities](#commodities) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [ordereddates](#ordereddates) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [parseable](#parseable) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [parseable-dates](#parseable-dates) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [parseable-regexps](#parseable-regexps) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [payees](#payees) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [uniqueleafnames](#uniqueleafnames) | ✓ | ✓ | ✓ | ✓✓ | ✓ | +| [tcclockouttime](#tcclockouttime) | ✓ | ✓ | ✓ | ✓✓ | | +| [tcorderedactions](#tcorderedactions) | ✓ | ✓ | ✓ | ✓✓ | | +| [csvamountonenonzero](#csvamountonenonzero) | | | | | | +| [csvamountparse](#csvamountparse) | | | | | | +| [csvbalanceparse](#csvbalanceparse) | | | | | | +| [csvbalancetypeparse](#csvbalancetypeparse) | | | | | | +| [csvdateformat](#csvdateformat) | | | | | | +| [csvdateparse](#csvdateparse) | | | | | | +| [csvdaterule](#csvdaterule) | | | | | | +| [csvdecimalmarkparse](#csvdecimalmarkparse) | | | | | | +| [csvifblocknonempty](#csvifblocknonempty) | | ✓ | ✓ | ✓ | | +| [csviftablefieldnames](#csviftablefieldnames) | | ✓ | ✓ | ✓✓ | | +| [csviftablenonempty](#csviftablenonempty) | | ✓ | ✓ | ✓ | | +| [csviftablevaluecount](#csviftablevaluecount) | | ✓ | ✓ | ✓ | | +| [csvnoinclude](#csvnoinclude) | | ✓ | ✓ | ✓ | | +| [csvskipvalue](#csvskipvalue) | | | | | | +| [csvstatusparse](#csvstatusparse) | | | | ✓ | | +| [csvstdinrules](#csvstdinrules) | | | | | | +| [csvtwofields](#csvtwofields) | | | | | | +| [csvstdinrules](#csvstdinrules) | | | | | | + + +## Current error messages + +(To update: `make readme`) - -hledger 1.25.99-g9bff671b5-20220424 error messages: +hledger 1.26.99-gaeae7232c-20220714 error messages: ### accounts ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:4:6-6: +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:4: | 2022-01-01 4 | (a) 1 | ^ -undeclared account "a" + +Strict account checking is enabled, and +account "a" has not been declared. +Consider adding an account directive. Examples: + +account a +account a ; type:A ; (L,E,R,X,C,V) ``` ### assertions ``` -hledger: Error: balance assertion: /Users/simon/src/hledger/hledger/test/errors/./assertions.j:4:8 -transaction: -2022-01-01 - a 0 = 1 +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./assertions.j:4:8: + | 2022-01-01 +4 | a 0 = 1 + | ^^^ -assertion details: -date: 2022-01-01 -account: a -commodity: -calculated: 0 -asserted: 1 -difference: 1 +This balance assertion failed. +In account: a +and commodity: +this balance was asserted: 1 +but the actual balance is: 0 +a difference of: 1 + +Consider viewing this account's register to troubleshoot. Eg: + +hledger reg -I 'a$' cur:'' ``` ### balanced ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balanced.j:3-4 -could not balance this transaction: -real postings' sum should be 0 but is: 1 -2022-01-01 - a 1 +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balanced.j:3-4: +3 | 2022-01-01 + | a 1 + +This transaction is unbalanced. +The real postings' sum should be 0 but is: 1 +Consider adjusting this entry's amounts, or adding missing postings. ``` ### balancednoautoconversion ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balancednoautoconversion.j:6-8 -could not balance this transaction: -real postings' sum should be 0 but is: 1 A --1 B -2022-01-01 - a 1 A - b -1 B +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balancednoautoconversion.j:6-8: +6 | 2022-01-01 + | a 1 A + | b -1 B + +This multi-commodity transaction is unbalanced. +Automatic commodity conversion is not enabled. +The real postings' sum should be 0 but is: 1 A, -1 B +Consider adjusting this entry's amounts, adding missing postings, +or recording conversion price(s) with @, @@ or equity postings. ``` ### commodities ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:6:21-23: +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:6: | 2022-01-01 6 | (a) A 1 | ^^^ -undeclared commodity "A" + +Strict commodity checking is enabled, and +commodity "A" has not been declared. +Consider adding a commodity directive. Examples: + +commodity A1000.00 +commodity 1.000,00 A ``` ### ordereddates ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10:1-10: +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10: +7 | 2022-01-02 p + | (a) 1 + 10 | 2022-01-01 p | ^^^^^^^^^^ | (a) 1 -transaction date is out of order with previous transaction date 2022-01-02 + +Ordered dates checking is enabled, and this transaction's +date (2022-01-01) is out of order with the previous transaction. +Consider moving this entry into date order, or adjusting its date. ``` @@ -176,7 +233,8 @@ hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./parseable-dates.j | 3 | 2022/1/32 | ^^^^^^^^^ -well-formed but invalid date: 2022/1/32 + +This date is invalid, please correct it: 2022/1/32 ``` @@ -186,7 +244,9 @@ hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./parseable-regexps | 3 | alias /(/ = a | ^ -this regular expression could not be compiled: ( + +This regular expression is malformed, please correct it: +( ``` @@ -203,21 +263,236 @@ expecting date separator or digit ### payees ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./payees.j:6:12-12: +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./payees.j:6: 6 | 2022-01-01 p | ^ | (a) A 1 -undeclared payee "p" + +Strict payee checking is enabled, and +payee "p" has not been declared. +Consider adding a payee directive. Examples: + +payee p ``` ### uniqueleafnames ``` -hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:9:8-8: +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:12: | 2022-01-01 p 9 | (a:c) 1 - | ^ -account leaf name "c" is not unique -it is used in account names: "a:c", "b:c" + ... + | 2022-01-01 p +12 | (b:c) 1 + | ^ + +Checking for unique account leaf names is enabled, and +account leaf name "c" is not unique. +It appears in these account names, which are used in 2 places: +a:c +b:c + +Consider changing these account names so their last parts are different. +``` + + +### tcclockouttime +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./tcclockouttime.timeclock:5:1: + | i 2022-01-01 00:01:00 +5 | o 2022-01-01 00:00:00 + | ^^^^^^^^^^^^^^^^^^^ + +This clockout time (2022-01-01 00:00:00) is earlier than the previous clockin. +Please adjust it to be later than 2022-01-01 00:01:00. +``` + + +### tcorderedactions +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./tcorderedactions.timeclock:8:1: +8 | i 2022-01-01 00:01:00 + | ^ + +Expected timeclock o entry but got i. +Only one session may be clocked in at a time. +Please alternate i and o, beginning with i. +``` + + +### csvamountonenonzero +``` +hledger: Error: multiple non-zero amounts assigned, +please ensure just one. (https://hledger.org/csv.html#amount) + record values: "2022-01-03","1","2" + for posting: 1 + assignment: amount-in %2 => value: 1 + assignment: amount-out %3 => value: 2 +``` + + +### csvamountparse +``` +hledger: Error: error: could not parse "badamount" as an amount +record values: "2022-01-03","badamount" +the amount rule is: %2 +the date rule is: %1 + +the parse error is: 1:10: + | +1 | badamount + | ^ +unexpected end of input +expecting '+', '-', or number + +you may need to change your amount*, balance*, or currency* rules, or add or change your skip rule +``` + + +### csvbalanceparse +``` +hledger: Error: error: could not parse "badbalance" as balance1 amount +record values: "2022-01-03","badbalance" +the balance rule is: %2 +the date rule is: %1 + +the parse error is: 1:11: + | +1 | badbalance + | ^ +unexpected end of input +expecting '+', '-', or number +``` + + +### csvbalancetypeparse +``` +hledger: Error: balance-type "badtype" is invalid. Use =, ==, =* or ==*. +record values: "2022-01-01","1" +the balance rule is: %2 +the date rule is: %1 +``` + + +### csvdateformat +``` +hledger: Error: error: could not parse "a" as a date using date format "YYYY/M/D", "YYYY-M-D" or "YYYY.M.D" +record values: "a","b" +the date rule is: %1 +the date-format is: unspecified +you may need to change your date rule, add a date-format rule, or change your skip rule +for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y +``` + + +### csvdateparse +``` +hledger: Error: error: could not parse "baddate" as a date using date format "%Y-%m-%d" +record values: "baddate","b" +the date rule is: %1 +the date-format is: %Y-%m-%d +you may need to change your date rule, change your date-format rule, or change your skip rule +for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y +``` + + +### csvdaterule +``` +hledger: Error: offset=0: +Please specify (at top level) the date field. Eg: date %1 +``` + + +### csvdecimalmarkparse +``` +hledger: Error: decimal-mark's argument should be "." or "," (not "badmark") +``` + + +### csvifblocknonempty +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./csvifblocknonempty.csv.rules:2:1: + | +2 | if foo + | ^ +start of conditional block found, but no assignment rules afterward +(assignment rules in a conditional block should be indented) +``` + + +### csviftablefieldnames +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./csviftablefieldnames.csv.rules:2:9: + | +2 | if,date,nosuchfield,description + | ^^^^^^^^^^^^ +unexpected "nosuchfield," +expecting "account1", "account10", "account11", "account12", "account13", "account14", "account15", "account16", "account17", "account18", "account19", "account2", "account20", "account21", "account22", "account23", "account24", "account25", "account26", "account27", "account28", "account29", "account3", "account30", "account31", "account32", "account33", "account34", "account35", "account36", "account37", "account38", "account39", "account4", "account40", "account41", "account42", "account43", "account44", "account45", "account46", "account47", "account48", "account49", "account5", "account50", "account51", "account52", "account53", "account54", "account55", "account56", "account57", "account58", "account59", "account6", "account60", "account61", "account62", "account63", "account64", "account65", "account66", "account67", "account68", "account69", "account7", "account70", "account71", "account72", "account73", "account74", "account75", "account76", "account77", "account78", "account79", "account8", "account80", "account81", "account82", "account83", "account84", "account85", "account86", "account87", "account88", "account89", "account9", "account90", "account91", "account92", "account93", "account94", "account95", "account96", "account97", "account98", "account99", "amount", "amount-in", "amount-out", "amount1", "amount1-in", "amount1-out", "amount10", "amount10-in", "amount10-out", "amount11", "amount11-in", "amount11-out", "amount12", "amount12-in", "amount12-out", "amount13", "amount13-in", "amount13-out", "amount14", "amount14-in", "amount14-out", "amount15", "amount15-in", "amount15-out", "amount16", "amount16-in", "amount16-out", "amount17", "amount17-in", "amount17-out", "amount18", "amount18-in", "amount18-out", "amount19", "amount19-in", "amount19-out", "amount2", "amount2-in", "amount2-out", "amount20", "amount20-in", "amount20-out", "amount21", "amount21-in", "amount21-out", "amount22", "amount22-in", "amount22-out", "amount23", "amount23-in", "amount23-out", "amount24", "amount24-in", "amount24-out", "amount25", "amount25-in", "amount25-out", "amount26", "amount26-in", "amount26-out", "amount27", "amount27-in", "amount27-out", "amount28", "amount28-in", "amount28-out", "amount29", "amount29-in", "amount29-out", "amount3", "amount3-in", "amount3-out", "amount30", "amount30-in", "amount30-out", "amount31", "amount31-in", "amount31-out", "amount32", "amount32-in", "amount32-out", "amount33", "amount33-in", "amount33-out", "amount34", "amount34-in", "amount34-out", "amount35", "amount35-in", "amount35-out", "amount36", "amount36-in", "amount36-out", "amount37", "amount37-in", "amount37-out", "amount38", "amount38-in", "amount38-out", "amount39", "amount39-in", "amount39-out", "amount4", "amount4-in", "amount4-out", "amount40", "amount40-in", "amount40-out", "amount41", "amount41-in", "amount41-out", "amount42", "amount42-in", "amount42-out", "amount43", "amount43-in", "amount43-out", "amount44", "amount44-in", "amount44-out", "amount45", "amount45-in", "amount45-out", "amount46", "amount46-in", "amount46-out", "amount47", "amount47-in", "amount47-out", "amount48", "amount48-in", "amount48-out", "amount49", "amount49-in", "amount49-out", "amount5", "amount5-in", "amount5-out", "amount50", "amount50-in", "amount50-out", "amount51", "amount51-in", "amount51-out", "amount52", "amount52-in", "amount52-out", "amount53", "amount53-in", "amount53-out", "amount54", "amount54-in", "amount54-out", "amount55", "amount55-in", "amount55-out", "amount56", "amount56-in", "amount56-out", "amount57", "amount57-in", "amount57-out", "amount58", "amount58-in", "amount58-out", "amount59", "amount59-in", "amount59-out", "amount6", "amount6-in", "amount6-out", "amount60", "amount60-in", "amount60-out", "amount61", "amount61-in", "amount61-out", "amount62", "amount62-in", "amount62-out", "amount63", "amount63-in", "amount63-out", "amount64", "amount64-in", "amount64-out", "amount65", "amount65-in", "amount65-out", "amount66", "amount66-in", "amount66-out", "amount67", "amount67-in", "amount67-out", "amount68", "amount68-in", "amount68-out", "amount69", "amount69-in", "amount69-out", "amount7", "amount7-in", "amount7-out", "amount70", "amount70-in", "amount70-out", "amount71", "amount71-in", "amount71-out", "amount72", "amount72-in", "amount72-out", "amount73", "amount73-in", "amount73-out", "amount74", "amount74-in", "amount74-out", "amount75", "amount75-in", "amount75-out", "amount76", "amount76-in", "amount76-out", "amount77", "amount77-in", "amount77-out", "amount78", "amount78-in", "amount78-out", "amount79", "amount79-in", "amount79-out", "amount8", "amount8-in", "amount8-out", "amount80", "amount80-in", "amount80-out", "amount81", "amount81-in", "amount81-out", "amount82", "amount82-in", "amount82-out", "amount83", "amount83-in", "amount83-out", "amount84", "amount84-in", "amount84-out", "amount85", "amount85-in", "amount85-out", "amount86", "amount86-in", "amount86-out", "amount87", "amount87-in", "amount87-out", "amount88", "amount88-in", "amount88-out", "amount89", "amount89-in", "amount89-out", "amount9", "amount9-in", "amount9-out", "amount90", "amount90-in", "amount90-out", "amount91", "amount91-in", "amount91-out", "amount92", "amount92-in", "amount92-out", "amount93", "amount93-in", "amount93-out", "amount94", "amount94-in", "amount94-out", "amount95", "amount95-in", "amount95-out", "amount96", "amount96-in", "amount96-out", "amount97", "amount97-in", "amount97-out", "amount98", "amount98-in", "amount98-out", "amount99", "amount99-in", "amount99-out", "balance", "balance1", "balance10", "balance11", "balance12", "balance13", "balance14", "balance15", "balance16", "balance17", "balance18", "balance19", "balance2", "balance20", "balance21", "balance22", "balance23", "balance24", "balance25", "balance26", "balance27", "balance28", "balance29", "balance3", "balance30", "balance31", "balance32", "balance33", "balance34", "balance35", "balance36", "balance37", "balance38", "balance39", "balance4", "balance40", "balance41", "balance42", "balance43", "balance44", "balance45", "balance46", "balance47", "balance48", "balance49", "balance5", "balance50", "balance51", "balance52", "balance53", "balance54", "balance55", "balance56", "balance57", "balance58", "balance59", "balance6", "balance60", "balance61", "balance62", "balance63", "balance64", "balance65", "balance66", "balance67", "balance68", "balance69", "balance7", "balance70", "balance71", "balance72", "balance73", "balance74", "balance75", "balance76", "balance77", "balance78", "balance79", "balance8", "balance80", "balance81", "balance82", "balance83", "balance84", "balance85", "balance86", "balance87", "balance88", "balance89", "balance9", "balance90", "balance91", "balance92", "balance93", "balance94", "balance95", "balance96", "balance97", "balance98", "balance99", "code", "comment", "comment1", "comment10", "comment11", "comment12", "comment13", "comment14", "comment15", "comment16", "comment17", "comment18", "comment19", "comment2", "comment20", "comment21", "comment22", "comment23", "comment24", "comment25", "comment26", "comment27", "comment28", "comment29", "comment3", "comment30", "comment31", "comment32", "comment33", "comment34", "comment35", "comment36", "comment37", "comment38", "comment39", "comment4", "comment40", "comment41", "comment42", "comment43", "comment44", "comment45", "comment46", "comment47", "comment48", "comment49", "comment5", "comment50", "comment51", "comment52", "comment53", "comment54", "comment55", "comment56", "comment57", "comment58", "comment59", "comment6", "comment60", "comment61", "comment62", "comment63", "comment64", "comment65", "comment66", "comment67", "comment68", "comment69", "comment7", "comment70", "comment71", "comment72", "comment73", "comment74", "comment75", "comment76", "comment77", "comment78", "comment79", "comment8", "comment80", "comment81", "comment82", "comment83", "comment84", "comment85", "comment86", "comment87", "comment88", "comment89", "comment9", "comment90", "comment91", "comment92", "comment93", "comment94", "comment95", "comment96", "comment97", "comment98", "comment99", "currency", "currency1", "currency10", "currency11", "currency12", "currency13", "currency14", "currency15", "currency16", "currency17", "currency18", "currency19", "currency2", "currency20", "currency21", "currency22", "currency23", "currency24", "currency25", "currency26", "currency27", "currency28", "currency29", "currency3", "currency30", "currency31", "currency32", "currency33", "currency34", "currency35", "currency36", "currency37", "currency38", "currency39", "currency4", "currency40", "currency41", "currency42", "currency43", "currency44", "currency45", "currency46", "currency47", "currency48", "currency49", "currency5", "currency50", "currency51", "currency52", "currency53", "currency54", "currency55", "currency56", "currency57", "currency58", "currency59", "currency6", "currency60", "currency61", "currency62", "currency63", "currency64", "currency65", "currency66", "currency67", "currency68", "currency69", "currency7", "currency70", "currency71", "currency72", "currency73", "currency74", "currency75", "currency76", "currency77", "currency78", "currency79", "currency8", "currency80", "currency81", "currency82", "currency83", "currency84", "currency85", "currency86", "currency87", "currency88", "currency89", "currency9", "currency90", "currency91", "currency92", "currency93", "currency94", "currency95", "currency96", "currency97", "currency98", "currency99", "date", "date2", "description", "end", "skip", or "status" +``` + + +### csviftablenonempty +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./csviftablenonempty.csv.rules:2:1: + | +2 | if,date,description,comment + | ^ +start of conditional table found, but no assignment rules afterward +``` + + +### csviftablevaluecount +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./csviftablevaluecount.csv.rules:4:1: + | +4 | one,val1 + | ^ +line of conditional table should have 2 values, but this one has only 1 +``` + + +### csvnoinclude +``` +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./csvnoinclude.j:4:23: + | +4 | include csvinclude.csv + | ^ +No existing files match pattern: csvinclude.csv +``` + + +### csvskipvalue +``` +hledger: Error: could not parse skip value: "badval" +``` + + +### csvstatusparse +``` +hledger: Error: error: could not parse "badstatus" as a cleared status (should be *, ! or empty) +the parse error is: 1:1: + | +1 | badstatus + | ^ +unexpected 'b' +expecting '!', '*', or end of input +``` + + +### csvstdinrules +``` +hledger: Error: please use --rules-file when reading CSV from stdin +``` + + +### csvtwofields +``` +hledger: Error: CSV record ["b"] has less than two fields +``` + + +### csvstdinrules +``` +hledger: Error: please use --rules-file when reading CSV from stdin ``` diff --git a/hledger/test/errors/accounts.test b/hledger/test/errors/accounts.test index 79c152046..b31160c65 100644 --- a/hledger/test/errors/accounts.test +++ b/hledger/test/errors/accounts.test @@ -1,9 +1,15 @@ $$$ hledger check accounts -f accounts.j ->>>2 /hledger: Error: .*accounts.j:4:6-6: - | 2022-01-01 -4 | (a) 1 - | ^ -undeclared account "a" +>>>2 /hledger: Error: .*accounts.j:4: + \| 2022-01-01 +4 \| \(a\) 1 + \| \^ + +Strict account checking is enabled, and +account "a" has not been declared. +Consider adding an account directive. Examples: + +account a +account a ; type:A ; \(L,E,R,X,C,V\) / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/assertions.test b/hledger/test/errors/assertions.test index 4afea2b94..986869c04 100644 --- a/hledger/test/errors/assertions.test +++ b/hledger/test/errors/assertions.test @@ -1,14 +1,15 @@ -$ hledger check -f assertions.j ->2 /hledger: Error: balance assertion: .*assertions.j:4:8: - | 2022-01-01 -4 | a 0 = 1 - | ^^^^^^^^^^ +$$$ hledger check -f assertions.j +>>>2 /hledger: Error: .*assertions.j:4:8: + \| 2022-01-01 +4 \| a 0 = 1 + \| \^\^\^ -account: a -commodity: -asserted: 0 -actual: 1 -difference: 1 +This balance assertion failed. +In account: a +and commodity: +this balance was asserted: 1 +but the actual balance is: 0 +a difference of: 1 -/ ->=1 \ No newline at end of file +Consider viewing this account'/ +>>>= 1 diff --git a/hledger/test/errors/balanced.test b/hledger/test/errors/balanced.test index 73f0c87b2..468b6868e 100644 --- a/hledger/test/errors/balanced.test +++ b/hledger/test/errors/balanced.test @@ -1,9 +1,10 @@ -$ hledger check -f balanced.j ->2 /hledger: Error: unbalanced transaction: .*balanced.j:3-4: -3 | 2022-01-01 - | a 1 - -real postings' sum should be 0 but is: 1 +$$$ hledger check -f balanced.j +>>>2 /hledger: Error: .*balanced.j:3-4: +3 \| 2022-01-01 + \| a 1 +This transaction is unbalanced. +The real postings' sum should be 0 but is: 1 +Consider adjusting this entry's amounts, or adding missing postings. / ->= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/balancednoautoconversion.test b/hledger/test/errors/balancednoautoconversion.test index 94de0f47e..96bd50591 100644 --- a/hledger/test/errors/balancednoautoconversion.test +++ b/hledger/test/errors/balancednoautoconversion.test @@ -1,11 +1,11 @@ -$ hledger check balancednoautoconversion -f balancednoautoconversion.j ->2 /hledger: Error: unbalanced transaction: .*balancednoautoconversion.j:6-8: -6 | 2022-01-01 - | a 1 A - | b -1 B +$$$ hledger check balancednoautoconversion -f balancednoautoconversion.j +>>>2 /hledger: Error: .*balancednoautoconversion.j:6-8: +6 \| 2022-01-01 + \| a 1 A + \| b -1 B -real postings' sum should be 0 but is: 1 A --1 B - -/ ->= 1 \ No newline at end of file +This multi-commodity transaction is unbalanced. +Automatic commodity conversion is not enabled. +The real postings' sum should be 0 but is: 1 A, -1 B +Consider adjusting this entry's/ +>>>= 1 diff --git a/hledger/test/errors/commodities.test b/hledger/test/errors/commodities.test index 6ecd7c466..aa038c444 100644 --- a/hledger/test/errors/commodities.test +++ b/hledger/test/errors/commodities.test @@ -1,9 +1,15 @@ $$$ hledger check commodities -f commodities.j ->>>2 /hledger: Error: .*commodities.j:6:21-23: - | 2022-01-01 -6 | (a) A 1 - | ^^^ -undeclared commodity "A" +>>>2 /hledger: Error: .*commodities.j:6: + \| 2022-01-01 +6 \| \(a\) A 1 + \| \^\^\^ + +Strict commodity checking is enabled, and +commodity "A" has not been declared. +Consider adding a commodity directive. Examples: + +commodity A1000.00 +commodity 1.000,00 A / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/csvamountonenonzero.csv b/hledger/test/errors/csvamountonenonzero.csv new file mode 100755 index 000000000..c278cb3b5 --- /dev/null +++ b/hledger/test/errors/csvamountonenonzero.csv @@ -0,0 +1,5 @@ +#!/usr/bin/env -S hledger print -f +# Non-zero for both amount-in and amount-out. +2022-01-01,1, +2022-01-02,1,0 +2022-01-03,1,2 diff --git a/hledger/test/errors/csvamountonenonzero.csv.rules b/hledger/test/errors/csvamountonenonzero.csv.rules new file mode 100644 index 000000000..6ce6980db --- /dev/null +++ b/hledger/test/errors/csvamountonenonzero.csv.rules @@ -0,0 +1,4 @@ +skip 2 +date %1 +amount-in %2 +amount-out %3 diff --git a/hledger/test/errors/csvamountonenonzero.test b/hledger/test/errors/csvamountonenonzero.test new file mode 100644 index 000000000..a396001bc --- /dev/null +++ b/hledger/test/errors/csvamountonenonzero.test @@ -0,0 +1,10 @@ +$$$ hledger print -f csvamountonenonzero.csv +>>>2 /hledger: Error: multiple non-zero amounts assigned, +please ensure just one. \(https:\/\/hledger.org\/csv.html#amount\) + record values: "2022-01-03","1","2" + for posting: 1 + assignment: amount-in %2 => value: 1 + assignment: amount-out %3 => value: 2 + +/ +>>>= 1 diff --git a/hledger/test/errors/csvamountparse.csv b/hledger/test/errors/csvamountparse.csv new file mode 100755 index 000000000..3792544ee --- /dev/null +++ b/hledger/test/errors/csvamountparse.csv @@ -0,0 +1,5 @@ +#!/usr/bin/env -S hledger print -f +# Unparseable amount. +2022-01-01,1 +2022-01-02,$1 +2022-01-03,badamount diff --git a/hledger/test/errors/csvamountparse.csv.rules b/hledger/test/errors/csvamountparse.csv.rules new file mode 100644 index 000000000..1227ffe7b --- /dev/null +++ b/hledger/test/errors/csvamountparse.csv.rules @@ -0,0 +1,3 @@ +skip 2 +date %1 +amount %2 diff --git a/hledger/test/errors/csvamountparse.test b/hledger/test/errors/csvamountparse.test new file mode 100644 index 000000000..46d80fa01 --- /dev/null +++ b/hledger/test/errors/csvamountparse.test @@ -0,0 +1,15 @@ +$$$ hledger print -f csvamountparse.csv +>>>2 /hledger: Error: error: could not parse "badamount" as an amount +record values: "2022-01-03","badamount" +the amount rule is: %2 +the date rule is: %1 + +the parse error is: 1:10: + \| +1 \| badamount + \| \^ +unexpected end of input +expecting '\+', '-', or number + +you may need to change your/ +>>>= 1 diff --git a/hledger/test/errors/csvbalanceparse.csv b/hledger/test/errors/csvbalanceparse.csv new file mode 100755 index 000000000..0ed4bd55b --- /dev/null +++ b/hledger/test/errors/csvbalanceparse.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger print -f +# Unparseable balance amount. +2022-01-03,badbalance diff --git a/hledger/test/errors/csvbalanceparse.csv.rules b/hledger/test/errors/csvbalanceparse.csv.rules new file mode 100644 index 000000000..888f06412 --- /dev/null +++ b/hledger/test/errors/csvbalanceparse.csv.rules @@ -0,0 +1,3 @@ +skip 2 +date %1 +balance %2 diff --git a/hledger/test/errors/csvbalanceparse.test b/hledger/test/errors/csvbalanceparse.test new file mode 100644 index 000000000..4a99f05b2 --- /dev/null +++ b/hledger/test/errors/csvbalanceparse.test @@ -0,0 +1,16 @@ +$$$ hledger print -f csvbalanceparse.csv +>>>2 /hledger: Error: error: could not parse "badbalance" as balance1 amount +record values: "2022-01-03","badbalance" +the balance rule is: %2 +the date rule is: %1 + +the parse error is: 1:11: + \| +1 \| badbalance + \| \^ +unexpected end of input +expecting '\+', '-', or number + + +/ +>>>= 1 diff --git a/hledger/test/errors/csvbalancetypeparse.csv b/hledger/test/errors/csvbalancetypeparse.csv new file mode 100755 index 000000000..da5db83d6 --- /dev/null +++ b/hledger/test/errors/csvbalancetypeparse.csv @@ -0,0 +1,4 @@ +#!/usr/bin/env -S hledger check -f +# See rules. +2022-01-01,1 + diff --git a/hledger/test/errors/csvbalancetypeparse.csv.rules b/hledger/test/errors/csvbalancetypeparse.csv.rules new file mode 100644 index 000000000..052d2fccd --- /dev/null +++ b/hledger/test/errors/csvbalancetypeparse.csv.rules @@ -0,0 +1,4 @@ +skip 2 +date %1 +balance %2 +balance-type badtype diff --git a/hledger/test/errors/csvbalancetypeparse.test b/hledger/test/errors/csvbalancetypeparse.test new file mode 100644 index 000000000..5de9aaa6d --- /dev/null +++ b/hledger/test/errors/csvbalancetypeparse.test @@ -0,0 +1,9 @@ +$$$ hledger check -f csvbalancetypeparse.csv +>>>2 /hledger: Error: balance-type "badtype" is invalid. Use =, ==, =\* or ==\*. +record values: "2022-01-01","1" +the balance rule is: %2 +the date rule is: %1 + + +/ +>>>= 1 diff --git a/hledger/test/errors/csvdateformat.csv b/hledger/test/errors/csvdateformat.csv new file mode 100755 index 000000000..73e45ec4c --- /dev/null +++ b/hledger/test/errors/csvdateformat.csv @@ -0,0 +1,4 @@ +#!/usr/bin/env -S hledger print -f +# See rules (missing/bad date-format rule). +# Note check doesn't show this error; print was needed. +a,b diff --git a/hledger/test/errors/csvdateformat.csv.rules b/hledger/test/errors/csvdateformat.csv.rules new file mode 100644 index 000000000..6a1b6e9eb --- /dev/null +++ b/hledger/test/errors/csvdateformat.csv.rules @@ -0,0 +1,2 @@ +skip 3 +date %1 diff --git a/hledger/test/errors/csvdateformat.test b/hledger/test/errors/csvdateformat.test new file mode 100644 index 000000000..7455d5cc4 --- /dev/null +++ b/hledger/test/errors/csvdateformat.test @@ -0,0 +1,8 @@ +$$$ hledger print -f csvdateformat.csv +>>>2 /hledger: Error: error: could not parse "a" as a date using date format "YYYY\/M\/D", "YYYY-M-D" or "YYYY.M.D" +record values: "a","b" +the date rule is: %1 +the date-format is: unspecified +you may need to change your date rule, add a date-format rule, or change your skip rule +for m\/d\/y or d\/m\/y d/ +>>>= 1 diff --git a/hledger/test/errors/csvdateparse.csv b/hledger/test/errors/csvdateparse.csv new file mode 100755 index 000000000..f13036592 --- /dev/null +++ b/hledger/test/errors/csvdateparse.csv @@ -0,0 +1,4 @@ +#!/usr/bin/env -S hledger check -f +# Date value not parseable by date-format rule. +2022-01-01,b +baddate,b diff --git a/hledger/test/errors/csvdateparse.csv.rules b/hledger/test/errors/csvdateparse.csv.rules new file mode 100644 index 000000000..717d10430 --- /dev/null +++ b/hledger/test/errors/csvdateparse.csv.rules @@ -0,0 +1,3 @@ +skip 2 +date %1 +date-format %Y-%m-%d diff --git a/hledger/test/errors/csvdateparse.test b/hledger/test/errors/csvdateparse.test new file mode 100644 index 000000000..ee3f93d0b --- /dev/null +++ b/hledger/test/errors/csvdateparse.test @@ -0,0 +1,8 @@ +$$$ hledger check -f csvdateparse.csv +>>>2 /hledger: Error: error: could not parse "baddate" as a date using date format "%Y-%m-%d" +record values: "baddate","b" +the date rule is: %1 +the date-format is: %Y-%m-%d +you may need to change your date rule, change your date-format rule, or change your skip rule +for m\/d\/y or d\/m\/y dates, use dat/ +>>>= 1 diff --git a/hledger/test/errors/csvdaterule.csv b/hledger/test/errors/csvdaterule.csv new file mode 100755 index 000000000..b586b5fb4 --- /dev/null +++ b/hledger/test/errors/csvdaterule.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger check -f +# Rules have no date rule. +a,b diff --git a/hledger/test/errors/csvdaterule.csv.rules b/hledger/test/errors/csvdaterule.csv.rules new file mode 100644 index 000000000..92d8bd67e --- /dev/null +++ b/hledger/test/errors/csvdaterule.csv.rules @@ -0,0 +1 @@ +skip 2 diff --git a/hledger/test/errors/csvdaterule.test b/hledger/test/errors/csvdaterule.test new file mode 100644 index 000000000..2419a021d --- /dev/null +++ b/hledger/test/errors/csvdaterule.test @@ -0,0 +1,6 @@ +$$$ hledger check -f csvdaterule.csv +>>>2 /hledger: Error: offset=0: +Please specify \(at top level\) the date field. Eg: date %1 + +/ +>>>= 1 diff --git a/hledger/test/errors/csvdecimalmarkparse.csv b/hledger/test/errors/csvdecimalmarkparse.csv new file mode 100755 index 000000000..f4da5151a --- /dev/null +++ b/hledger/test/errors/csvdecimalmarkparse.csv @@ -0,0 +1,4 @@ +#!/usr/bin/env -S hledger check -f +# See rules. +2022-01-01,1.0 + diff --git a/hledger/test/errors/csvdecimalmarkparse.csv.rules b/hledger/test/errors/csvdecimalmarkparse.csv.rules new file mode 100644 index 000000000..062e72e64 --- /dev/null +++ b/hledger/test/errors/csvdecimalmarkparse.csv.rules @@ -0,0 +1,4 @@ +skip 2 +date %1 +amount %2 +decimal-mark badmark diff --git a/hledger/test/errors/csvdecimalmarkparse.test b/hledger/test/errors/csvdecimalmarkparse.test new file mode 100644 index 000000000..0ed46520b --- /dev/null +++ b/hledger/test/errors/csvdecimalmarkparse.test @@ -0,0 +1,4 @@ +$$$ hledger check -f csvdecimalmarkparse.csv +>>>2 /hledger: Error: decimal-mark's argument should be "." or "," \(not "badmark"\) +/ +>>>= 1 diff --git a/hledger/test/errors/csvifblocknonempty.csv b/hledger/test/errors/csvifblocknonempty.csv new file mode 100755 index 000000000..84f97c3bd --- /dev/null +++ b/hledger/test/errors/csvifblocknonempty.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger check -f +# Rules have an empty conditional block. +a,b diff --git a/hledger/test/errors/csvifblocknonempty.csv.rules b/hledger/test/errors/csvifblocknonempty.csv.rules new file mode 100644 index 000000000..be75fc02e --- /dev/null +++ b/hledger/test/errors/csvifblocknonempty.csv.rules @@ -0,0 +1,2 @@ +# no (indented) rules following if +if foo diff --git a/hledger/test/errors/csvifblocknonempty.test b/hledger/test/errors/csvifblocknonempty.test new file mode 100644 index 000000000..9e6d16080 --- /dev/null +++ b/hledger/test/errors/csvifblocknonempty.test @@ -0,0 +1,10 @@ +$$$ hledger check -f csvifblocknonempty.csv +>>>2 /hledger: Error: .*csvifblocknonempty.csv.rules:2:1: + \| +2 \| if foo + \| \^ +start of conditional block found, but no assignment rules afterward +\(assignment rules in a conditional block should be indented\) + +/ +>>>= 1 diff --git a/hledger/test/errors/csviftablefieldnames.csv b/hledger/test/errors/csviftablefieldnames.csv new file mode 100755 index 000000000..eb28858cc --- /dev/null +++ b/hledger/test/errors/csviftablefieldnames.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger check -f +# See rules. + diff --git a/hledger/test/errors/csviftablefieldnames.csv.rules b/hledger/test/errors/csviftablefieldnames.csv.rules new file mode 100644 index 000000000..bfa963739 --- /dev/null +++ b/hledger/test/errors/csviftablefieldnames.csv.rules @@ -0,0 +1,2 @@ +# if table not using valid CSV field names. +if,date,nosuchfield,description diff --git a/hledger/test/errors/csviftablefieldnames.test b/hledger/test/errors/csviftablefieldnames.test new file mode 100644 index 000000000..bac26db57 --- /dev/null +++ b/hledger/test/errors/csviftablefieldnames.test @@ -0,0 +1,8 @@ +$$$ hledger check -f csviftablefieldnames.csv +>>>2 /hledger: Error: .*csviftablefieldnames.csv.rules:2:9: + \| +2 \| if,date,nosuchfield,description + \| \^\^\^\^\^\^\^\^\^\^\^\^ +unexpected "nosuchfield," +expecting "account1", "account10", "account11", "account12", "account13", "account14", "account15", "account16", "account17", "account18", "/ +>>>= 1 diff --git a/hledger/test/errors/csviftablenonempty.csv b/hledger/test/errors/csviftablenonempty.csv new file mode 100755 index 000000000..eb28858cc --- /dev/null +++ b/hledger/test/errors/csviftablenonempty.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger check -f +# See rules. + diff --git a/hledger/test/errors/csviftablenonempty.csv.rules b/hledger/test/errors/csviftablenonempty.csv.rules new file mode 100644 index 000000000..cd76861c9 --- /dev/null +++ b/hledger/test/errors/csviftablenonempty.csv.rules @@ -0,0 +1,2 @@ +# no (indented) rules following if table +if,date,description,comment diff --git a/hledger/test/errors/csviftablenonempty.test b/hledger/test/errors/csviftablenonempty.test new file mode 100644 index 000000000..611b283c5 --- /dev/null +++ b/hledger/test/errors/csviftablenonempty.test @@ -0,0 +1,9 @@ +$$$ hledger check -f csviftablenonempty.csv +>>>2 /hledger: Error: .*csviftablenonempty.csv.rules:2:1: + \| +2 \| if,date,description,comment + \| \^ +start of conditional table found, but no assignment rules afterward + +/ +>>>= 1 diff --git a/hledger/test/errors/csviftablevaluecount.csv b/hledger/test/errors/csviftablevaluecount.csv new file mode 100755 index 000000000..eb28858cc --- /dev/null +++ b/hledger/test/errors/csviftablevaluecount.csv @@ -0,0 +1,3 @@ +#!/usr/bin/env -S hledger check -f +# See rules. + diff --git a/hledger/test/errors/csviftablevaluecount.csv.rules b/hledger/test/errors/csviftablevaluecount.csv.rules new file mode 100644 index 000000000..5111a25a7 --- /dev/null +++ b/hledger/test/errors/csviftablevaluecount.csv.rules @@ -0,0 +1,4 @@ +# if table where some records have wrong number of values. +if,date,description +two,val1,val2 +one,val1 diff --git a/hledger/test/errors/csviftablevaluecount.test b/hledger/test/errors/csviftablevaluecount.test new file mode 100644 index 000000000..ec890c172 --- /dev/null +++ b/hledger/test/errors/csviftablevaluecount.test @@ -0,0 +1,9 @@ +$$$ hledger check -f csviftablevaluecount.csv +>>>2 /hledger: Error: .*csviftablevaluecount.csv.rules:4:1: + \| +4 \| one,val1 + \| \^ +line of conditional table should have 2 values, but this one has only 1 + +/ +>>>= 1 diff --git a/hledger/test/errors/csvnoinclude.csv b/hledger/test/errors/csvnoinclude.csv new file mode 100644 index 000000000..e69de29bb diff --git a/hledger/test/errors/csvnoinclude.j b/hledger/test/errors/csvnoinclude.j new file mode 100755 index 000000000..6d54945ad --- /dev/null +++ b/hledger/test/errors/csvnoinclude.j @@ -0,0 +1,6 @@ +#!/usr/bin/env -S hledger check -f +# Trying to include a CSV file. + +include csvinclude.csv + + diff --git a/hledger/test/errors/csvnoinclude.test b/hledger/test/errors/csvnoinclude.test new file mode 100644 index 000000000..6f302749e --- /dev/null +++ b/hledger/test/errors/csvnoinclude.test @@ -0,0 +1,9 @@ +$$$ hledger check -f csvnoinclude.j +>>>2 /hledger: Error: .*csvnoinclude.j:4:23: + \| +4 \| include csvinclude.csv + \| \^ +No existing files match pattern: csvinclude.csv + +/ +>>>= 1 diff --git a/hledger/test/errors/csvskipvalue.csv b/hledger/test/errors/csvskipvalue.csv new file mode 100755 index 000000000..6a9b93c64 --- /dev/null +++ b/hledger/test/errors/csvskipvalue.csv @@ -0,0 +1,2 @@ +#!/usr/bin/env -S hledger check -f +# See rules. diff --git a/hledger/test/errors/csvskipvalue.csv.rules b/hledger/test/errors/csvskipvalue.csv.rules new file mode 100644 index 000000000..76577c1a7 --- /dev/null +++ b/hledger/test/errors/csvskipvalue.csv.rules @@ -0,0 +1,2 @@ +date %1 +skip badval diff --git a/hledger/test/errors/csvskipvalue.test b/hledger/test/errors/csvskipvalue.test new file mode 100644 index 000000000..2e4be3641 --- /dev/null +++ b/hledger/test/errors/csvskipvalue.test @@ -0,0 +1,4 @@ +$$$ hledger check -f csvskipvalue.csv +>>>2 /hledger: Error: could not parse skip value: "badval" +/ +>>>= 1 diff --git a/hledger/test/errors/csvstatusparse.csv b/hledger/test/errors/csvstatusparse.csv new file mode 100755 index 000000000..240ee00aa --- /dev/null +++ b/hledger/test/errors/csvstatusparse.csv @@ -0,0 +1,6 @@ +#!/usr/bin/env -S hledger print -f +# Status value not parseable. +2022-01-01,* +2022-01-02,! +2022-01-03, +2022-01-04,badstatus diff --git a/hledger/test/errors/csvstatusparse.csv.rules b/hledger/test/errors/csvstatusparse.csv.rules new file mode 100644 index 000000000..95e216085 --- /dev/null +++ b/hledger/test/errors/csvstatusparse.csv.rules @@ -0,0 +1,3 @@ +skip 2 +date %1 +status %2 diff --git a/hledger/test/errors/csvstatusparse.test b/hledger/test/errors/csvstatusparse.test new file mode 100644 index 000000000..17022c5aa --- /dev/null +++ b/hledger/test/errors/csvstatusparse.test @@ -0,0 +1,12 @@ +$$$ hledger print -f csvstatusparse.csv +>>>2 /hledger: Error: error: could not parse "badstatus" as a cleared status \(should be \*, ! or empty\) +the parse error is: 1:1: + \| +1 \| badstatus + \| \^ +unexpected 'b' +expecting '!', '\*', or end of input + + +/ +>>>= 1 diff --git a/hledger/test/errors/csvstdinrules.sh b/hledger/test/errors/csvstdinrules.sh new file mode 100755 index 000000000..398586f5d --- /dev/null +++ b/hledger/test/errors/csvstdinrules.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env -S sh +# Second space above is significant, prevents shelltest's "-w hledger" substitution. +# Try to read CSV from stdin without specifying a rules file. +echo | hledger -fcsv:- check diff --git a/hledger/test/errors/csvstdinrules.test b/hledger/test/errors/csvstdinrules.test new file mode 100644 index 000000000..bb598c777 --- /dev/null +++ b/hledger/test/errors/csvstdinrules.test @@ -0,0 +1,4 @@ +$$$ sh csvstdinrules.sh +>>>2 /hledger: Error: please use --rules-file when reading CSV from stdin +/ +>>>= 1 diff --git a/hledger/test/errors/csvtwofields.csv b/hledger/test/errors/csvtwofields.csv new file mode 100755 index 000000000..f629b6d26 --- /dev/null +++ b/hledger/test/errors/csvtwofields.csv @@ -0,0 +1,5 @@ +#!/usr/bin/env -S hledger check -f +# Record(s) have less than two fields. +a,a +b +c,c diff --git a/hledger/test/errors/csvtwofields.csv.rules b/hledger/test/errors/csvtwofields.csv.rules new file mode 100644 index 000000000..8c81abb3b --- /dev/null +++ b/hledger/test/errors/csvtwofields.csv.rules @@ -0,0 +1,2 @@ +skip 2 +date %1 diff --git a/hledger/test/errors/csvtwofields.test b/hledger/test/errors/csvtwofields.test new file mode 100644 index 000000000..9ab83b90b --- /dev/null +++ b/hledger/test/errors/csvtwofields.test @@ -0,0 +1,4 @@ +$$$ hledger check -f csvtwofields.csv +>>>2 /hledger: Error: CSV record \["b"\] has less than two fields +/ +>>>= 1 diff --git a/hledger/test/errors/hledger2shelltest b/hledger/test/errors/hledger2shelltest new file mode 100755 index 000000000..f23d4d976 --- /dev/null +++ b/hledger/test/errors/hledger2shelltest @@ -0,0 +1,46 @@ +#!/usr/bin/env bash +# hledger2shelltest SCRIPT +# +# Speaking generally: given an executable hashbang script (beginning with #!/usr/bin/env), +# this generates a similarly-named shelltestrunner test that will repeatably +# run the same command as the script and test its (stderr) output. +# (Ideally, this would be built in to shelltestrunner.) +# More precisely, this generates a test expecting no stdout, the given stderr, +# and an error exit code, for scripts reproducing various hledger errors. +# +# The script is run once to capture its output, which is then adjusted +# for use in a shelltest regex matcher: +# - common regex metacharacters are escaped +# - file paths are simplified +# - any remaining problematic text is sanitised +# - the regex is trimmed to <= 300 chars, to avoid a shelltestrunner limitation. + +SCRIPT="$1" +TEST=$(echo "$SCRIPT" | sed -E 's/\.[^.]+$//').test + +{ +head -1 "$SCRIPT" | sed -E "s%#!/usr/bin/env -S (.*)%\$\$\$ \1 $SCRIPT%" +printf ">>>2 /" +./"$SCRIPT" 2>&1 | sed -E \ + -e 's/\^/\\^/g' \ + -e 's/\$/\\$/g' \ + -e 's/\+/\\+/g' \ + -e 's/\*/\\*/g' \ + -e 's/\[/\\[/g' \ + -e 's/\]/\\]/g' \ + -e 's/\(/\\(/g' \ + -e 's/\)/\\)/g' \ + -e 's/\|/\\|/g' \ + -e 's%(hledger: Error: ).*/\./(.*)%\1.*\2%' \ + -e 's%/%\\/%g' \ + | head -c 300 +printf "/\n>>>= 1\n" +} >"$TEST" + + +# -e 's%alias \\/\(\\/%alias \\/\\(\\/%' \ +# -e 's%compiled: \(%compiled: \\(%' \ + +# gnused() { # GNU sed, called gsed on mac +# if hash gsed 2>/dev/null; then gsed "$@"; else sed "$@"; fi +# } diff --git a/hledger/test/errors/ordereddates.test b/hledger/test/errors/ordereddates.test index 7cc02a644..281a522e5 100644 --- a/hledger/test/errors/ordereddates.test +++ b/hledger/test/errors/ordereddates.test @@ -1,8 +1,13 @@ $$$ hledger check ordereddates -f ordereddates.j ->>>2 /hledger: Error: .*ordereddates.j:10:1-10: -10 | 2022-01-01 p - | ^^^^^^^^^^ - | (a) 1 -transaction date is out of order with previous transaction date 2022-01-02 -/ ->>>= 1 \ No newline at end of file +>>>2 /hledger: Error: .*ordereddates.j:10: +7 \| 2022-01-02 p + \| \(a\) 1 + +10 \| 2022-01-01 p + \| \^\^\^\^\^\^\^\^\^\^ + \| \(a\) 1 + +Ordered dates checking is enabled, and this transaction's +date \(2022-01-01\) is out of order with the previous transaction. +Consider/ +>>>= 1 diff --git a/hledger/test/errors/parseable-dates.test b/hledger/test/errors/parseable-dates.test index b08e652f9..3bda3832a 100644 --- a/hledger/test/errors/parseable-dates.test +++ b/hledger/test/errors/parseable-dates.test @@ -1,9 +1,10 @@ $$$ hledger check -f parseable-dates.j >>>2 /hledger: Error: .*parseable-dates.j:3:1: - | -3 | 2022\/1\/32 - | ^^^^^^^^^ -well-formed but invalid date: 2022\/1\/32 + \| +3 \| 2022\/1\/32 + \| \^\^\^\^\^\^\^\^\^ + +This date is invalid, please correct it: 2022\/1\/32 / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/parseable-regexps.test b/hledger/test/errors/parseable-regexps.test index 958e5a8b3..cb7aa167f 100644 --- a/hledger/test/errors/parseable-regexps.test +++ b/hledger/test/errors/parseable-regexps.test @@ -1,9 +1,11 @@ $$$ hledger check -f parseable-regexps.j >>>2 /hledger: Error: .*parseable-regexps.j:3:8: - | -3 | alias \/\(\/ = a - | ^ -this regular expression could not be compiled: \( + \| +3 \| alias \/\(\/ = a + \| \^ + +This regular expression is malformed, please correct it: +\( / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/parseable.test b/hledger/test/errors/parseable.test index e99de9e52..648860fd0 100644 --- a/hledger/test/errors/parseable.test +++ b/hledger/test/errors/parseable.test @@ -1,10 +1,10 @@ $$$ hledger check -f parseable.j >>>2 /hledger: Error: .*parseable.j:3:2: - | -3 | 1 - | ^ + \| +3 \| 1 + \| \^ unexpected newline expecting date separator or digit / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/payees.test b/hledger/test/errors/payees.test index c46874bdc..5dc44aeed 100644 --- a/hledger/test/errors/payees.test +++ b/hledger/test/errors/payees.test @@ -1,9 +1,14 @@ $$$ hledger check payees -f payees.j ->>>2 /hledger: Error: .*payees.j:6:12-12: -6 | 2022-01-01 p - | ^ - | (a) A 1 -undeclared payee "p" +>>>2 /hledger: Error: .*payees.j:6: +6 \| 2022-01-01 p + \| \^ + \| \(a\) A 1 + +Strict payee checking is enabled, and +payee "p" has not been declared. +Consider adding a payee directive. Examples: + +payee p / ->>>= 1 \ No newline at end of file +>>>= 1 diff --git a/hledger/test/errors/tcclockouttime.test b/hledger/test/errors/tcclockouttime.test new file mode 100644 index 000000000..26ec46d00 --- /dev/null +++ b/hledger/test/errors/tcclockouttime.test @@ -0,0 +1,10 @@ +$$$ hledger check -f tcclockouttime.timeclock +>>>2 /hledger: Error: .*tcclockouttime.timeclock:5:1: + \| i 2022-01-01 00:01:00 +5 \| o 2022-01-01 00:00:00 + \| \^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^ + +This clockout time \(2022-01-01 00:00:00\) is earlier than the previous clockin. +Please adjust it to be later than 2022-01-01 00:01:00. +/ +>>>= 1 diff --git a/hledger/test/errors/tcclockouttime.timeclock b/hledger/test/errors/tcclockouttime.timeclock new file mode 100755 index 000000000..0aafd29de --- /dev/null +++ b/hledger/test/errors/tcclockouttime.timeclock @@ -0,0 +1,5 @@ +#!/usr/bin/env -S hledger check -f +# Clockout time before previous clockin. + +i 2022/01/01 00:01:00 +o 2022/01/01 00:00:00 diff --git a/hledger/test/errors/tcorderedactions.test b/hledger/test/errors/tcorderedactions.test new file mode 100644 index 000000000..f9d9cf4bb --- /dev/null +++ b/hledger/test/errors/tcorderedactions.test @@ -0,0 +1,10 @@ +$$$ hledger check -f tcorderedactions.timeclock +>>>2 /hledger: Error: .*tcorderedactions.timeclock:8:1: +8 \| i 2022-01-01 00:01:00 + \| \^ + +Expected timeclock o entry but got i. +Only one session may be clocked in at a time. +Please alternate i and o, beginning with i. +/ +>>>= 1 diff --git a/hledger/test/errors/tcorderedactions.timeclock b/hledger/test/errors/tcorderedactions.timeclock new file mode 100755 index 000000000..7998291ea --- /dev/null +++ b/hledger/test/errors/tcorderedactions.timeclock @@ -0,0 +1,8 @@ +#!/usr/bin/env -S hledger check -f +# Clockin/clockout out of order: +# two clockins without intervening clockout, +# two clockouts without intervening clockin, +# or an initial clockout with no preceding clockin. + +i 2022/01/01 00:00:00 +i 2022/01/01 00:01:00 diff --git a/hledger/test/errors/uniqueleafnames.test b/hledger/test/errors/uniqueleafnames.test index 6934a3e32..d6d2161e2 100644 --- a/hledger/test/errors/uniqueleafnames.test +++ b/hledger/test/errors/uniqueleafnames.test @@ -1,9 +1,13 @@ $$$ hledger check uniqueleafnames -f uniqueleafnames.j ->>>2 /hledger: Error: .*uniqueleafnames.j:9:8-8: - | 2022-01-01 p -9 | (a:c) 1 - | ^ -account leaf name "c" is not unique -it is used in account names: "a:c", "b:c" -/ ->>>= 1 \ No newline at end of file +>>>2 /hledger: Error: .*uniqueleafnames.j:12: + \| 2022-01-01 p +9 \| \(a:c\) 1 + ... + \| 2022-01-01 p +12 \| \(b:c\) 1 + \| \^ + +Checking for unique account leaf names is enabled, and +account leaf name "c" is not unique. +It appears in these account names, which a/ +>>>= 1 diff --git a/hledger/test/journal/auto-postings.test b/hledger/test/journal/auto-postings.test index 2ff2860b0..18810e401 100644 --- a/hledger/test/journal/auto-postings.test +++ b/hledger/test/journal/auto-postings.test @@ -160,7 +160,7 @@ $ hledger -f- print --auto -x # 9. $ hledger print -f- --auto ->2 /can't use balance assignment with auto postings/ +>2 /Balance assignments and auto postings may not be combined/ >=1 diff --git a/hledger/test/journal/balance-assertions.test b/hledger/test/journal/balance-assertions.test index 1db0dfbd9..1ccd34f9d 100755 --- a/hledger/test/journal/balance-assertions.test +++ b/hledger/test/journal/balance-assertions.test @@ -56,7 +56,7 @@ $ hledger -f - stats b $-1 = $-3 $ hledger -f - stats ->2 /balance assertion.*11:12/ +>2 /Error: -:11:12/ >=1 # 4. should also work without commodity symbols @@ -225,7 +225,7 @@ $ hledger -f - stats b =$-1 ; date:2012/1/1 $ hledger -f - stats ->2 /can't use balance assignment with custom posting date/ +>2 /Balance assignments and custom posting dates may not be combined/ >=1 # 13. Posting Date @@ -314,7 +314,7 @@ $ hledger -f - stats a 0 == $1 $ hledger -f - stats ->2 /balance assertion.*10:15/ +>2 /Error: -:10:15:/ >=1 # 18. Mix different commodities and total assignments @@ -385,7 +385,7 @@ commodity $1000.00 (a) $1.00 = $1.01 $ hledger -f- print ->2 /difference: 0\.004/ +>2 /a difference of.*0\.004/ >=1 # 23. This fails @@ -399,7 +399,7 @@ commodity $1000.00 (a) $1.00 = $1.0061 $ hledger -f- print ->2 /difference: 0\.0001/ +>2 /a difference of.*0\.0001/ >=1 # 24. Inclusive assertions include balances from subaccounts. diff --git a/hledger/test/journal/dates.test b/hledger/test/journal/dates.test index 1a1a19fad..c0de552c9 100644 --- a/hledger/test/journal/dates.test +++ b/hledger/test/journal/dates.test @@ -5,7 +5,7 @@ hledger -f- print 2010/31/12 x a 1 b ->>>2 /invalid date/ +>>>2 /date is invalid/ >>>= 1 # 2. too-large day hledger -f- print @@ -13,7 +13,7 @@ hledger -f- print 2010/12/32 x a 1 b ->>>2 /invalid date/ +>>>2 /date is invalid/ >>>= 1 # 3. 29th feb on leap year should be ok hledger -f- print @@ -33,7 +33,7 @@ hledger -f- print 2001/2/29 x a 1 b ->>>2 /invalid date/ +>>>2 /date is invalid/ >>>= 1 # 5. dates must be followed by whitespace or newline hledger -f- print diff --git a/hledger/test/journal/parse-errors.test b/hledger/test/journal/parse-errors.test index 47b58101e..c0e4aa1ab 100644 --- a/hledger/test/journal/parse-errors.test +++ b/hledger/test/journal/parse-errors.test @@ -56,7 +56,7 @@ $ hledger -f - print -x c $ hledger -f journal:- print ->2 /can't have more than one real posting with no amount/ +>2 /can't be more than one real posting with no amount/ >=1 # 6. Two (or more) virtual postings with implicit amount cannot be balanced. @@ -123,13 +123,15 @@ $ hledger -f- print b 1B $ hledger -f- print >2 -hledger: Error: unbalanced transaction: -:1-3: +hledger: Error: -:1-3: 1 | 2020-01-01 | a 1A | b 1B -real postings all have the same sign - +This multi-commodity transaction is unbalanced. +The real postings all have the same sign. Consider negating some of them. +Consider adjusting this entry's amounts, adding missing postings, +or recording conversion price(s) with @, @@ or equity postings. >=1 # 12. Typical "hledger equity --close" transaction does not trigger sign error. diff --git a/hledger/test/timeclock.test b/hledger/test/timeclock.test index a66557074..2ac76c933 100644 --- a/hledger/test/timeclock.test +++ b/hledger/test/timeclock.test @@ -22,7 +22,7 @@ $ hledger -f timeclock:- print >2 >= 0 -# Command-line account aliases are applied. +# 2. Command-line account aliases are applied. $ hledger -ftimeclock:- print --alias '/account/=FOO' 2009-01-01 * 08:00-09:00 () 1.00h @@ -35,37 +35,29 @@ $ hledger -ftimeclock:- print --alias '/account/=FOO' >= 0 -# For a missing clock-out, now is implied +# 3. For a missing clock-out, now is implied < i 2020/1/1 08:00 $ hledger -f timeclock:- balance > /./ >= 0 -# For a log not starting with clock-out, print error +# 4. For a log not starting with clock-out, print error < o 2020/1/1 08:00 $ hledger -f timeclock:- balance ->2 /line 1: expected timeclock code i/ +>2 /Expected timeclock i entry/ >= !0 -# For a different log starting not with clock-out, print error -< -o 2020/1/1 08:00 -o 2020/1/1 09:00 -$ hledger -f timeclock:- balance ->2 /line 1: expected timeclock code i/ ->= !0 - -# For two consecutive clock-in, print error +# 5. For two consecutive clock-ins, print error < i 2020/1/1 08:00 i 2020/1/1 09:00 $ hledger -f timeclock:- balance ->2 /line 2: expected timeclock code o/ +>2 /Expected timeclock o entry/ >= !0 -# Timeclock amounts are always rounded to two decimal places, +# 6. Timeclock amounts are always rounded to two decimal places, # even when displayed by print (#1527). < i 2020-01-30 08:38:35 a