diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,9 @@ +# v1.3.6 (UNRELEASED) + +* The `defined` function can now test variables +* Fixed the `delete_at` function, added new tests, TBC +* Fixed the `ensure_resource` function, so that its second argument can take an array. + # v1.3.5.1 (2017/02/02) * Version bumps for megaparsec & servant diff --git a/Facter.hs b/Facter.hs --- a/Facter.hs +++ b/Facter.hs @@ -110,14 +110,16 @@ | otherwise = takeWhile (/= '.') lrelease osfam | distid == "Ubuntu" = "Debian" | otherwise = distid - return [ ("lsbdistid" , distid) - , ("operatingsystem" , distid) - , ("lsbdistrelease" , lrelease) - , ("operatingsystemrelease" , lrelease) - , ("lsbmajdistrelease" , maj) - , ("osfamily" , osfam) - , ("lsbdistcodename" , getval "DISTRIB_CODENAME") - , ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION") + return [ ("lsbdistid" , distid) + , ("operatingsystem" , distid) + , ("lsbdistrelease" , lrelease) + , ("operatingsystemrelease" , lrelease) + , ("operatingsystemmajrelease" , lrelease) + , ("lsbmajdistrelease" , maj) + , ("lsbminordistrelease" , "") + , ("osfamily" , osfam) + , ("lsbdistcodename" , getval "DISTRIB_CODENAME") + , ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION") ] factMountPoints :: IO [(String, String)] diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -911,6 +911,7 @@ checkStrict "The use of the 'ensure_resource' function is a code smell." "The 'ensure_resource' function is not allowed in strict mode." ensureResource' t params title +ensureResource [t, PArray arr, params] = concat <$> mapM (\r -> ensureResource [t, r, params]) (V.toList arr) ensureResource [t,title] = ensureResource [t,title,PHash mempty] ensureResource [_, PString _, PHash _] = throwPosError "ensureResource(): The first argument must be a string." ensureResource [PString _, _, PHash _] = throwPosError "ensureResource(): The second argument must be a string." diff --git a/Puppet/Interpreter/Resolve.hs b/Puppet/Interpreter/Resolve.hs --- a/Puppet/Interpreter/Resolve.hs +++ b/Puppet/Interpreter/Resolve.hs @@ -61,7 +61,7 @@ import qualified Data.Text.Encoding as T import Data.Tuple.Strict as S import qualified Data.Vector as V -import Data.Version (parseVersion) +import Data.Version (parseVersion, Version(..)) import Text.ParserCombinators.ReadP (readP_to_S) import qualified Text.PrettyPrint.ANSI.Leijen as PP import Text.Regex.PCRE.ByteString.Utils @@ -263,7 +263,7 @@ checkStrict ("Look up for an hash with the unknown key '" <> ttext ridx <> "' for" <+> pretty (PHash h)) ("Can't find index '" <> ttext ridx <> "' in" <+> pretty (PHash h)) - return "undef" + return PUndef PArray ar -> do ridx <- resolveExpression idx i <- case ridx ^? _Integer of @@ -421,15 +421,24 @@ checkStrict "The use of the 'defined' function is a code smell." "The 'defined' function is not allowed in strict mode." t <- resolvePValueString ut - -- case 1, netsted thingie - nestedStuff <- use nestedDeclarations - if has (ix (TopDefine, t)) nestedStuff || has (ix (TopClass, t)) nestedStuff - then return (PBoolean True) - else do -- case 2, loadeded class - lc <- use loadedClasses - if has (ix t) lc + if (not (T.null t) && T.head t == '$') -- variable test + then do + scps <- use scopes + scp <- getScopeName + return $ PBoolean $ case getVariable scps scp (T.tail t) of + Left _ -> False + Right _ -> True + else do -- resource test + -- case 1, nested thingie + nestedStuff <- use nestedDeclarations + if has (ix (TopDefine, t)) nestedStuff || has (ix (TopClass, t)) nestedStuff then return (PBoolean True) - else fmap PBoolean (isNativeType t) + else do -- case 2, loaded class + lc <- use loadedClasses + if has (ix t) lc + then return (PBoolean True) + else fmap PBoolean (isNativeType t) + resolveFunction' "defined" x = throwPosError ("defined(): expects a single resource reference, type or class name, and not" <+> pretty x) resolveFunction' "fail" x = throwPosError ("fail:" <+> pretty x) resolveFunction' "inline_template" [] = throwPosError "inline_template(): Expects at least one argument" @@ -497,14 +506,15 @@ a <- resolvePValueString pa b <- resolvePValueString pb let parser x = case filter (null . Prelude.snd) (readP_to_S parseVersion (T.unpack x)) of - ( (v, _) : _ ) -> return v - _ -> throwPosError ("Could not parse this string as a version:" <+> ttext x) - va <- parser a - vb <- parser b + ( (v, _) : _ ) -> v + _ -> Version [] [] -- fallback :( + va = parser a + vb = parser b return $ PString $ case compare va vb of EQ -> "0" LT -> "-1" GT -> "1" + resolveFunction' "versioncmp" _ = throwPosError "versioncmp(): Expects two arguments" -- some custom functions resolveFunction' "pdbresourcequery" [q] = pdbresourcequery q Nothing diff --git a/Puppet/Stdlib.hs b/Puppet/Stdlib.hs --- a/Puppet/Stdlib.hs +++ b/Puppet/Stdlib.hs @@ -55,8 +55,8 @@ -- dos2unix , ("downcase", stringArrayFunction T.toLower) , singleArgument "empty" _empty - -- ensure_packages - -- ensure_resource + -- ensure_packages (in main interpreter module) + -- ensure_resource (in main interpreter module) , singleArgument "flatten" flatten -- floor -- fqdn_rand_string @@ -264,7 +264,7 @@ lr = V.length r s1 = V.slice 0 n r s2 = V.slice (n+1) (lr - n - 1) r - in if V.length r >= n + in if V.length r <= n then throwPosError ("delete_at(): Out of bounds access detected, tried to remove index" <+> pretty z <+> "wheras the array only has" <+> string (show lr) <+> "elements") else return (PArray (s1 <> s2)) _ -> throwPosError ("delete_at(): The second argument must be an integer, not" <+> pretty z) diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet -version: 1.3.5.1 +version: 1.3.6 synopsis: Tools to parse and evaluate the Puppet DSL. description: This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/ @@ -179,10 +179,12 @@ Function.SizeSpec Function.MergeSpec Function.EachSpec + Function.DeleteAtSpec Function.AssertPrivateSpec Function.JoinKeysToValuesSpec InterpreterSpec Interpreter.CollectorSpec + Interpreter.IfSpec Helpers main-is: Spec.hs diff --git a/tests/Function/DeleteAtSpec.hs b/tests/Function/DeleteAtSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Function/DeleteAtSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedLists #-} +module Function.DeleteAtSpec (spec, main) where + +import Test.Hspec + +import Data.Monoid + +import Puppet.Interpreter.Pure +import Puppet.Interpreter.Types + +import Helpers + +main :: IO () +main = hspec spec + +spec :: Spec +spec = withStdlibFunction "delete_at" $ \deleteAtFunc -> do + let evalArgs' = dummyEval . deleteAtFunc + narray = PArray . fmap PNumber + check a b res = case evalArgs' [narray a, PNumber b] of + Left rr -> expectationFailure (show rr) + Right res' -> res' `shouldBe` narray res + checkError args ins = case evalArgs' args of + Left rr -> show rr `shouldContain` ins + Right r -> expectationFailure ("Should have errored, received this instead: " <> show r) + it "should error with invalid arguments" $ do + checkError [] "expects 2 arguments" + checkError [PNumber 1] "expects 2 arguments" + checkError ["foo", "bar"] "expects its first argument to be an array" + checkError [ narray [0,1,2], PNumber 3 ] "Out of bounds access" + it "should work otherwise" $ do + check [0,1,2] 1 [0,2] + it "should work for negative positions" $ do + pending + check [0,1,2] (-1) [0,1] + check [0,1,2] (-4) [0,1,2] diff --git a/tests/Interpreter/IfSpec.hs b/tests/Interpreter/IfSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Interpreter/IfSpec.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedLists #-} +-- | Directly ported from puppet specs +module Interpreter.IfSpec (spec) where + +import Test.Hspec + +import Control.Lens +import Control.Monad.Except +import Data.Text (Text) +import qualified Data.Text as T + +import Helpers +import Puppet.Interpreter.Types + +{- +shouldReturn :: [Text] -> [PValue] -> Expectation +shouldReturn content expectedMessages = do + cat <- case runExcept (getCatalog (T.unlines content)) of + Left rr -> fail rr + Right x -> return x + _foo cat +-} + +shouldFail :: [Text] -> Expectation +shouldFail content = let cat :: Either String FinalCatalog + cat = runExcept (getCatalog (T.unlines content)) + in cat `shouldSatisfy` has _Left + +shouldNotFail :: [Text] -> Expectation +shouldNotFail content = let cat :: Either String FinalCatalog + cat = runExcept (getCatalog (T.unlines content)) + in cat `shouldSatisfy` has _Right + +spec :: Spec +spec = do + it "doesn't enter false conditions" $ shouldNotFail + [ "if (false) { fail ':(' }" ] + it "enters true conditions" $ shouldFail + [ "if (true) { fail ':(' }" ] + it "not (unknown variable) is true" $ shouldFail + [ "if (!$::unknown123) { fail ':(' }" ] diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -8,6 +8,8 @@ import qualified Function.EachSpec import qualified Function.AssertPrivateSpec import qualified Function.JoinKeysToValuesSpec +import qualified Function.DeleteAtSpec +import qualified Interpreter.IfSpec main :: IO () main = hspec spec @@ -18,6 +20,7 @@ describe "Collector" InterpreterSpec.collectorSpec describe "Class include" InterpreterSpec.classIncludeSpec describe "Collector (puppet tests)" Interpreter.CollectorSpec.spec + describe "If" Interpreter.IfSpec.spec describe "Puppet functions" $ do describe "The shellquote function" Function.ShellquoteSpec.spec describe "The each function" Function.EachSpec.spec @@ -26,3 +29,4 @@ describe "The join_keys_to_values function" Function.JoinKeysToValuesSpec.spec describe "The merge function" Function.MergeSpec.spec describe "The size function" Function.SizeSpec.spec + describe "The delete_at function" Function.DeleteAtSpec.spec