From 9f1f00cdd1e3116117196c2e1c532a5cc2672008 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 4 Apr 2015 16:26:28 -0700 Subject: [PATCH] Switch from regex-compat to regex-tdfa --- ShellCheck.cabal | 7 ++-- ShellCheck/AST.hs | 12 ++++--- ShellCheck/Analytics.hs | 55 ++++++++++++------------------- ShellCheck/Regex.hs | 71 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 103 insertions(+), 42 deletions(-) create mode 100644 ShellCheck/Regex.hs diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 0f4e875..9b521fb 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -43,7 +43,7 @@ library json, mtl, parsec, - regex-compat, + regex-tdfa, QuickCheck >= 2.7.4 exposed-modules: ShellCheck.Analytics @@ -51,6 +51,7 @@ library ShellCheck.Data ShellCheck.Options ShellCheck.Parser + ShellCheck.Regex ShellCheck.Simple other-modules: Paths_ShellCheck @@ -64,7 +65,7 @@ executable shellcheck json, mtl, parsec, - regex-compat, + regex-tdfa, transformers, QuickCheck >= 2.7.4 main-is: shellcheck.hs @@ -79,7 +80,7 @@ test-suite test-shellcheck json, mtl, parsec, - regex-compat, + regex-tdfa, transformers, QuickCheck >= 2.7.4 main-is: test/shellcheck.hs diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 09e37f3..89b7f28 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -19,7 +19,7 @@ module ShellCheck.AST where import Control.Monad import Control.Monad.Identity -import qualified Text.Regex as Re +import qualified ShellCheck.Regex as Re data Id = Id Int deriving (Show, Eq, Ord) @@ -128,11 +128,13 @@ data Token = data Annotation = DisableComment Integer deriving (Show, Eq) data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq) --- I apologize for nothing! -lolHax s = Re.subRegex (Re.mkRegex "(Id [0-9]+)") (show s) "(Id 0)" -instance Eq Token where - (==) a b = lolHax a == lolHax b +-- This is an abomination. +tokenEquals :: Token -> Token -> Bool +tokenEquals a b = kludge a == kludge b + where kludge s = Re.subRegex (Re.mkRegex "\\(Id [0-9]+\\)") (show s) "(Id 0)" +instance Eq Token where + (==) = tokenEquals analyze :: Monad m => (Token -> m ()) -> (Token -> m ()) -> (Token -> Token) -> Token -> m Token analyze f g i = diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index d1d82cd..7ff841b 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -33,7 +33,7 @@ import ShellCheck.AST import ShellCheck.Options import ShellCheck.Data import ShellCheck.Parser hiding (runTests) -import Text.Regex +import ShellCheck.Regex import qualified Data.Map as Map import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) @@ -240,12 +240,6 @@ isVariableName _ = False potentially = fromMaybe (return ()) -matchAll re = unfoldr f - where - f str = do - (_, match, rest, _) <- matchRegexAll re str - return (match, rest) - willSplit x = case x of T_DollarBraced {} -> True @@ -280,20 +274,9 @@ getSuspiciousRegexWildcard str = suspicious = mkRegex "([A-Za-z1-9])\\*" contra = mkRegex "[^a-zA-Z1-9]\\*|[][^$+\\\\]" -matches string regex = isJust $ matchRegex regex string - headOrDefault _ (a:_) = a headOrDefault def _ = def -getAllMatches :: Regex -> String -> [[String]] -getAllMatches regex str = fromJust $ f str - where - f str = do - (_, _, rest, groups) <- matchRegexAll regex str - more <- f rest - return $ groups : more - `mappend` return [] - isConstant token = case token of T_NormalWord _ l -> all isConstant l @@ -413,14 +396,19 @@ checkEchoSed _ (T_Pipeline id _ [a, b]) = ["sed", "-e", v] -> checkIn v _ -> return () where - sedRe = mkRegex "^s(.)(.*)\\1(.*)\\1g?$" + -- This should have used backreferences, but TDFA doesn't support them + sedRe = mkRegex "^s(.)([^\n]*)g?$" + isSimpleSed s = fromMaybe False $ do + [first,rest] <- matchRegex sedRe s + let delimiters = filter (== (first !! 0)) rest + guard $ length delimiters == 2 + return True + acmd = deadSimple a bcmd = deadSimple b checkIn s = - case matchRegex sedRe s of - Just _ -> style id 2001 - "See if you can use ${variable//search/replace} instead." - _ -> return () + when (isSimpleSed s) $ + style id 2001 "See if you can use ${variable//search/replace} instead." checkEchoSed _ _ = return () prop_checkPipedAssignment1 = verify checkPipedAssignment "A=ls | grep foo" @@ -2017,15 +2005,15 @@ data StackData = -- (Base expression, specific position, var name, assigned values) | Assignment (Token, Token, String, DataType) | Reference (Token, Token, String) - deriving (Show, Eq) + deriving (Show) data DataType = DataString DataSource | DataArray DataSource - deriving (Show, Eq) + deriving (Show) data DataSource = SourceFrom [Token] | SourceExternal | SourceDeclaration - deriving (Show, Eq) + deriving (Show) -data VariableState = Dead Token String | Alive deriving (Show, Eq) +data VariableState = Dead Token String | Alive deriving (Show) dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultType) $ SourceFrom [v] @@ -2220,10 +2208,11 @@ getBracedReference s = fromMaybe s $ getSpecial _ = fail "empty" getIndexReferences s = fromMaybe [] $ do - (_, index, _, _) <- matchRegexAll re s - return $ matchAll variableNameRegex index + match <- matchRegex re s + index <- match !!! 0 + return $ matchAllStrings variableNameRegex index where - re = mkRegex "\\[.*\\]" + re = mkRegex "(\\[.*\\])" getReferencedVariables t = case t of @@ -2263,7 +2252,7 @@ getReferencedVariables t = prop_getVariablesFromLiteral1 = getVariablesFromLiteral "$foo${bar//a/b}$BAZ" == ["foo", "bar", "BAZ"] getVariablesFromLiteral string = - map (!! 0) $ getAllMatches variableRegex string + map (!! 0) $ matchAllSubgroups variableRegex string where variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)" @@ -3107,9 +3096,7 @@ checkMultipleAppends params t = mapM_ checkList $ getCommandSequences t where checkList list = - mapM_ checkGroup groups - where - groups = groupWith (liftM fst) $ map getTarget list + mapM_ checkGroup (groupWith (liftM fst) $ map getTarget list) checkGroup (f:_:_:_) | isJust f = style (snd $ fromJust f) 2129 "Consider using { cmd1; cmd2; } >> file instead of individual redirects." diff --git a/ShellCheck/Regex.hs b/ShellCheck/Regex.hs new file mode 100644 index 0000000..4d3ccfb --- /dev/null +++ b/ShellCheck/Regex.hs @@ -0,0 +1,71 @@ +{- + This file is part of ShellCheck. + http://www.vidarholen.net/contents/shellcheck + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +-} +{-# LANGUAGE FlexibleContexts #-} + +-- Basically Text.Regex based on regex-tdfa instead of the buggy regex-posix. +module ShellCheck.Regex where + +import Data.List +import Data.Maybe +import Control.Monad +import Text.Regex.TDFA + +-- Precompile the regex +mkRegex :: String -> Regex +mkRegex str = + let make :: RegexMaker Regex CompOption ExecOption String => String -> Regex + make = makeRegex + in + make str + +-- Does the regex match? +matches :: String -> Regex -> Bool +matches = flip match + +-- Get all subgroups of the first match +matchRegex :: Regex -> String -> Maybe [String] +matchRegex re str = do + (_, _, _, groups) <- matchM re str :: Maybe (String,String,String,[String]) + return groups + +-- Get all full matches +matchAllStrings :: Regex -> String -> [String] +matchAllStrings re = unfoldr f + where + f :: String -> Maybe (String, String) + f str = do + (_, match, rest, _) <- matchM re str :: Maybe (String, String, String, [String]) + return (match, rest) + +-- Get all subgroups from all matches +matchAllSubgroups :: Regex -> String -> [[String]] +matchAllSubgroups re = unfoldr f + where + f :: String -> Maybe ([String], String) + f str = do + (_, _, rest, groups) <- matchM re str :: Maybe (String, String, String, [String]) + return (groups, rest) + +-- Replace regex in input with string +subRegex :: Regex -> String -> String -> String +subRegex re input replacement = f input + where + f str = fromMaybe str $ do + (before, match, after) <- matchM re str :: Maybe (String, String, String) + when (null match) $ error ("Internal error: substituted empty in " ++ str) + return $ before ++ replacement ++ f after