2015-04-26 14:05:26 +00:00
|
|
|
diff --git i/ShellCheck.cabal w/ShellCheck.cabal
|
|
|
|
index 6e46dfe..8223f3a 100644
|
|
|
|
--- i/ShellCheck.cabal
|
|
|
|
+++ w/ShellCheck.cabal
|
|
|
|
@@ -43,8 +43,7 @@ library
|
2014-11-06 10:50:20 +00:00
|
|
|
json,
|
|
|
|
mtl,
|
|
|
|
parsec,
|
2015-04-26 14:05:26 +00:00
|
|
|
- regex-tdfa,
|
2015-01-28 15:10:31 +00:00
|
|
|
- QuickCheck >= 2.7.4
|
2015-04-26 14:05:26 +00:00
|
|
|
+ regex-tdfa
|
2014-11-06 10:50:20 +00:00
|
|
|
exposed-modules:
|
|
|
|
ShellCheck.Analytics
|
|
|
|
ShellCheck.AST
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -66,8 +65,7 @@ executable shellcheck
|
2014-11-06 10:50:20 +00:00
|
|
|
mtl,
|
|
|
|
parsec,
|
2015-04-26 14:05:26 +00:00
|
|
|
regex-tdfa,
|
2015-01-28 15:10:31 +00:00
|
|
|
- transformers,
|
|
|
|
- QuickCheck >= 2.7.4
|
|
|
|
+ transformers
|
2014-11-06 10:50:20 +00:00
|
|
|
main-is: shellcheck.hs
|
|
|
|
|
|
|
|
test-suite test-shellcheck
|
2015-04-26 14:05:26 +00:00
|
|
|
diff --git i/ShellCheck/Analytics.hs w/ShellCheck/Analytics.hs
|
|
|
|
index fe2fcf4..80bc7a0 100644
|
|
|
|
--- i/ShellCheck/Analytics.hs
|
|
|
|
+++ w/ShellCheck/Analytics.hs
|
|
|
|
@@ -16,7 +16,7 @@
|
2014-09-22 03:09:13 +00:00
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
-}
|
2015-04-26 14:05:26 +00:00
|
|
|
{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
|
2015-01-28 15:10:31 +00:00
|
|
|
-module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable, runTests) where
|
|
|
|
+module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable) where
|
2014-09-22 03:09:13 +00:00
|
|
|
|
|
|
|
import Control.Arrow (first)
|
|
|
|
import Control.Monad
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -32,11 +32,9 @@ import Debug.Trace
|
2014-11-07 05:00:53 +00:00
|
|
|
import ShellCheck.AST
|
2015-01-28 15:10:31 +00:00
|
|
|
import ShellCheck.Options
|
2014-11-07 05:00:53 +00:00
|
|
|
import ShellCheck.Data
|
|
|
|
-import ShellCheck.Parser hiding (runTests)
|
|
|
|
+import ShellCheck.Parser
|
2015-04-26 14:05:26 +00:00
|
|
|
import ShellCheck.Regex
|
2014-11-06 10:50:20 +00:00
|
|
|
import qualified Data.Map as Map
|
2015-04-26 14:05:26 +00:00
|
|
|
-import Test.QuickCheck.All (forAllProperties)
|
|
|
|
-import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
|
2014-11-06 10:50:20 +00:00
|
|
|
|
2015-01-28 15:10:31 +00:00
|
|
|
data Parameters = Parameters {
|
|
|
|
variableFlow :: [StackData],
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -3310,7 +3308,3 @@ checkMaskedReturns _ t@(T_SimpleCommand id _ (cmd:rest)) = potentially $ do
|
|
|
|
T_DollarExpansion {} -> True
|
|
|
|
_ -> False
|
|
|
|
checkMaskedReturns _ _ = return ()
|
2014-09-22 03:09:13 +00:00
|
|
|
-
|
|
|
|
-
|
2015-04-26 14:05:26 +00:00
|
|
|
-return []
|
|
|
|
-runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
|
|
|
|
diff --git i/ShellCheck/Parser.hs w/ShellCheck/Parser.hs
|
|
|
|
index fd2cbea..0ece932 100644
|
|
|
|
--- i/ShellCheck/Parser.hs
|
|
|
|
+++ w/ShellCheck/Parser.hs
|
|
|
|
@@ -16,7 +16,7 @@
|
2014-09-22 03:09:13 +00:00
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
-}
|
2015-04-26 14:05:26 +00:00
|
|
|
{-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell, FlexibleContexts #-}
|
2015-01-28 15:10:31 +00:00
|
|
|
-module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, runTests, readScript) where
|
|
|
|
+module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, readScript) where
|
2014-09-22 03:09:13 +00:00
|
|
|
|
|
|
|
import ShellCheck.AST
|
|
|
|
import ShellCheck.Data
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -34,7 +34,6 @@ import Prelude hiding (readList)
|
2014-11-06 10:50:20 +00:00
|
|
|
import System.IO
|
|
|
|
import Text.Parsec.Error
|
|
|
|
import GHC.Exts (sortWith)
|
|
|
|
-import Test.QuickCheck.All (quickCheckAll)
|
|
|
|
|
|
|
|
backslash = char '\\'
|
|
|
|
linefeed = optional carriageReturn >> char '\n'
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -2163,7 +2162,3 @@ parseShell options filename contents =
|
2014-09-22 03:09:13 +00:00
|
|
|
|
|
|
|
lt x = trace (show x) x
|
|
|
|
ltt t = trace (show t)
|
|
|
|
-
|
|
|
|
-return []
|
|
|
|
-runTests = $quickCheckAll
|
|
|
|
-
|
2015-04-26 14:05:26 +00:00
|
|
|
diff --git i/ShellCheck/Simple.hs w/ShellCheck/Simple.hs
|
|
|
|
index 71cde43..70f769c 100644
|
|
|
|
--- i/ShellCheck/Simple.hs
|
|
|
|
+++ w/ShellCheck/Simple.hs
|
|
|
|
@@ -16,14 +16,13 @@
|
2014-09-22 03:09:13 +00:00
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
-}
|
2015-04-26 14:05:26 +00:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2014-09-22 03:09:13 +00:00
|
|
|
-module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where
|
|
|
|
+module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage) where
|
|
|
|
|
2015-01-28 15:10:31 +00:00
|
|
|
import Data.List
|
|
|
|
import Data.Maybe
|
2014-11-07 05:00:53 +00:00
|
|
|
-import ShellCheck.Analytics hiding (runTests)
|
|
|
|
+import ShellCheck.Analytics
|
2015-01-28 15:10:31 +00:00
|
|
|
import ShellCheck.Options
|
|
|
|
-import ShellCheck.Parser hiding (runTests)
|
2014-09-22 03:09:13 +00:00
|
|
|
-import Test.QuickCheck.All (quickCheckAll)
|
2015-01-28 15:10:31 +00:00
|
|
|
+import ShellCheck.Parser
|
|
|
|
import Text.Parsec.Pos
|
|
|
|
|
|
|
|
shellCheck :: AnalysisOptions -> String -> [ShellCheckComment]
|
2015-04-26 14:05:26 +00:00
|
|
|
@@ -74,7 +73,3 @@ prop_optionDisablesIssue1 =
|
2014-09-22 03:09:13 +00:00
|
|
|
|
2015-04-26 14:05:26 +00:00
|
|
|
prop_optionDisablesIssue2 =
|
|
|
|
null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2148, 1037] }) "echo \"$10\""
|
2014-09-22 03:09:13 +00:00
|
|
|
-
|
|
|
|
-return []
|
|
|
|
-runTests = $quickCheckAll
|
|
|
|
-
|