Plug space leaks when processing multiple files

This commit is contained in:
Vidar Holen 2022-07-27 14:25:19 -07:00
parent a30ac402eb
commit 3ce310e939
4 changed files with 7 additions and 4 deletions

View File

@ -225,7 +225,7 @@ runFormatter sys format options files = do
f :: Status -> FilePath -> IO Status f :: Status -> FilePath -> IO Status
f status file = do f status file = do
newStatus <- process file `catch` handler file newStatus <- process file `catch` handler file
return $ status `mappend` newStatus return $! status `mappend` newStatus
handler :: FilePath -> IOException -> IO Status handler :: FilePath -> IOException -> IO Status
handler file e = reportFailure file (show e) handler file e = reportFailure file (show e)
reportFailure file str = do reportFailure file str = do

View File

@ -23,6 +23,7 @@ module ShellCheck.Formatter.JSON (format) where
import ShellCheck.Interface import ShellCheck.Interface
import ShellCheck.Formatter.Format import ShellCheck.Formatter.Format
import Control.DeepSeq
import Data.Aeson import Data.Aeson
import Data.IORef import Data.IORef
import Data.Monoid import Data.Monoid
@ -103,7 +104,7 @@ collectResult ref cr sys = mapM_ f groups
comments = crComments cr comments = crComments cr
groups = groupWith sourceFile comments groups = groupWith sourceFile comments
f :: [PositionedComment] -> IO () f :: [PositionedComment] -> IO ()
f group = modifyIORef ref (\x -> comments ++ x) f group = deepseq comments $ modifyIORef ref (\x -> comments ++ x)
finish ref = do finish ref = do
list <- readIORef ref list <- readIORef ref

View File

@ -23,6 +23,7 @@ module ShellCheck.Formatter.JSON1 (format) where
import ShellCheck.Interface import ShellCheck.Interface
import ShellCheck.Formatter.Format import ShellCheck.Formatter.Format
import Control.DeepSeq
import Data.Aeson import Data.Aeson
import Data.IORef import Data.IORef
import Data.Monoid import Data.Monoid
@ -120,7 +121,7 @@ collectResult ref cr sys = mapM_ f groups
result <- siReadFile sys (Just True) filename result <- siReadFile sys (Just True) filename
let contents = either (const "") id result let contents = either (const "") id result
let comments' = makeNonVirtual comments contents let comments' = makeNonVirtual comments contents
modifyIORef ref (\x -> comments' ++ x) deepseq comments' $ modifyIORef ref (\x -> comments' ++ x)
finish ref = do finish ref = do
list <- readIORef ref list <- readIORef ref

View File

@ -23,6 +23,7 @@ import ShellCheck.Fixer
import ShellCheck.Interface import ShellCheck.Interface
import ShellCheck.Formatter.Format import ShellCheck.Formatter.Format
import Control.DeepSeq
import Control.Monad import Control.Monad
import Data.Array import Data.Array
import Data.Foldable import Data.Foldable
@ -88,7 +89,7 @@ rankError err = (ranking, cSeverity $ pcComment err, cCode $ pcComment err)
appendComments errRef comments max = do appendComments errRef comments max = do
previous <- readIORef errRef previous <- readIORef errRef
let current = map (\x -> (rankError x, cCode $ pcComment x, cMessage $ pcComment x)) comments let current = map (\x -> (rankError x, cCode $ pcComment x, cMessage $ pcComment x)) comments
writeIORef errRef . take max . nubBy equal . sort $ previous ++ current writeIORef errRef $! force . take max . nubBy equal . sort $ previous ++ current
where where
fst3 (x,_,_) = x fst3 (x,_,_) = x
equal x y = fst3 x == fst3 y equal x y = fst3 x == fst3 y