30 Commits

Author SHA1 Message Date
Vidar Holen
39423ddf81 Stable version 0.3.4
This release is dedicated to Kerbal Space Program,
which has delayed the project by at least a month.
2014-07-08 18:43:33 -07:00
Vidar Holen
875c2d2aad Removed Makefile from cabal file 2014-07-08 18:18:32 -07:00
Vidar Holen
64cc7c691a Warn about precedence in find -name -o -name -exec. 2014-06-22 14:16:24 -07:00
Vidar Holen
b9784cbcc0 Parse let arguments as arithmetic expressions. 2014-06-22 13:23:44 -07:00
Vidar Holen
1a3f6aadaf Support indices in array declarations 2014-06-22 10:35:45 -07:00
Vidar Holen
35756c2cd6 Delete outdated Makefile. 2014-06-22 09:16:54 -07:00
Vidar Holen
0fd351404f Allow escape sequences in here documents. 2014-06-16 14:18:29 -07:00
Vidar Holen
4caa7e7900 Removed accidentally submotted debug code 2014-06-10 00:49:43 -07:00
Vidar Holen
c11c0196d5 Fixed broken parsing of <( in arithmetics 2014-06-10 00:42:07 -07:00
Vidar Holen
b035331d4a Fixed failing test 2014-06-10 00:33:54 -07:00
Vidar Holen
d13253973b Updated readme 2014-06-07 23:25:01 -07:00
koalaman
d9c622ae33 Merge pull request #172 from jbnicolai/master
Adds homebrew installation steps to README.
2014-06-07 23:07:38 -07:00
Vidar Holen
aac7d76047 Don't warn when using find -print0 | xargs --null 2014-06-07 22:41:37 -07:00
Vidar Holen
fc421adb45 Reworked arithmetics to allow composite terms 2014-06-07 22:09:34 -07:00
Joshua Appelman
e0d3c6923a Removes trailing whitespace. 2014-06-08 01:42:32 +02:00
Joshua Appelman
9772ba9de4 Adds homebrew installation steps to README. 2014-06-08 01:42:20 +02:00
Vidar Holen
3a944de606 Warn when concatening strings and arrays. 2014-06-07 13:47:40 -07:00
Vidar Holen
3dd592a02a Support ;& and ;;& in case statements 2014-06-07 12:23:42 -07:00
koalaman
61531cbb10 Merge pull request #169 from Dridi/hackage
Add extra source files in the source tarball
2014-06-01 12:46:08 -07:00
Dridi Boukelmoune
d53087f056 Updated Extra-Source-Files accordingly with #165 2014-06-01 21:35:45 +02:00
Dridi Boukelmoune
39756b420e Add extra source files in the source tarball
This way ShellCheck can be entirely built (including the test suite)
from the Hackage tarball.

The source tarball can be generated using:

    cabal sdist
2014-06-01 17:59:24 +02:00
koalaman
52d4efc951 Merge pull request #168 from rodrigosetti/hlint
Collection of HLint fixes
2014-05-31 16:07:51 -07:00
Rodrigo Setti
5dac723593 Collection of HLint fixes
http://community.haskell.org/~ndm/hlint/
2014-05-31 22:20:49 +00:00
koalaman
2364fd58b6 Merge pull request #166 from rodrigosetti/better-gitignore
Using a more complete Haskell .gitignore
2014-05-31 10:42:17 -07:00
Vidar Holen
cde364c97b Updated README with new cabal instructions 2014-05-31 10:40:45 -07:00
Vidar Holen
98b790f87a Removed outdated version comment 2014-05-31 10:16:11 -07:00
Vidar Holen
726a4e5848 Merge branch 'cabal-version' of https://github.com/rodrigosetti/shellcheck into rodrigosetti-cabal-version
Conflicts:
	ShellCheck/Analytics.hs
	ShellCheck/Data.hs
2014-05-31 09:55:07 -07:00
Rodrigo Setti
0a9ed917e7 Test Suite in Cabal (cabal test)
Please run using "cabal test --show-details=streaming", there's a known
issue about this that was fixed in the latest version of cabal:
https://github.com/haskell/cabal/issues/1810
2014-05-31 01:30:23 +00:00
Rodrigo Setti
b18ee3fdef Using a more complete Haskell .gitignore
Specially for using cabal sandbox.
2014-05-30 00:10:21 +00:00
Rodrigo Setti
3fcc6c44d8 Use version from generated cabal Paths module 2014-05-30 00:08:09 +00:00
12 changed files with 685 additions and 649 deletions

20
.gitignore vendored
View File

@@ -1,7 +1,15 @@
*.hi # Created by http://www.gitignore.io
*.o
.tests ### Haskell ###
jsoncheck
shellcheck
shellcheck.1
dist dist
cabal-dev
*.o
*.hi
*.chi
*.chs.h
.virtualenv
.hsenv
.cabal-sandbox/
cabal.sandbox.config
cabal.config

View File

@@ -1,30 +0,0 @@
# TODO: Phase out Makefile in favor of Cabal
GHCFLAGS=-O9
GHCFLAGS_STATIC=$(GHCFLAGS) -optl-static -optl-pthread
all: shellcheck .tests shellcheck.1
: Done
shellcheck: regardless
: Conditionally compiling shellcheck
ghc $(GHCFLAGS) --make shellcheck
.tests: *.hs */*.hs
: Running unit tests
./test/runQuack && touch .tests
shellcheck.1: shellcheck.1.md
: Formatting man page
pandoc -s -t man $< -o $@
clean:
rm -f .tests shellcheck shellcheck.1
rm -f *.hi *.o ShellCheck/*.hi ShellCheck/*.o
rm -rf dist
shellcheck-static: regardless
: Conditionally compiling a statically linked shellcheck-static
ghc $(GHCFLAGS_STATIC) --make shellcheck -o shellcheck-static
regardless:

View File

@@ -16,12 +16,32 @@ The goals of ShellCheck are:
- To point out subtle caveats, corner cases and pitfalls, that may cause an - To point out subtle caveats, corner cases and pitfalls, that may cause an
advanced user's otherwise working script to fail under future circumstances. advanced user's otherwise working script to fail under future circumstances.
ShellCheck requires at least 1 GB of RAM to compile. Executables can be built with cabal. Tests currently still rely on a Makefile. ShellCheck is written in Haskell, and requires at least 1 GB of RAM to compile.
## Installing
On systems with Cabal:
cabal update
cabal install shellcheck
On Arch Linux with community packages enabled:
pacman -S shellcheck
On OS X with homebrew:
brew install shellcheck
ShellCheck is also available as an online service:
http://www.shellcheck.net
## Building with Cabal ## Building with Cabal
Make sure cabal is installed. On Debian based distros: This sections describes how to build ShellCheck from a source directory.
First, make sure cabal is installed. On Debian based distros:
apt-get install cabal-install apt-get install cabal-install
@@ -45,39 +65,24 @@ Let cabal update itself, in case your distro version is outdated:
With cabal installed, cd to the ShellCheck source directory and: With cabal installed, cd to the ShellCheck source directory and:
$ cabal install $ cabal install
This will install ShellCheck to your ~/.cabal/bin directory. This will install ShellCheck to your ~/.cabal/bin directory.
Add the directory to your PATH (for bash, add this to your ~/.bashrc file): Add the directory to your PATH (for bash, add this to your ~/.bashrc file):
export PATH=$HOME/.cabal/bin:$PATH export PATH=$HOME/.cabal/bin:$PATH
Verify that your PATH is set up correctly: Verify that your PATH is set up correctly:
$ which shellcheck $ which shellcheck
~/.cabal/bin/shellcheck ~/.cabal/bin/shellcheck
## Building with Make ## Running tests
ShellCheck is written in Haskell, and requires GHC, Parsec3, JSON and To run the unit test suite:
Text.Regex. To run the unit tests, it also requires QuickCheck2.
On Fedora, these can be installed with: cabal configure --enable-tests
cabal build
yum install ghc ghc-parsec-devel ghc-QuickCheck-devel \ cabal test
ghc-json-devel ghc-regex-compat-devel pandoc
On Ubuntu and similar, use:
apt-get install ghc libghc-parsec3-dev libghc-json-dev \
libghc-regex-compat-dev libghc-quickcheck2-dev pandoc
To build and run the tests, cd to the shellcheck source directory and:
$ make
If you want to distribute the binary and/or run it on other distros, you
can `make shellcheck-static` to build a statically linked executable without
library dependencies.
Happy ShellChecking! Happy ShellChecking!

View File

@@ -1,6 +1,5 @@
Name: ShellCheck Name: ShellCheck
-- Must also be updated in ShellCheck/Data.hs : Version: 0.3.4
Version: 0.3.3
Synopsis: Shell script analysis tool Synopsis: Shell script analysis tool
License: OtherLicense License: OtherLicense
License-file: LICENSE License-file: LICENSE
@@ -23,6 +22,13 @@ Description:
* To point out subtle caveats, corner cases and pitfalls, that may cause an * To point out subtle caveats, corner cases and pitfalls, that may cause an
advanced user's otherwise working script to fail under future circumstances. advanced user's otherwise working script to fail under future circumstances.
Extra-Source-Files:
-- documentation
README.md
shellcheck.1.md
-- tests
test/shellcheck.hs
source-repository head source-repository head
type: git type: git
location: git://github.com/koalaman/shellcheck.git location: git://github.com/koalaman/shellcheck.git
@@ -35,13 +41,16 @@ library
json, json,
mtl, mtl,
parsec, parsec,
regex-compat regex-compat,
QuickCheck >= 2.2
exposed-modules: exposed-modules:
ShellCheck.Analytics ShellCheck.Analytics
ShellCheck.AST ShellCheck.AST
ShellCheck.Data ShellCheck.Data
ShellCheck.Parser ShellCheck.Parser
ShellCheck.Simple ShellCheck.Simple
other-modules:
Paths_ShellCheck
executable shellcheck executable shellcheck
build-depends: build-depends:
@@ -52,5 +61,21 @@ executable shellcheck
json, json,
mtl, mtl,
parsec, parsec,
regex-compat regex-compat,
QuickCheck >= 2.2
main-is: shellcheck.hs main-is: shellcheck.hs
test-suite test-shellcheck
type: exitcode-stdio-1.0
build-depends:
ShellCheck,
base >= 4 && < 5,
containers,
directory,
json,
mtl,
parsec,
regex-compat,
QuickCheck >= 2.2
main-is: test/shellcheck.hs

View File

@@ -29,16 +29,14 @@ data AssignmentMode = Assign | Append deriving (Show, Eq)
data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq) data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq)
data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq) data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq)
data ForInType = NormalForIn | ShortForIn deriving (Show, Eq) data ForInType = NormalForIn | ShortForIn deriving (Show, Eq)
data CaseType = CaseBreak | CaseFallThrough | CaseContinue deriving (Show, Eq)
data Token = data Token =
TA_Base Id String Token TA_Binary Id String Token Token
| TA_Binary Id String Token Token | TA_Expansion Id [Token]
| TA_Expansion Id Token
| TA_Literal Id String
| TA_Sequence Id [Token] | TA_Sequence Id [Token]
| TA_Trinary Id Token Token Token | TA_Trinary Id Token Token Token
| TA_Unary Id String Token | TA_Unary Id String Token
| TA_Variable Id String
| TC_And Id ConditionType String Token Token | TC_And Id ConditionType String Token Token
| TC_Binary Id ConditionType String Token Token | TC_Binary Id ConditionType String Token Token
| TC_Group Id ConditionType Token | TC_Group Id ConditionType Token
@@ -49,6 +47,8 @@ data Token =
| T_AndIf Id (Token) (Token) | T_AndIf Id (Token) (Token)
| T_Arithmetic Id Token | T_Arithmetic Id Token
| T_Array Id [Token] | T_Array Id [Token]
| T_IndexedElement Id Token Token
| T_ Id [Token]
| T_Assignment Id AssignmentMode String (Maybe Token) Token | T_Assignment Id AssignmentMode String (Maybe Token) Token
| T_Backgrounded Id Token | T_Backgrounded Id Token
| T_Backticked Id [Token] | T_Backticked Id [Token]
@@ -58,7 +58,7 @@ data Token =
| T_BraceGroup Id [Token] | T_BraceGroup Id [Token]
| T_CLOBBER Id | T_CLOBBER Id
| T_Case Id | T_Case Id
| T_CaseExpression Id Token [([Token],[Token])] | T_CaseExpression Id Token [(CaseType, [Token], [Token])]
| T_Condition Id ConditionType Token | T_Condition Id ConditionType Token
| T_DGREAT Id | T_DGREAT Id
| T_DLESS Id | T_DLESS Id
@@ -179,6 +179,7 @@ analyze f g i =
b <- round value b <- round value
return $ T_Assignment id mode var a b return $ T_Assignment id mode var a b
delve (T_Array id t) = dl t $ T_Array id delve (T_Array id t) = dl t $ T_Array id
delve (T_IndexedElement id t1 t2) = d2 t1 t2 $ T_IndexedElement id
delve (T_Redirecting id redirs cmd) = do delve (T_Redirecting id redirs cmd) = do
a <- roundAll redirs a <- roundAll redirs
b <- round cmd b <- round cmd
@@ -207,10 +208,10 @@ analyze f g i =
delve (T_SelectIn id v w l) = dll w l $ T_SelectIn id v delve (T_SelectIn id v w l) = dll w l $ T_SelectIn id v
delve (T_CaseExpression id word cases) = do delve (T_CaseExpression id word cases) = do
newWord <- round word newWord <- round word
newCases <- mapM (\(c, t) -> do newCases <- mapM (\(o, c, t) -> do
x <- mapM round c x <- mapM round c
y <- mapM round t y <- mapM round t
return (x,y) return (o, x,y)
) cases ) cases
return $ T_CaseExpression id newWord newCases return $ T_CaseExpression id newWord newCases
@@ -243,8 +244,7 @@ analyze f g i =
b <- round t2 b <- round t2
c <- round t3 c <- round t3
return $ TA_Trinary id a b c return $ TA_Trinary id a b c
delve (TA_Expansion id t) = d1 t $ TA_Expansion id delve (TA_Expansion id t) = dl t $ TA_Expansion id
delve (TA_Base id b t) = d1 t $ TA_Base id b
delve (T_Annotation id anns t) = d1 t $ T_Annotation id anns delve (T_Annotation id anns t) = d1 t $ T_Annotation id anns
delve t = return t delve t = return t
@@ -297,6 +297,7 @@ getId t = case t of
T_FdRedirect id _ _ -> id T_FdRedirect id _ _ -> id
T_Assignment id _ _ _ _ -> id T_Assignment id _ _ _ _ -> id
T_Array id _ -> id T_Array id _ -> id
T_IndexedElement id _ _ -> id
T_Redirecting id _ _ -> id T_Redirecting id _ _ -> id
T_SimpleCommand id _ _ -> id T_SimpleCommand id _ _ -> id
T_Pipeline id _ _ -> id T_Pipeline id _ _ -> id
@@ -327,11 +328,8 @@ getId t = case t of
TA_Binary id _ _ _ -> id TA_Binary id _ _ _ -> id
TA_Unary id _ _ -> id TA_Unary id _ _ -> id
TA_Sequence id _ -> id TA_Sequence id _ -> id
TA_Variable id _ -> id
TA_Trinary id _ _ _ -> id TA_Trinary id _ _ _ -> id
TA_Expansion id _ -> id TA_Expansion id _ -> id
TA_Literal id _ -> id
TA_Base id _ _ -> id
T_ProcSub id _ _ -> id T_ProcSub id _ _ -> id
T_Glob id _ -> id T_Glob id _ -> id
T_ForArithmetic id _ _ _ _ -> id T_ForArithmetic id _ _ _ _ -> id

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,9 @@
module ShellCheck.Data where module ShellCheck.Data where
shellcheckVersion = "0.3.3" -- Must also be updated in ShellCheck.cabal import Data.Version (showVersion)
import Paths_ShellCheck (version)
shellcheckVersion = showVersion version
internalVariables = [ internalVariables = [
-- Generic -- Generic

View File

@@ -15,15 +15,15 @@
You should have received a copy of the GNU Affero General Public License You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. along with this program. If not, see <http://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell #-}
module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, runTests) where
module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote) where
import ShellCheck.AST import ShellCheck.AST
import ShellCheck.Data import ShellCheck.Data
import Text.Parsec import Text.Parsec
import Debug.Trace import Debug.Trace
import Control.Monad import Control.Monad
import Control.Arrow (first)
import Data.Char import Data.Char
import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub) import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub)
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -33,9 +33,10 @@ import Prelude hiding (readList)
import System.IO import System.IO
import Text.Parsec.Error import Text.Parsec.Error
import GHC.Exts (sortWith) import GHC.Exts (sortWith)
import Test.QuickCheck.All (quickCheckAll)
backslash = char '\\' backslash = char '\\'
linefeed = (optional carriageReturn) >> char '\n' linefeed = optional carriageReturn >> char '\n'
singleQuote = char '\'' <|> unicodeSingleQuote singleQuote = char '\'' <|> unicodeSingleQuote
doubleQuote = char '"' <|> unicodeDoubleQuote doubleQuote = char '"' <|> unicodeDoubleQuote
variableStart = upper <|> lower <|> oneOf "_" variableStart = upper <|> lower <|> oneOf "_"
@@ -60,7 +61,7 @@ unicodeDoubleQuoteChars = "\x201C\x201D\x2033\x2036"
prop_spacing = isOk spacing " \\\n # Comment" prop_spacing = isOk spacing " \\\n # Comment"
spacing = do spacing = do
x <- many (many1 linewhitespace <|> (try $ string "\\\n")) x <- many (many1 linewhitespace <|> try (string "\\\n"))
optional readComment optional readComment
return $ concat x return $ concat x
@@ -110,7 +111,7 @@ nbsp = do
data Note = Note Id Severity Code String deriving (Show, Eq) data Note = Note Id Severity Code String deriving (Show, Eq)
data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq) data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq)
data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord)
data Context = ContextName SourcePos String | ContextAnnotation [Annotation] data Context = ContextName SourcePos String | ContextAnnotation [Annotation] deriving (Show)
type Code = Integer type Code = Integer
codeForParseNote (ParseNote _ _ code _) = code codeForParseNote (ParseNote _ _ code _) = code
@@ -131,7 +132,7 @@ getNextIdAt sourcepos = do
let newMap = Map.insert newId sourcepos map let newMap = Map.insert newId sourcepos map
putState (newId, newMap, notes) putState (newId, newMap, notes)
return newId return newId
where incId (Id n) = (Id $ n+1) where incId (Id n) = Id $ n+1
getNextId = do getNextId = do
pos <- getPosition pos <- getPosition
@@ -151,7 +152,7 @@ getParseNotes = do
addParseNote n = do addParseNote n = do
irrelevant <- shouldIgnoreCode (codeForParseNote n) irrelevant <- shouldIgnoreCode (codeForParseNote n)
when (not irrelevant) $ do unless irrelevant $ do
(a, b, notes) <- getState (a, b, notes) <- getState
putState (a, b, n:notes) putState (a, b, n:notes)
@@ -169,7 +170,7 @@ parseProblem level code msg = do
pos <- getPosition pos <- getPosition
parseProblemAt pos level code msg parseProblemAt pos level code msg
setCurrentContexts c = do setCurrentContexts c =
Ms.modify (\(list, _) -> (list, c)) Ms.modify (\(list, _) -> (list, c))
getCurrentContexts = do getCurrentContexts = do
@@ -192,8 +193,8 @@ pushContext c = do
parseProblemAt pos level code msg = do parseProblemAt pos level code msg = do
irrelevant <- shouldIgnoreCode code irrelevant <- shouldIgnoreCode code
when (not irrelevant) $ unless irrelevant $
Ms.modify (\(list, current) -> ((ParseNote pos level code msg):list, current)) Ms.modify (first ((:) (ParseNote pos level code msg)))
-- Store non-parse problems inside -- Store non-parse problems inside
@@ -209,15 +210,15 @@ thenSkip main follow = do
optional follow optional follow
return r return r
unexpecting s p = try $ do unexpecting s p = try $
(try p >> unexpected s) <|> return () (try p >> unexpected s) <|> return ()
notFollowedBy2 = unexpecting "keyword/token" notFollowedBy2 = unexpecting "keyword/token"
disregard x = x >> return () disregard = void
reluctantlyTill p end = do reluctantlyTill p end =
(lookAhead ((disregard $ try end) <|> eof) >> return []) <|> do (lookAhead (disregard (try end) <|> eof) >> return []) <|> do
x <- p x <- p
more <- reluctantlyTill p end more <- reluctantlyTill p end
return $ x:more return $ x:more
@@ -229,15 +230,15 @@ reluctantlyTill1 p end = do
more <- reluctantlyTill p end more <- reluctantlyTill p end
return $ x:more return $ x:more
attempting rest branch = do attempting rest branch =
((try branch) >> rest) <|> rest (try branch >> rest) <|> rest
orFail parser stuff = do orFail parser stuff =
try (disregard parser) <|> (disregard stuff >> fail "nope") try (disregard parser) <|> (disregard stuff >> fail "nope")
wasIncluded p = option False (p >> return True) wasIncluded p = option False (p >> return True)
acceptButWarn parser level code note = do acceptButWarn parser level code note =
optional $ try (do optional $ try (do
pos <- getPosition pos <- getPosition
parser parser
@@ -252,17 +253,17 @@ withContext entry p = do
return v return v
<|> do -- p failed without consuming input, abort context <|> do -- p failed without consuming input, abort context
popContext popContext
fail $ "" fail ""
called s p = do called s p = do
pos <- getPosition pos <- getPosition
withContext (ContextName pos s) p withContext (ContextName pos s) p
withAnnotations anns p = withAnnotations anns =
withContext (ContextAnnotation anns) p withContext (ContextAnnotation anns)
readConditionContents single = do readConditionContents single =
readCondContents `attempting` (lookAhead $ do readCondContents `attempting` lookAhead (do
pos <- getPosition pos <- getPosition
s <- many1 letter s <- many1 letter
when (s `elem` commonCommands) $ when (s `elem` commonCommands) $
@@ -273,7 +274,7 @@ readConditionContents single = do
readCondBinaryOp = try $ do readCondBinaryOp = try $ do
optional guardArithmetic optional guardArithmetic
id <- getNextId id <- getNextId
op <- (choice $ (map tryOp ["==", "!=", "<=", ">=", "=~", ">", "<", "=", "\\<=", "\\>=", "\\<", "\\>"])) <|> otherOp op <- choice (map tryOp ["==", "!=", "<=", ">=", "=~", ">", "<", "=", "\\<=", "\\>=", "\\<", "\\>"]) <|> otherOp
hardCondSpacing hardCondSpacing
return op return op
where where
@@ -301,7 +302,7 @@ readConditionContents single = do
arg <- readCondWord arg <- readCondWord
return $ op arg) return $ op arg)
<|> (do <|> (do
parseProblemAt pos ErrorC 1019 $ "Expected this to be an argument to the unary condition." parseProblemAt pos ErrorC 1019 "Expected this to be an argument to the unary condition."
fail "oops") fail "oops")
readCondUnaryOp = try $ do readCondUnaryOp = try $ do
@@ -316,7 +317,7 @@ readConditionContents single = do
return ('-':s) return ('-':s)
readCondWord = do readCondWord = do
notFollowedBy2 (try (spacing >> (string "]"))) notFollowedBy2 (try (spacing >> string "]"))
x <- readNormalWord x <- readNormalWord
pos <- getPosition pos <- getPosition
when (endedWith "]" x) $ do when (endedWith "]" x) $ do
@@ -324,14 +325,14 @@ readConditionContents single = do
"You need a space before the " ++ (if single then "]" else "]]") ++ "." "You need a space before the " ++ (if single then "]" else "]]") ++ "."
fail "Missing space before ]" fail "Missing space before ]"
when (single && endedWith ")" x) $ do when (single && endedWith ")" x) $ do
parseProblemAt pos ErrorC 1021 $ parseProblemAt pos ErrorC 1021
"You need a space before the \\)" "You need a space before the \\)"
fail "Missing space before )" fail "Missing space before )"
disregard spacing disregard spacing
return x return x
where endedWith str (T_NormalWord id s@(_:_)) = where endedWith str (T_NormalWord id s@(_:_)) =
case (last s) of T_Literal id s -> str `isSuffixOf` s case last s of T_Literal id s -> str `isSuffixOf` s
_ -> False _ -> False
endedWith _ _ = False endedWith _ _ = False
readCondAndOp = do readCondAndOp = do
@@ -364,9 +365,9 @@ readConditionContents single = do
op <- readCondBinaryOp op <- readCondBinaryOp
y <- if isRegex y <- if isRegex
then readRegex then readRegex
else readCondWord <|> ( (parseProblemAt pos ErrorC 1027 $ "Expected another argument for this operator.") >> mzero) else readCondWord <|> (parseProblemAt pos ErrorC 1027 "Expected another argument for this operator." >> mzero)
return (x `op` y) return (x `op` y)
) <|> (return $ TC_Noary id typ x) ) <|> return (TC_Noary id typ x)
readCondGroup = do readCondGroup = do
id <- getNextId id <- getNextId
@@ -389,7 +390,7 @@ readConditionContents single = do
xor x y = x && not y || not x && y xor x y = x && not y || not x && y
-- Currently a bit of a hack since parsing rules are obscure -- Currently a bit of a hack since parsing rules are obscure
regexOperatorAhead = (lookAhead $ do regexOperatorAhead = lookAhead (do
try (string "=~") <|> try (string "~=") try (string "=~") <|> try (string "~=")
return True) return True)
<|> return False <|> return False
@@ -467,6 +468,8 @@ prop_aC = isOk readArithmeticContents "\"$((3+2))\" + '37'"
prop_aD = isOk readArithmeticContents "foo[9*y+x]++" prop_aD = isOk readArithmeticContents "foo[9*y+x]++"
prop_aE = isOk readArithmeticContents "1+`echo 2`" prop_aE = isOk readArithmeticContents "1+`echo 2`"
prop_aF = isOk readArithmeticContents "foo[`echo foo | sed s/foo/4/g` * 3] + 4" prop_aF = isOk readArithmeticContents "foo[`echo foo | sed s/foo/4/g` * 3] + 4"
prop_a10= isOk readArithmeticContents "$foo$bar"
prop_a11= isOk readArithmeticContents "i<(0+(1+1))"
readArithmeticContents = readArithmeticContents =
readSequence readSequence
where where
@@ -484,25 +487,34 @@ readArithmeticContents =
spacing spacing
return $ token id op return $ token id op
readVar = do
id <- getNextId
x <- readVariableName
y <- readArrayIndex <|> return ""
optional spacing
return $ TA_Variable id (x ++ y)
-- Doesn't help with foo[foo]
readArrayIndex = do readArrayIndex = do
char '[' id <- getNextId
x <- many1 $ noneOf "]" start <- literal "["
char ']' middle <- readArithmeticContents
return $ "[" ++ x ++ "]" end <- literal "]"
return $ T_NormalWord id [start, middle, end]
literal s = do
id <- getNextId
string s
return $ T_Literal id s
readArithmeticLiteral =
readArrayIndex <|> literal "#"
readExpansion = do readExpansion = do
id <- getNextId id <- getNextId
x <- readNormalDollar <|> readBackTicked pieces <- many1 $ choice [
readArithmeticLiteral,
readSingleQuoted,
readDoubleQuoted,
readNormalDollar,
readBraced,
readBackTicked,
readNormalLiteral "+-*/=%^,]"
]
spacing spacing
return $ TA_Expansion id x return $ TA_Expansion id pieces
readGroup = do readGroup = do
char '(' char '('
@@ -511,40 +523,7 @@ readArithmeticContents =
spacing spacing
return s return s
readNumber = do readArithTerm = readGroup <|> readExpansion
id <- getNextId
num <- many1 $ oneOf "0123456789."
return $ TA_Literal id (num)
readBased = getArbitrary <|> getHex <|> getOct
where
getThing prefix litchars = try $ do
id <- getNextId
x <- prefix
t <- readExpansion <|> (do
i <- getNextId
stuff <- many1 litchars
return $ TA_Literal i stuff)
return $ TA_Base id x t
getArbitrary = getThing arbitrary variableChars
getHex = getThing hex hexDigit
getOct = getThing oct digit
arbitrary = try $ do
b <- many1 digit
s <- char '#'
return (b ++ [s])
hex = try $ do
z <- char '0'
x <- oneOf "xX"
return (z:x:[])
oct = string "0"
readArithTerm = readBased <|> readArithTermUnit
readArithTermUnit = readGroup <|> readExpansion <|> readQuoted <|> readNumber <|> readVar
readQuoted = readDoubleQuoted <|> readSingleQuoted
readSequence = do readSequence = do
spacing spacing
@@ -641,7 +620,7 @@ prop_readCondition13= isOk readCondition "[[ foo =~ ^fo{1,3}$ ]]"
readCondition = called "test expression" $ do readCondition = called "test expression" $ do
opos <- getPosition opos <- getPosition
id <- getNextId id <- getNextId
open <- (try $ string "[[") <|> (string "[") open <- try (string "[[") <|> string "["
let single = open == "[" let single = open == "["
condSpacingMsg False $ if single condSpacingMsg False $ if single
then "You need spaces after the opening [ and before the closing ]." then "You need spaces after the opening [ and before the closing ]."
@@ -649,7 +628,7 @@ readCondition = called "test expression" $ do
condition <- readConditionContents single condition <- readConditionContents single
cpos <- getPosition cpos <- getPosition
close <- (try $ string "]]") <|> (string "]") close <- try (string "]]") <|> string "]"
when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC 1033 "Did you mean ]] ?" when (open == "[[" && close /= "]]") $ parseProblemAt cpos ErrorC 1033 "Did you mean ]] ?"
when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC 1034 "Did you mean [[ ?" when (open == "[" && close /= "]" ) $ parseProblemAt opos ErrorC 1034 "Did you mean [[ ?"
spacing spacing
@@ -674,12 +653,12 @@ prop_readAnnotation2 = isOk readAnnotation "# shellcheck disable=SC1234 disable=
readAnnotation = called "shellcheck annotation" $ do readAnnotation = called "shellcheck annotation" $ do
try readAnnotationPrefix try readAnnotationPrefix
many1 linewhitespace many1 linewhitespace
values <- many1 (readDisable) values <- many1 readDisable
linefeed linefeed
many linewhitespace many linewhitespace
return $ concat values return $ concat values
where where
readDisable = forKey "disable" $ do readDisable = forKey "disable" $
readCode `sepBy` char ',' readCode `sepBy` char ','
where where
readCode = do readCode = do
@@ -718,12 +697,12 @@ readNormalishWord end = do
return $ T_NormalWord id x return $ T_NormalWord id x
checkPossibleTermination pos [T_Literal _ x] = checkPossibleTermination pos [T_Literal _ x] =
if x `elem` ["do", "done", "then", "fi", "esac"] when (x `elem` ["do", "done", "then", "fi", "esac"]) $
then parseProblemAt pos WarningC 1010 $ "Use semicolon or linefeed before '" ++ x ++ "' (or quote to make it literal)." parseProblemAt pos WarningC 1010 $ "Use semicolon or linefeed before '" ++ x ++ "' (or quote to make it literal)."
else return ()
checkPossibleTermination _ _ = return () checkPossibleTermination _ _ = return ()
readNormalWordPart end = do readNormalWordPart end = do
notFollowedBy2 $ oneOf end
checkForParenthesis checkForParenthesis
choice [ choice [
readSingleQuoted, readSingleQuoted,
@@ -737,7 +716,7 @@ readNormalWordPart end = do
readLiteralCurlyBraces readLiteralCurlyBraces
] ]
where where
checkForParenthesis = do checkForParenthesis =
return () `attempting` do return () `attempting` do
pos <- getPosition pos <- getPosition
lookAhead $ char '(' lookAhead $ char '('
@@ -806,9 +785,9 @@ readSingleQuoted = called "single quoted string" $ do
optional $ do optional $ do
c <- try . lookAhead $ suspectCharAfterQuotes <|> oneOf "'" c <- try . lookAhead $ suspectCharAfterQuotes <|> oneOf "'"
if (not (null string) && isAlpha c && isAlpha (last string)) if not (null string) && isAlpha c && isAlpha (last string)
then then
parseProblemAt endPos WarningC 1011 $ parseProblemAt endPos WarningC 1011
"This apostrophe terminated the single quoted string!" "This apostrophe terminated the single quoted string!"
else else
when ('\n' `elem` string && not ("\n" `isPrefixOf` string)) $ when ('\n' `elem` string && not ("\n" `isPrefixOf` string)) $
@@ -824,7 +803,7 @@ readSingleQuotedLiteral = do
readSingleQuotedPart = readSingleQuotedPart =
readSingleEscaped readSingleEscaped
<|> (many1 $ noneOf "'\\\x2018\x2019") <|> many1 (noneOf "'\\\x2018\x2019")
prop_readBackTicked = isOk readBackTicked "`ls *.mp3`" prop_readBackTicked = isOk readBackTicked "`ls *.mp3`"
prop_readBackTicked2 = isOk readBackTicked "`grep \"\\\"\"`" prop_readBackTicked2 = isOk readBackTicked "`grep \"\\\"\"`"
@@ -843,7 +822,7 @@ readBackTicked = called "backtick expansion" $ do
optional $ do optional $ do
c <- try . lookAhead $ suspectCharAfterQuotes c <- try . lookAhead $ suspectCharAfterQuotes
when ('\n' `elem` subString && not ("\n" `isPrefixOf` subString)) $ do when ('\n' `elem` subString && not ("\n" `isPrefixOf` subString)) $
suggestForgotClosingQuote startPos endPos "backtick expansion" suggestForgotClosingQuote startPos endPos "backtick expansion"
-- Result positions may be off due to escapes -- Result positions may be off due to escapes
@@ -858,7 +837,7 @@ readBackTicked = called "backtick expansion" $ do
disregard (char '`') <|> do disregard (char '`') <|> do
pos <- getPosition pos <- getPosition
char '´' char '´'
parseProblemAt pos ErrorC 1077 $ parseProblemAt pos ErrorC 1077
"For command expansion, the tick should slant left (` vs ´)." "For command expansion, the tick should slant left (` vs ´)."
subParse pos parser input = do subParse pos parser input = do
@@ -889,7 +868,7 @@ readDoubleQuoted = called "double quoted string" $ do
suggestForgotClosingQuote startPos endPos "double quoted string" suggestForgotClosingQuote startPos endPos "double quoted string"
return $ T_DoubleQuoted id x return $ T_DoubleQuoted id x
where where
startsWithLineFeed ((T_Literal _ ('\n':_)):_) = True startsWithLineFeed (T_Literal _ ('\n':_):_) = True
startsWithLineFeed _ = False startsWithLineFeed _ = False
hasLineFeed (T_Literal _ str) | '\n' `elem` str = True hasLineFeed (T_Literal _ str) | '\n' `elem` str = True
hasLineFeed _ = False hasLineFeed _ = False
@@ -897,7 +876,7 @@ readDoubleQuoted = called "double quoted string" $ do
suggestForgotClosingQuote startPos endPos name = do suggestForgotClosingQuote startPos endPos name = do
parseProblemAt startPos WarningC 1078 $ parseProblemAt startPos WarningC 1078 $
"Did you forget to close this " ++ name ++ "?" "Did you forget to close this " ++ name ++ "?"
parseProblemAt endPos InfoC 1079 $ parseProblemAt endPos InfoC 1079
"This is actually an end quote, but due to next char it looks suspect." "This is actually an end quote, but due to next char it looks suspect."
doubleQuotedPart = readDoubleLiteral <|> readDoubleQuotedDollar <|> readBackTicked doubleQuotedPart = readDoubleLiteral <|> readDoubleQuotedDollar <|> readBackTicked
@@ -914,7 +893,7 @@ readDoubleLiteral = do
return $ T_Literal id (concat s) return $ T_Literal id (concat s)
readDoubleLiteralPart = do readDoubleLiteralPart = do
x <- many1 $ (readDoubleEscaped <|> (many1 $ noneOf ('\\':doubleQuotableChars))) x <- many1 (readDoubleEscaped <|> many1 (noneOf ('\\':doubleQuotableChars)))
return $ concat x return $ concat x
readNormalLiteral end = do readNormalLiteral end = do
@@ -937,9 +916,9 @@ readGlob = readExtglob <|> readSimple <|> readClass <|> readGlobbyLiteral
readClass = try $ do readClass = try $ do
id <- getNextId id <- getNextId
char '[' char '['
s <- many1 (predefined <|> (liftM return $ letter <|> digit <|> oneOf globchars)) s <- many1 (predefined <|> liftM return (letter <|> digit <|> oneOf globchars))
char ']' char ']'
return $ T_Glob id $ "[" ++ (concat s) ++ "]" return $ T_Glob id $ "[" ++ concat s ++ "]"
where where
globchars = "^-_:?*.,!~@#$%=+{}/~" globchars = "^-_:?*.,!~@#$%=+{}/~"
predefined = do predefined = do
@@ -953,20 +932,20 @@ readGlob = readExtglob <|> readSimple <|> readClass <|> readGlobbyLiteral
c <- extglobStart <|> char '[' c <- extglobStart <|> char '['
return $ T_Literal id [c] return $ T_Literal id [c]
readNormalLiteralPart end = do readNormalLiteralPart end =
readNormalEscaped <|> (many1 $ noneOf (end ++ quotableChars ++ extglobStartChars ++ "[{}")) readNormalEscaped <|> many1 (noneOf (end ++ quotableChars ++ extglobStartChars ++ "[{}"))
readNormalEscaped = called "escaped char" $ do readNormalEscaped = called "escaped char" $ do
pos <- getPosition pos <- getPosition
backslash backslash
do do
next <- (quotable <|> oneOf "?*@!+[]{}.,") next <- quotable <|> oneOf "?*@!+[]{}.,"
return $ if next == '\n' then "" else [next] return $ if next == '\n' then "" else [next]
<|> <|>
do do
next <- anyChar next <- anyChar
case escapedChar next of case escapedChar next of
Just name -> parseNoteAt pos WarningC 1012 $ "\\" ++ [next] ++ " is just literal '" ++ [next] ++ "' here. For " ++ name ++ ", use " ++ (alternative next) ++ " instead." Just name -> parseNoteAt pos WarningC 1012 $ "\\" ++ [next] ++ " is just literal '" ++ [next] ++ "' here. For " ++ name ++ ", use " ++ alternative next ++ " instead."
Nothing -> parseNoteAt pos InfoC 1001 $ "This \\" ++ [next] ++ " will be a regular '" ++ [next] ++ "' in this context." Nothing -> parseNoteAt pos InfoC 1001 $ "This \\" ++ [next] ++ " will be a regular '" ++ [next] ++ "' in this context."
return [next] return [next]
where where
@@ -991,7 +970,7 @@ readExtglob = called "extglob" $ do
f <- extglobStart f <- extglobStart
char '(' char '('
return f return f
contents <- readExtglobPart `sepBy` (char '|') contents <- readExtglobPart `sepBy` char '|'
char ')' char ')'
return $ T_Extglob id [c] contents return $ T_Extglob id [c] contents
@@ -1003,7 +982,7 @@ readExtglobPart = do
readExtglobGroup = do readExtglobGroup = do
id <- getNextId id <- getNextId
char '(' char '('
contents <- readExtglobPart `sepBy` (char '|') contents <- readExtglobPart `sepBy` char '|'
char ')' char ')'
return $ T_Extglob id "" contents return $ T_Extglob id "" contents
readExtglobLiteral = do readExtglobLiteral = do
@@ -1030,18 +1009,18 @@ readSingleEscaped = do
readDoubleEscaped = do readDoubleEscaped = do
bs <- backslash bs <- backslash
(linefeed >> return "") (linefeed >> return "")
<|> (doubleQuotable >>= return . return) <|> liftM return doubleQuotable
<|> (anyChar >>= (return . \x -> [bs, x])) <|> liftM (\ x -> [bs, x]) anyChar
readBraceEscaped = do readBraceEscaped = do
bs <- backslash bs <- backslash
(linefeed >> return "") (linefeed >> return "")
<|> (bracedQuotable >>= return . return) <|> liftM return bracedQuotable
<|> (anyChar >>= (return . \x -> [bs, x])) <|> liftM (\ x -> [bs, x]) anyChar
readGenericLiteral endChars = do readGenericLiteral endChars = do
strings <- many (readGenericEscaped <|> (many1 $ noneOf ('\\':endChars))) strings <- many (readGenericEscaped <|> many1 (noneOf ('\\':endChars)))
return $ concat strings return $ concat strings
readGenericLiteral1 endExp = do readGenericLiteral1 endExp = do
@@ -1059,12 +1038,12 @@ readBraced = try $ do
let strip (T_Literal _ s) = return ("\"" ++ s ++ "\"") let strip (T_Literal _ s) = return ("\"" ++ s ++ "\"")
id <- getNextId id <- getNextId
char '{' char '{'
str <- many1 ((readDoubleQuotedLiteral >>= (strip)) <|> readGenericLiteral1 (oneOf "}\"" <|> whitespace)) str <- many1 ((readDoubleQuotedLiteral >>= strip) <|> readGenericLiteral1 (oneOf "}\"" <|> whitespace))
char '}' char '}'
let result = concat str let result = concat str
unless (',' `elem` result || ".." `isInfixOf` result) $ unless (',' `elem` result || ".." `isInfixOf` result) $
fail "Not a brace expression" fail "Not a brace expression"
return $ T_BraceExpansion id $ result return $ T_BraceExpansion id result
readNormalDollar = readDollarExpression <|> readDollarDoubleQuote <|> readDollarSingleQuote <|> readDollarLonely readNormalDollar = readDollarExpression <|> readDollarDoubleQuote <|> readDollarSingleQuote <|> readDollarLonely
readDoubleQuotedDollar = readDollarExpression <|> readDollarLonely readDoubleQuotedDollar = readDollarExpression <|> readDollarLonely
@@ -1129,7 +1108,7 @@ readDollarExpansion = called "command expansion" $ do
try (string "$(") try (string "$(")
cmds <- readCompoundList cmds <- readCompoundList
char ')' <?> "end of $(..) expression" char ')' <?> "end of $(..) expression"
return $ (T_DollarExpansion id cmds) return $ T_DollarExpansion id cmds
prop_readDollarVariable = isOk readDollarVariable "$@" prop_readDollarVariable = isOk readDollarVariable "$@"
readDollarVariable = do readDollarVariable = do
@@ -1176,6 +1155,7 @@ prop_readHereDoc3 = isOk readHereDoc "<< foo\n$\"\nfoo"
prop_readHereDoc4 = isOk readHereDoc "<< foo\n`\nfoo" prop_readHereDoc4 = isOk readHereDoc "<< foo\n`\nfoo"
prop_readHereDoc5 = isOk readHereDoc "<<- !foo\nbar\n!foo" prop_readHereDoc5 = isOk readHereDoc "<<- !foo\nbar\n!foo"
prop_readHereDoc6 = isOk readHereDoc "<< foo\\ bar\ncow\nfoo bar" prop_readHereDoc6 = isOk readHereDoc "<< foo\\ bar\ncow\nfoo bar"
prop_readHereDoc7 = isOk readHereDoc "<< foo\n\\$(f ())\nfoo"
readHereDoc = called "here document" $ do readHereDoc = called "here document" $ do
fid <- getNextId fid <- getNextId
pos <- getPosition pos <- getPosition
@@ -1189,8 +1169,8 @@ readHereDoc = called "here document" $ do
parseProblemAt pos ErrorC 1038 message parseProblemAt pos ErrorC 1038 message
hid <- getNextId hid <- getNextId
(quoted, endToken) <- (quoted, endToken) <-
(readDoubleQuotedLiteral >>= return . (\x -> (Quoted, stripLiteral x))) liftM (\ x -> (Quoted, stripLiteral x)) readDoubleQuotedLiteral
<|> (readSingleQuotedLiteral >>= return . (\x -> (Quoted, x))) <|> liftM (\ x -> (Quoted, x)) readSingleQuotedLiteral
<|> (readToken >>= (\x -> return (Unquoted, x))) <|> (readToken >>= (\x -> return (Unquoted, x)))
spacing spacing
@@ -1214,7 +1194,7 @@ readHereDoc = called "here document" $ do
stripLiteral (T_Literal _ x) = x stripLiteral (T_Literal _ x) = x
stripLiteral (T_SingleQuoted _ x) = x stripLiteral (T_SingleQuoted _ x) = x
readToken = do readToken =
liftM concat $ many1 (escaped <|> quoted <|> normal) liftM concat $ many1 (escaped <|> quoted <|> normal)
where where
quoted = liftM stripLiteral readDoubleQuotedLiteral <|> readSingleQuotedLiteral quoted = liftM stripLiteral readDoubleQuotedLiteral <|> readSingleQuotedLiteral
@@ -1226,16 +1206,16 @@ readHereDoc = called "here document" $ do
parseHereData Quoted startPos hereData = do parseHereData Quoted startPos hereData = do
id <- getNextIdAt startPos id <- getNextIdAt startPos
return $ [T_Literal id hereData] return [T_Literal id hereData]
parseHereData Unquoted startPos hereData = do parseHereData Unquoted startPos hereData =
subParse startPos readHereData hereData subParse startPos readHereData hereData
readHereData = many $ try readNormalDollar <|> try readBackTicked <|> readHereLiteral readHereData = many $ try doubleQuotedPart <|> readHereLiteral
readHereLiteral = do readHereLiteral = do
id <- getNextId id <- getNextId
chars <- many1 $ noneOf "`$" chars <- many1 $ noneOf "`$\\"
return $ T_Literal id chars return $ T_Literal id chars
verifyHereDoc dashed quoted spacing hereInfo = do verifyHereDoc dashed quoted spacing hereInfo = do
@@ -1245,17 +1225,17 @@ readHereDoc = called "here document" $ do
parseNote ErrorC 1040 "When using <<-, you can only indent with tabs." parseNote ErrorC 1040 "When using <<-, you can only indent with tabs."
return () return ()
debugHereDoc pos endToken doc = debugHereDoc pos endToken doc
if endToken `isInfixOf` doc | endToken `isInfixOf` doc =
then let lookAt line = when (endToken `isInfixOf` line) $
let lookAt line = when (endToken `isInfixOf` line) $ parseProblemAt pos ErrorC 1041 ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').")
parseProblemAt pos ErrorC 1041 ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').") in do
in do parseProblemAt pos ErrorC 1042 ("Found '" ++ endToken ++ "' further down, but not entirely by itself.")
parseProblemAt pos ErrorC 1042 ("Found '" ++ endToken ++ "' further down, but not entirely by itself.") mapM_ lookAt (lines doc)
mapM_ lookAt (lines doc) | map toLower endToken `isInfixOf` map toLower doc =
else if (map toLower endToken) `isInfixOf` (map toLower doc) parseProblemAt pos ErrorC 1043 ("Found " ++ endToken ++ " further down, but with wrong casing.")
then parseProblemAt pos ErrorC 1043 ("Found " ++ endToken ++ " further down, but with wrong casing.") | otherwise =
else parseProblemAt pos ErrorC 1044 ("Couldn't find end token `" ++ endToken ++ "' in the here document.") parseProblemAt pos ErrorC 1044 ("Couldn't find end token `" ++ endToken ++ "' in the here document.")
readFilename = readNormalWord readFilename = readNormalWord
@@ -1305,9 +1285,9 @@ readLineBreak = optional readNewlineList
prop_readSeparator1 = isWarning readScript "a &; b" prop_readSeparator1 = isWarning readScript "a &; b"
prop_readSeparator2 = isOk readScript "a & b" prop_readSeparator2 = isOk readScript "a & b"
readSeparatorOp = do readSeparatorOp = do
notFollowedBy2 (g_AND_IF <|> g_DSEMI) notFollowedBy2 (void g_AND_IF <|> void readCaseSeparator)
notFollowedBy2 (string "&>") notFollowedBy2 (string "&>")
f <- (try $ do f <- try (do
char '&' char '&'
spacing spacing
pos <- getPosition pos <- getPosition
@@ -1320,7 +1300,7 @@ readSeparatorOp = do
spacing spacing
return f return f
readSequentialSep = (disregard $ g_Semi >> readLineBreak) <|> (disregard readNewlineList) readSequentialSep = disregard (g_Semi >> readLineBreak) <|> disregard readNewlineList
readSeparator = readSeparator =
do do
separator <- readSeparatorOp separator <- readSeparatorOp
@@ -1343,9 +1323,9 @@ makeSimpleCommand id1 id2 prefix cmd suffix =
in in
T_Redirecting id1 redirs $ T_SimpleCommand id2 assigns args T_Redirecting id1 redirs $ T_SimpleCommand id2 assigns args
where where
assignment (T_Assignment _ _ _ _ _) = True assignment (T_Assignment {}) = True
assignment _ = False assignment _ = False
redirection (T_FdRedirect _ _ _) = True redirection (T_FdRedirect {}) = True
redirection _ = False redirection _ = False
@@ -1365,20 +1345,20 @@ readSimpleCommand = called "simple command" $ do
case cmd of case cmd of
Nothing -> return $ makeSimpleCommand id1 id2 prefix [] [] Nothing -> return $ makeSimpleCommand id1 id2 prefix [] []
Just cmd -> do Just cmd -> do
suffix <- option [] $ suffix <- option [] $ getParser readCmdSuffix cmd [
if isModifierCommand cmd (["declare", "export", "local", "readonly", "typeset"], readModifierSuffix),
then readModifierSuffix (["time"], readTimeSuffix),
else if isTimeCommand cmd (["let"], readLetSuffix)
then readTimeSuffix ]
else readCmdSuffix
return $ makeSimpleCommand id1 id2 prefix [cmd] suffix return $ makeSimpleCommand id1 id2 prefix [cmd] suffix
where where
isModifierCommand (T_NormalWord _ [T_Literal _ s]) = isCommand strings (T_NormalWord _ [T_Literal _ s]) = s `elem` strings
s `elem` ["declare", "export", "local", "readonly", "typeset"] isCommand _ _ = False
isModifierCommand _ = False getParser def cmd [] = def
-- Might not belong in T_SimpleCommand. Fixme? getParser def cmd ((list, action):rest) =
isTimeCommand (T_NormalWord _ [T_Literal _ "time"]) = True if isCommand list cmd
isTimeCommand _ = False then action
else getParser def cmd rest
prop_readPipeline = isOk readPipeline "! cat /etc/issue | grep -i ubuntu" prop_readPipeline = isOk readPipeline "! cat /etc/issue | grep -i ubuntu"
prop_readPipeline2 = isWarning readPipeline "!cat /etc/issue | grep -i ubuntu" prop_readPipeline2 = isWarning readPipeline "!cat /etc/issue | grep -i ubuntu"
@@ -1389,7 +1369,7 @@ readPipeline = do
(T_Bang id) <- g_Bang (T_Bang id) <- g_Bang
pipe <- readPipeSequence pipe <- readPipeSequence
return $ T_Banged id pipe return $ T_Banged id pipe
<|> do <|>
readPipeSequence readPipeSequence
prop_readAndOr = isOk readAndOr "grep -i lol foo || exit 1" prop_readAndOr = isOk readAndOr "grep -i lol foo || exit 1"
@@ -1399,7 +1379,7 @@ readAndOr = do
aid <- getNextId aid <- getNextId
annotations <- readAnnotations annotations <- readAnnotations
andOr <- withAnnotations annotations $ do andOr <- withAnnotations annotations $
chainr1 readPipeline $ do chainr1 readPipeline $ do
op <- g_AND_IF <|> g_OR_IF op <- g_AND_IF <|> g_OR_IF
readLineBreak readLineBreak
@@ -1419,11 +1399,11 @@ readTerm' current =
do do
id <- getNextId id <- getNextId
sep <- readSeparator sep <- readSeparator
more <- (option (T_EOF id) readAndOr) more <- option (T_EOF id) readAndOr
case more of (T_EOF _) -> return [transformWithSeparator id sep current] case more of (T_EOF _) -> return [transformWithSeparator id sep current]
_ -> do _ -> do
list <- readTerm' more list <- readTerm' more
return $ (transformWithSeparator id sep current : list) return (transformWithSeparator id sep current : list)
<|> <|>
return [current] return [current]
@@ -1453,7 +1433,7 @@ readPipe = do
spacing spacing
return $ T_Pipe id ('|':qualifier) return $ T_Pipe id ('|':qualifier)
readCommand = (readCompoundCommand <|> readSimpleCommand) readCommand = readCompoundCommand <|> readSimpleCommand
readCmdName = do readCmdName = do
f <- readNormalWord f <- readNormalWord
@@ -1512,7 +1492,7 @@ readIfPart = do
readElifPart = called "elif clause" $ do readElifPart = called "elif clause" $ do
pos <- getPosition pos <- getPosition
correctElif <- elif correctElif <- elif
when (not correctElif) $ unless correctElif $
parseProblemAt pos ErrorC 1075 "Use 'elif' instead of 'else if'." parseProblemAt pos ErrorC 1075 "Use 'elif' instead of 'else if'."
allspacing allspacing
condition <- readTerm condition <- readTerm
@@ -1524,7 +1504,7 @@ readElifPart = called "elif clause" $ do
return (condition, action) return (condition, action)
where where
elif = (g_Elif >> return True) <|> elif = (g_Elif >> return True) <|>
(try $ g_Else >> g_If >> return False) try (g_Else >> g_If >> return False)
readElsePart = called "else clause" $ do readElsePart = called "else clause" $ do
pos <- getPosition pos <- getPosition
@@ -1671,14 +1651,14 @@ readSelectClause = called "select loop" $ do
readInClause = do readInClause = do
g_In g_In
things <- (readCmdWord) `reluctantlyTill` things <- readCmdWord `reluctantlyTill`
(disregard (g_Semi) <|> disregard linefeed <|> disregard g_Do) (disregard g_Semi <|> disregard linefeed <|> disregard g_Do)
do { do {
lookAhead (g_Do); lookAhead g_Do;
parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'."; parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'.";
} <|> do { } <|> do {
optional $ g_Semi; optional g_Semi;
disregard allspacing; disregard allspacing;
} }
@@ -1687,6 +1667,8 @@ readInClause = do
prop_readCaseClause = isOk readCaseClause "case foo in a ) lol; cow;; b|d) fooo; esac" prop_readCaseClause = isOk readCaseClause "case foo in a ) lol; cow;; b|d) fooo; esac"
prop_readCaseClause2 = isOk readCaseClause "case foo\n in * ) echo bar;; esac" prop_readCaseClause2 = isOk readCaseClause "case foo\n in * ) echo bar;; esac"
prop_readCaseClause3 = isOk readCaseClause "case foo\n in * ) echo bar & ;; esac" prop_readCaseClause3 = isOk readCaseClause "case foo\n in * ) echo bar & ;; esac"
prop_readCaseClause4 = isOk readCaseClause "case foo\n in *) echo bar ;& bar) foo; esac"
prop_readCaseClause5 = isOk readCaseClause "case foo\n in *) echo bar;;& foo) baz;; esac"
readCaseClause = called "case expression" $ do readCaseClause = called "case expression" $ do
id <- getNextId id <- getNextId
g_Case g_Case
@@ -1707,14 +1689,21 @@ readCaseItem = called "case item" $ do
pattern <- readPattern pattern <- readPattern
g_Rparen g_Rparen
readLineBreak readLineBreak
list <- ((lookAhead g_DSEMI >> return []) <|> readCompoundList) list <- (lookAhead readCaseSeparator >> return []) <|> readCompoundList
(g_DSEMI <|> lookAhead (readLineBreak >> g_Esac)) `attempting` do separator <- readCaseSeparator `attempting` do
pos <- getPosition pos <- getPosition
lookAhead g_Rparen lookAhead g_Rparen
parseProblemAt pos ErrorC 1074 parseProblemAt pos ErrorC 1074
"Did you forget the ;; after the previous case item?" "Did you forget the ;; after the previous case item?"
readLineBreak readLineBreak
return (pattern, list) return (separator, pattern, list)
readCaseSeparator = choice [
tryToken ";;&" (const ()) >> return CaseContinue,
tryToken ";&" (const ()) >> return CaseFallThrough,
g_DSEMI >> return CaseBreak,
lookAhead (readLineBreak >> g_Esac) >> return CaseBreak
]
prop_readFunctionDefinition = isOk readFunctionDefinition "foo() { command foo --lol \"$@\"; }" prop_readFunctionDefinition = isOk readFunctionDefinition "foo() { command foo --lol \"$@\"; }"
prop_readFunctionDefinition1 = isOk readFunctionDefinition "foo (){ command foo --lol \"$@\"; }" prop_readFunctionDefinition1 = isOk readFunctionDefinition "foo (){ command foo --lol \"$@\"; }"
@@ -1726,11 +1715,11 @@ prop_readFunctionDefinition8 = isOk readFunctionDefinition "foo() (ls)"
readFunctionDefinition = called "function" $ do readFunctionDefinition = called "function" $ do
functionSignature <- try readFunctionSignature functionSignature <- try readFunctionSignature
allspacing allspacing
(disregard (lookAhead $ oneOf "{(") <|> parseProblem ErrorC 1064 "Expected a { to open the function definition.") disregard (lookAhead $ oneOf "{(") <|> parseProblem ErrorC 1064 "Expected a { to open the function definition."
group <- readBraceGroup <|> readSubshell group <- readBraceGroup <|> readSubshell
return $ functionSignature group return $ functionSignature group
where where
readFunctionSignature = do readFunctionSignature =
readWithFunction <|> readWithoutFunction readWithFunction <|> readWithoutFunction
where where
readWithFunction = do readWithFunction = do
@@ -1770,10 +1759,10 @@ readCompoundCommand = do
cmd <- choice [ readBraceGroup, readArithmeticExpression, readSubshell, readCondition, readWhileClause, readUntilClause, readIfClause, readForClause, readSelectClause, readCaseClause, readFunctionDefinition] cmd <- choice [ readBraceGroup, readArithmeticExpression, readSubshell, readCondition, readWhileClause, readUntilClause, readIfClause, readForClause, readSelectClause, readCaseClause, readFunctionDefinition]
optional spacing optional spacing
redirs <- many readIoRedirect redirs <- many readIoRedirect
when (not . null $ redirs) $ optional $ do unless (null redirs) $ optional $ do
lookAhead $ try (spacing >> needsSeparator) lookAhead $ try (spacing >> needsSeparator)
parseProblem WarningC 1013 "Bash requires ; or \\n here, after redirecting nested compound commands." parseProblem WarningC 1013 "Bash requires ; or \\n here, after redirecting nested compound commands."
return $ T_Redirecting id redirs $ cmd return $ T_Redirecting id redirs cmd
where where
needsSeparator = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbrace ] needsSeparator = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbrace ]
@@ -1793,6 +1782,22 @@ readTimeSuffix = do
lookAhead $ char '-' lookAhead $ char '-'
readCmdWord readCmdWord
-- Fixme: this is a hack that doesn't handle let '++c' or let a\>b
readLetSuffix = many1 (readIoRedirect <|> try readLetExpression <|> readCmdWord)
where
readLetExpression = do
startPos <- getPosition
expression <- readStringForParser readCmdWord
subParse startPos readArithmeticContents expression
-- Get whatever a parser would parse as a string
readStringForParser parser = do
pos <- lookAhead (parser >> getPosition)
s <- readUntil pos
return s
where
readUntil endPos = anyChar `reluctantlyTill` (getPosition >>= guard . (== endPos))
prop_readAssignmentWord = isOk readAssignmentWord "a=42" prop_readAssignmentWord = isOk readAssignmentWord "a=42"
prop_readAssignmentWord2 = isOk readAssignmentWord "b=(1 2 3)" prop_readAssignmentWord2 = isOk readAssignmentWord "b=(1 2 3)"
prop_readAssignmentWord3 = isWarning readAssignmentWord "$b = 13" prop_readAssignmentWord3 = isWarning readAssignmentWord "$b = 13"
@@ -1802,7 +1807,8 @@ prop_readAssignmentWord6 = isWarning readAssignmentWord "b += (1 2 3)"
prop_readAssignmentWord7 = isOk readAssignmentWord "a[3$n'']=42" prop_readAssignmentWord7 = isOk readAssignmentWord "a[3$n'']=42"
prop_readAssignmentWord8 = isOk readAssignmentWord "a[4''$(cat foo)]=42" prop_readAssignmentWord8 = isOk readAssignmentWord "a[4''$(cat foo)]=42"
prop_readAssignmentWord9 = isOk readAssignmentWord "IFS= " prop_readAssignmentWord9 = isOk readAssignmentWord "IFS= "
prop_readAssignmentWord0 = isWarning readAssignmentWord "foo$n=42" prop_readAssignmentWord10= isWarning readAssignmentWord "foo$n=42"
prop_readAssignmentWord11= isOk readAssignmentWord "foo=([a]=b [c] [d]= [e f )"
readAssignmentWord = try $ do readAssignmentWord = try $ do
id <- getNextId id <- getNextId
pos <- getPosition pos <- getPosition
@@ -1853,9 +1859,24 @@ readArray = called "array assignment" $ do
id <- getNextId id <- getNextId
char '(' char '('
allspacing allspacing
words <- (readNormalWord `thenSkip` allspacing) `reluctantlyTill` (char ')') words <- readElement `reluctantlyTill` char ')'
char ')' char ')'
return $ T_Array id words return $ T_Array id words
where
readElement = (readIndexed <|> readRegular) `thenSkip` allspacing
readIndexed = do
id <- getNextId
index <- try $ do
x <- readArrayIndex
char '='
return x
value <- readNormalWord <|> nothing
return $ T_IndexedElement id index value
readRegular = readNormalWord
nothing = do
id <- getNextId
return $ T_Literal id ""
tryToken s t = try $ do tryToken s t = try $ do
id <- getNextId id <- getNextId
@@ -1876,14 +1897,14 @@ tryParseWordToken keyword t = try $ do
optional (do optional (do
try . lookAhead $ char '[' try . lookAhead $ char '['
parseProblem ErrorC 1069 "You need a space before the [.") parseProblem ErrorC 1069 "You need a space before the [.")
try $ lookAhead (keywordSeparator) try $ lookAhead keywordSeparator
when (str /= keyword) $ when (str /= keyword) $
parseProblem ErrorC 1081 $ parseProblem ErrorC 1081 $
"Scripts are case sensitive. Use '" ++ keyword ++ "', not '" ++ str ++ "'." "Scripts are case sensitive. Use '" ++ keyword ++ "', not '" ++ str ++ "'."
return $ t id return $ t id
anycaseString str = anycaseString =
mapM anycaseChar str mapM anycaseChar
where where
anycaseChar c = char (toLower c) <|> char (toUpper c) anycaseChar c = char (toLower c) <|> char (toUpper c)
@@ -1930,11 +1951,11 @@ g_Semi = do
tryToken ";" T_Semi tryToken ";" T_Semi
keywordSeparator = keywordSeparator =
eof <|> disregard whitespace <|> (disregard $ oneOf ";()[<>&|") eof <|> disregard whitespace <|> disregard (oneOf ";()[<>&|")
readKeyword = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbrace, g_Rparen, g_DSEMI ] readKeyword = choice [ g_Then, g_Else, g_Elif, g_Fi, g_Do, g_Done, g_Esac, g_Rbrace, g_Rparen, g_DSEMI ]
ifParse p t f = do ifParse p t f =
(lookAhead (try p) >> t) <|> f (lookAhead (try p) >> t) <|> f
readShebang = do readShebang = do
@@ -1953,24 +1974,24 @@ readScript = do
pos <- getPosition pos <- getPosition
optional $ do optional $ do
readUtf8Bom readUtf8Bom
parseProblem ErrorC 1082 $ parseProblem ErrorC 1082
"This file has a UTF-8 BOM. Remove it with: LC_CTYPE=C sed '1s/^...//' < yourscript ." "This file has a UTF-8 BOM. Remove it with: LC_CTYPE=C sed '1s/^...//' < yourscript ."
sb <- option "" readShebang sb <- option "" readShebang
verifyShell pos (getShell sb) verifyShell pos (getShell sb)
if (isValidShell $ getShell sb) /= Just False if isValidShell (getShell sb) /= Just False
then then
do { do {
allspacing; allspacing;
commands <- readTerm; commands <- readTerm;
eof <|> (parseProblem ErrorC 1070 "Parsing stopped here because of parsing errors."); eof <|> parseProblem ErrorC 1070 "Parsing stopped here because of parsing errors.";
return $ T_Script id sb commands; return $ T_Script id sb commands;
} <|> do { } <|> do {
parseProblem WarningC 1014 "Couldn't read any commands."; parseProblem WarningC 1014 "Couldn't read any commands.";
return $ T_Script id sb $ [T_EOF id]; return $ T_Script id sb [T_EOF id];
} }
else do else do
many anyChar many anyChar
return $ T_Script id sb $ [T_EOF id]; return $ T_Script id sb [T_EOF id];
where where
basename s = reverse . takeWhile (/= '/') . reverse $ s basename s = reverse . takeWhile (/= '/') . reverse $ s
@@ -2018,8 +2039,8 @@ readScript = do
rp p filename contents = Ms.runState (runParserT p initialState filename contents) ([], []) rp p filename contents = Ms.runState (runParserT p initialState filename contents) ([], [])
isWarning p s = (fst cs) && (not . null . snd $ cs) where cs = checkString p s isWarning p s = fst cs && (not . null . snd $ cs) where cs = checkString p s
isOk p s = (fst cs) && (null . snd $ cs) where cs = checkString p s isOk p s = fst cs && (null . snd $ cs) where cs = checkString p s
checkString parser string = checkString parser string =
case rp (parser >> eof >> getState) "-" string of case rp (parser >> eof >> getState) "-" string of
@@ -2043,7 +2064,7 @@ makeErrorFor parsecError =
getStringFromParsec errors = getStringFromParsec errors =
case map snd $ sortWith fst $ map f errors of case map snd $ sortWith fst $ map f errors of
r -> (intercalate " " $ take 1 $ nub r) ++ " Fix any mentioned problems and try again." r -> unwords (take 1 $ nub r) ++ " Fix any mentioned problems and try again."
where f err = where f err =
case err of case err of
UnExpect s -> (1, unexpected s) UnExpect s -> (1, unexpected s)
@@ -2052,15 +2073,15 @@ getStringFromParsec errors =
Message s -> (4, s ++ ".") Message s -> (4, s ++ ".")
wut "" = "eof" wut "" = "eof"
wut x = x wut x = x
unexpected s = "Unexpected " ++ (wut s) ++ "." unexpected s = "Unexpected " ++ wut s ++ "."
parseShell filename contents = do parseShell filename contents =
case rp (parseWithNotes readScript) filename contents of case rp (parseWithNotes readScript) filename contents of
(Right (script, map, notes), (parsenotes, _)) -> (Right (script, map, notes), (parsenotes, _)) ->
ParseResult (Just (script, map)) (nub $ sortNotes $ notes ++ parsenotes) ParseResult (Just (script, map)) (nub $ sortNotes $ notes ++ parsenotes)
(Left err, (p, context)) -> (Left err, (p, context)) ->
ParseResult Nothing ParseResult Nothing
(nub $ sortNotes $ p ++ (notesForContext context) ++ ([makeErrorFor err])) (nub $ sortNotes $ p ++ notesForContext context ++ [makeErrorFor err])
where where
isName (ContextName _ _) = True isName (ContextName _ _) = True
isName _ = False isName _ = False
@@ -2071,4 +2092,8 @@ parseShell filename contents = do
"The mentioned parser error was in this " ++ str ++ "." "The mentioned parser error was in this " ++ str ++ "."
lt x = trace (show x) x lt x = trace (show x) x
ltt t x = trace (show t) x ltt t = trace (show t)
return []
runTests = $quickCheckAll

View File

@@ -15,35 +15,20 @@
You should have received a copy of the GNU Affero General Public License You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. along with this program. If not, see <http://www.gnu.org/licenses/>.
-} -}
module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage) where {-# LANGUAGE TemplateHaskell #-}
module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where
import ShellCheck.Parser import ShellCheck.Parser hiding (runTests)
import ShellCheck.Analytics import ShellCheck.Analytics hiding (runTests)
import Data.Maybe import Data.Maybe
import Text.Parsec.Pos import Text.Parsec.Pos
import Data.List import Data.List
import Test.QuickCheck.All (quickCheckAll)
prop_findsParseIssue =
let comments = shellCheck "echo \"$12\"" [] in
(length comments) == 1 && (scCode $ head comments) == 1037
prop_commentDisablesParseIssue1 =
null $ shellCheck "#shellcheck disable=SC1037\necho \"$12\"" []
prop_commentDisablesParseIssue2 =
null $ shellCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\"" []
prop_findsAnalysisIssue =
let comments = shellCheck "echo $1" [] in
(length comments) == 1 && (scCode $ head comments) == 2086
prop_commentDisablesAnalysisIssue1 =
null $ shellCheck "#shellcheck disable=SC2086\necho $1" []
prop_commentDisablesAnalysisIssue2 =
null $ shellCheck "#shellcheck disable=SC2086\n#lol\necho $1" []
shellCheck :: String -> [AnalysisOption] -> [ShellCheckComment] shellCheck :: String -> [AnalysisOption] -> [ShellCheckComment]
shellCheck script options = shellCheck script options =
let (ParseResult result notes) = parseShell "-" script in let (ParseResult result notes) = parseShell "-" script in
let allNotes = notes ++ (concat $ maybeToList $ do let allNotes = notes ++ concat (maybeToList $ do
(tree, posMap) <- result (tree, posMap) <- result
let list = runAnalytics options tree let list = runAnalytics options tree
return $ map (noteToParseNote posMap) $ filterByAnnotation tree list return $ map (noteToParseNote posMap) $ filterByAnnotation tree list
@@ -65,3 +50,23 @@ severityToString s =
formatNote (ParseNote pos severity code text) = formatNote (ParseNote pos severity code text) =
ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text
prop_findsParseIssue =
let comments = shellCheck "echo \"$12\"" [] in
length comments == 1 && scCode (head comments) == 1037
prop_commentDisablesParseIssue1 =
null $ shellCheck "#shellcheck disable=SC1037\necho \"$12\"" []
prop_commentDisablesParseIssue2 =
null $ shellCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\"" []
prop_findsAnalysisIssue =
let comments = shellCheck "echo $1" [] in
length comments == 1 && scCode (head comments) == 2086
prop_commentDisablesAnalysisIssue1 =
null $ shellCheck "#shellcheck disable=SC2086\necho $1" []
prop_commentDisablesAnalysisIssue2 =
null $ shellCheck "#shellcheck disable=SC2086\n#lol\necho $1" []
return []
runTests = $quickCheckAll

View File

@@ -1,65 +0,0 @@
#!/usr/bin/env runhaskell
-- #!/usr/bin/env runhugs
-- $Id: quickcheck,v 1.4 2003/01/08 15:09:22 shae Exp $
-- This file defines a command
-- quickCheck <options> <files>
-- which invokes quickCheck on all properties defined in the files given as
-- arguments, by generating an input script for hugs and then invoking it.
-- quickCheck recognises the options
-- +names print the name of each property before checking it
-- -names do not print property names (the default)
-- +verbose displays each test case before running
-- -verbose do not displays each test case before running (the default)
-- Other options (beginning with + or -) are passed unchanged to hugs.
--
-- Change the first line of this file to the location of runhaskell or runhugs
-- on your system.
-- Make the file executable.
--
-- TODO:
-- someone on #haskell asked about supporting QC tests inside LaTeX, ex. \{begin} \{end}, how?
import System.Cmd
import System.Directory (findExecutable)
import System.Environment
import Data.List
import Data.Maybe (fromJust)
main :: IO ()
main = do as<-getArgs
sequence_ (map (process (filter isOption as))
(filter (not.isOption) as))
-- ugly hack for .lhs files, is there a better way?
unlit [] = []
unlit x = if (head x) == '>' then (tail x) else x
process opts file =
let (namesOpt,opts') = getOption "names" "-names" opts
(verboseOpt,opts'') = getOption "verbose" "-verbose" opts' in
do xs<-readFile file
let names = nub$ filter (\x -> (("> prop_" `isPrefixOf` x) || ("prop_" `isPrefixOf` x)))
(map (fst.head.lex.unlit) (lines xs))
if null names then
putStr (file++": no properties to check\n")
else do writeFile "hugsin"$
unlines ((":load "++file):
":m +Test.QuickCheck":
"let quackCheck p = quickCheckWith (stdArgs { maxSuccess = 1 }) p ":
[(if namesOpt=="+names" then
"putStr \""++p++": \" >> "
else "") ++
("quackCheck ")
++ p | p<-names])
-- To use ghci
ghci <- findExecutable "ghci"
system (fromJust ghci ++options opts''++" <hugsin")
return ()
isOption xs = head xs `elem` "-+"
options opts = unwords ["\""++opt++"\"" | opt<-opts]
getOption name def opts =
let opt = head [opt | opt<-opts++[def], isPrefixOf name (drop 1 opt)] in
(opt, filter (/=opt) opts)

View File

@@ -1,22 +0,0 @@
#!/bin/bash
# Todo: Find a way to make this not suck.
ulimit -t 60 # Sometimes GHC ends in a spin loop, and this is easier than debugging
[[ -e test/quackCheck.hs ]] || { echo "Are you running me from the wrong directory?"; exit 1; }
[[ $1 == -v ]] && pattern="" || pattern="FAIL"
find . -name '*.hs' -exec bash -c '
grep -v "^module " "$1" > quack.tmp.hs
./test/quackCheck.hs +names quack.tmp.hs
' -- {} \; 2>&1 | grep -i "$pattern"
result=$?
rm -f quack.tmp.hs hugsin
if [[ $result == 0 ]]
then
exit 1
else
exit 0
fi

16
test/shellcheck.hs Normal file
View File

@@ -0,0 +1,16 @@
module Main where
import Control.Monad
import System.Exit
import qualified ShellCheck.Simple
import qualified ShellCheck.Analytics
import qualified ShellCheck.Parser
main = do
putStrLn "Running ShellCheck tests..."
results <- sequence [ShellCheck.Simple.runTests,
ShellCheck.Analytics.runTests,
ShellCheck.Parser.runTests]
if and results then exitSuccess
else exitFailure