@@ -74,6 +74,11 @@ checksFor Sh = [
74
74
,checkTimeParameters
75
75
,checkForDecimals
76
76
]
77
+ checksFor Dash = [
78
+ checkBashisms
79
+ ,checkForDecimals
80
+ ,checkLocalScope
81
+ ]
77
82
checksFor Ksh = [
78
83
checkEchoSed
79
84
]
@@ -587,11 +592,20 @@ prop_checkBashisms28= verify checkBashisms "exec {n}>&2"
587
592
prop_checkBashisms29= verify checkBashisms " echo ${!var}"
588
593
prop_checkBashisms30= verify checkBashisms " printf -v '%s' \" $1\" "
589
594
prop_checkBashisms31= verify checkBashisms " printf '%q' \" $1\" "
590
- checkBashisms _ = bashism
591
- where
592
- errMsg id s = err id 2040 $ " In sh, " ++ s ++ " not supported, even when sh is actually bash."
593
- warnMsg id s = warn id 2039 $ " In POSIX sh, " ++ s ++ " not supported."
594
- bashism (T_ProcSub id _ _) = errMsg id " process substitution is"
595
+ prop_checkBashisms32= verifyNot checkBashisms " #!/bin/dash\n [ foo -nt bar ]"
596
+ prop_checkBashisms33= verify checkBashisms " #!/bin/sh\n echo -n foo"
597
+ prop_checkBashisms34= verifyNot checkBashisms " #!/bin/dash\n echo -n foo"
598
+ prop_checkBashisms35= verifyNot checkBashisms " #!/bin/dash\n local foo"
599
+ prop_checkBashisms36= verifyNot checkBashisms " #!/bin/dash\n read -p foo -r bar"
600
+ checkBashisms params = bashism
601
+ where
602
+ isDash = shellType params == Dash
603
+ warnMsg id s =
604
+ if isDash
605
+ then warn id 2169 $ " In dash, " ++ s ++ " not supported."
606
+ else warn id 2039 $ " In POSIX sh, " ++ s ++ " undefined."
607
+
608
+ bashism (T_ProcSub id _ _) = warnMsg id " process substitution is"
595
609
bashism (T_Extglob id _ _) = warnMsg id " extglob is"
596
610
bashism (T_DollarSingleQuoted id _) = warnMsg id " $'..' is"
597
611
bashism (T_DollarDoubleQuoted id _) = warnMsg id " $\" ..\" is"
@@ -603,8 +617,10 @@ checkBashisms _ = bashism
603
617
bashism (T_Condition id DoubleBracket _) = warnMsg id " [[ ]] is"
604
618
bashism (T_HereString id _) = warnMsg id " here-strings are"
605
619
bashism (TC_Binary id SingleBracket op _ _)
606
- | op `elem` [ " -nt" , " -ef" , " \\ <" , " \\ >" , " ==" ] =
607
- warnMsg id $ op ++ " is"
620
+ | op `elem` [ " -nt" , " -ef" , " \\ <" , " \\ >" ] =
621
+ unless isDash $ warnMsg id $ op ++ " is"
622
+ bashism (TC_Binary id SingleBracket " ==" _ _) =
623
+ warnMsg id " == in place of = is"
608
624
bashism (TC_Unary id _ " -a" _) =
609
625
warnMsg id " unary -a in place of -e is"
610
626
bashism (TA_Unary id op _)
@@ -646,8 +662,13 @@ checkBashisms _ = bashism
646
662
647
663
bashism t@ (T_SimpleCommand _ _ (cmd: arg: _))
648
664
| t `isCommand` " echo" && " -" `isPrefixOf` argString =
649
- unless (" --" `isPrefixOf` argString) $ -- echo "-------"
650
- warnMsg (getId arg) " echo flags are"
665
+ unless (" --" `isPrefixOf` argString) $ -- echo "-----"
666
+ if isDash
667
+ then
668
+ when (argString /= " -n" ) $
669
+ warnMsg (getId arg) " echo flags besides -n"
670
+ else
671
+ warnMsg (getId arg) " echo flags are"
651
672
where argString = concat $ oversimplify arg
652
673
bashism t@ (T_SimpleCommand _ _ (cmd: arg: _))
653
674
| t `isCommand` " exec" && " -" `isPrefixOf` concat (oversimplify arg) =
@@ -659,7 +680,8 @@ checkBashisms _ = bashism
659
680
let name = fromMaybe " " $ getCommandName t
660
681
flags = getLeadingFlags t
661
682
in do
662
- when (name `elem` bashCommands) $ warnMsg id $ " '" ++ name ++ " ' is"
683
+ when (name `elem` unsupportedCommands) $
684
+ warnMsg id $ " '" ++ name ++ " ' is"
663
685
potentially $ do
664
686
allowed <- Map. lookup name allowedFlags
665
687
(word, flag) <- listToMaybe $ filter (\ x -> snd x `notElem` allowed) flags
@@ -681,15 +703,14 @@ checkBashisms _ = bashism
681
703
guard $ " %q" `isInfixOf` literal
682
704
return $ warnMsg (getId format) " printf %q is"
683
705
where
684
- bashCommands = [
706
+ unsupportedCommands = [
685
707
" let" , " caller" , " builtin" , " complete" , " compgen" , " declare" , " dirs" , " disown" ,
686
- " enable" , " mapfile" , " readarray" , " pushd" , " popd" , " shopt" , " suspend" , " type " ,
687
- " typeset" , " local "
688
- ]
708
+ " enable" , " mapfile" , " readarray" , " pushd" , " popd" , " shopt" , " suspend" ,
709
+ " typeset"
710
+ ] ++ if not isDash then [ " local " , " type " ] else []
689
711
allowedFlags = Map. fromList [
690
- (" read" , [" r" ]),
712
+ (" read" , if isDash then [ " r " , " p " ] else [" r" ]),
691
713
(" ulimit" , [" f" ]),
692
- (" echo" , [] ),
693
714
(" printf" , [] ),
694
715
(" exec" , [] )
695
716
]
@@ -1124,9 +1145,8 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
1124
1145
isLtGt = flip elem [" <" , " \\ <" , " >" , " \\ >" ]
1125
1146
isLeGe = flip elem [" <=" , " \\ <=" , " >=" , " \\ >=" ]
1126
1147
1127
- supportsDecimals = (shellType params) == Ksh
1128
1148
checkDecimals hs =
1129
- when (isFraction hs && not supportsDecimals ) $
1149
+ when (isFraction hs && not (hasFloatingPoint params) ) $
1130
1150
err (getId hs) 2072 decimalError
1131
1151
decimalError = " Decimals are not supported. " ++
1132
1152
" Either use integers only, or use bc or awk to compare."
@@ -1334,7 +1354,8 @@ checkBraceExpansionVars _ (T_BraceExpansion id list) = mapM_ check list
1334
1354
checkBraceExpansionVars _ _ = return ()
1335
1355
1336
1356
prop_checkForDecimals = verify checkForDecimals " ((3.14*c))"
1337
- checkForDecimals _ t@ (TA_Expansion id _) = potentially $ do
1357
+ checkForDecimals params t@ (TA_Expansion id _) = potentially $ do
1358
+ guard $ not (hasFloatingPoint params)
1338
1359
str <- getLiteralString t
1339
1360
first <- str !!! 0
1340
1361
guard $ isDigit first && ' .' `elem` str
@@ -2132,6 +2153,7 @@ leadType shell parents t =
2132
2153
lastCreatesSubshell =
2133
2154
case shell of
2134
2155
Bash -> True
2156
+ Dash -> True
2135
2157
Sh -> True
2136
2158
Ksh -> False
2137
2159
@@ -2988,7 +3010,11 @@ checkFunctionDeclarations params
2988
3010
Ksh ->
2989
3011
when (hasKeyword && hasParens) $
2990
3012
err id 2111 " ksh does not allow 'function' keyword and '()' at the same time."
2991
- Sh -> do
3013
+ Dash -> forSh
3014
+ Sh -> forSh
3015
+
3016
+ where
3017
+ forSh = do
2992
3018
when (hasKeyword && hasParens) $
2993
3019
warn id 2112 " 'function' keyword is non-standard. Delete it."
2994
3020
when (hasKeyword && not hasParens) $
0 commit comments