module CompilerSpec where
import Compiler
import Compiler.TestUtils
import Compiler.Types
import Config
import CoreTypes
import Data.Either (isLeft, isRight)
import Data.List (isPrefixOf)
import Language.Gen ()
import Language.Types
import PreCompiler
import System.FilePath.Posix (takeExtension, (<.>), (</>))
import Test.Hspec
import Test.QuickCheck
import TestUtils
import Types
import Utils
spec :: Spec
spec = parallel $ do
singleCompileDecSpec
precompileSpec
hopTests
exactTests
compilerBlackBoxTests
precompileSpec :: Spec
precompileSpec = describe "pre-compilation" $ do
cleanContentSpec
cleanContentSpec :: Spec
cleanContentSpec = do
let validFp = arbitrary `suchThat` cleanBy cleanFilePath
describe "cleanCard" $ do
it "doesn't report any card with valid content and a valid name" $ do
forAll (arbitrary `suchThat` cleanBy cleanCardName) $ \cn ->
forAll (arbitrary `suchThat` cleanBy cleanDeclaration) $ \cc ->
Card cn cc `shouldSatisfy` cleanBy cleanCard
describe "cleanCardName" $ do
pend
it "doesn't report an emty card name" $ do
"" `shouldSatisfy` cleanBy cleanCardName
it "reports card names with newlines" $ do
forAll (arbitrary `suchThat` containsNewlineCharacter) $ \s ->
s `shouldNotSatisfy` cleanBy cleanCardName
describe "cleanDeclaration" $ do
describe "Deploy" $ do
it "doesn't report Deploy declarations with valid filepaths" $ do
forAll validFp $ \src ->
forAll validFp $ \dst ->
forAll arbitrary $ \kind ->
Deploy src dst kind `shouldSatisfy` cleanBy cleanDeclaration
it "reports Deploy declarations with an invalid source" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanFilePath)) $ \src ->
forAll validFp $ \dst ->
forAll arbitrary $ \kind ->
Deploy src dst kind `shouldNotSatisfy` cleanBy cleanDeclaration
it "reports Deploy declarations with an invalid destination" $ do
forAll validFp $ \src ->
forAll (arbitrary `suchThat` (not . cleanBy cleanFilePath)) $ \dst ->
forAll arbitrary $ \kind ->
Deploy src dst kind `shouldNotSatisfy` cleanBy cleanDeclaration
pend
describe "SparkOff" $ do
it "reports SparkOff declarations with an invalid card reference" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanCardReference)) $ \cr ->
SparkOff cr `shouldNotSatisfy` cleanBy cleanDeclaration
it "doesn't report SparkOff declarations with a valid card reference" $ do
forAll (arbitrary `suchThat` cleanBy cleanCardReference) $ \cr ->
SparkOff cr `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "IntoDir" $ do
it "reports IntoDir declarations with an invalid filepath" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanFilePath)) $ \fp ->
IntoDir fp `shouldNotSatisfy` cleanBy cleanDeclaration
it "doesn't report IntoDir declarations with a valid filepath" $ do
forAll (arbitrary `suchThat` cleanBy cleanFilePath) $ \fp ->
IntoDir fp `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "OutofDir" $ do
it "reports OutofDir declarations with an invalid filepath" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanFilePath)) $ \fp ->
OutofDir fp `shouldNotSatisfy` cleanBy cleanDeclaration
it "doesn't report OutofDir declarations with a valid filepath" $ do
forAll (arbitrary `suchThat` cleanBy cleanFilePath) $ \fp ->
OutofDir fp `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "DeployKindOverride" $ do
it "doesn't report any deployment kind override declarations" $ do
forAll arbitrary $ \kind ->
DeployKindOverride kind `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "Alternatives" $ do
it "reports alternatives declarations with as much as a single invalid filepath" $ do
forAll (arbitrary `suchThat` (any $ not . cleanBy cleanFilePath)) $ \fs ->
Alternatives fs `shouldNotSatisfy` cleanBy cleanDeclaration
it "doesn't report alternatives declarations with valid filepaths" $ do
forAll (arbitrary `suchThat` (all $ cleanBy cleanFilePath)) $ \fs ->
Alternatives fs `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "Block" $ do
it "reports block declarations with as much as a single invalid declaration inside" $ do
forAll (arbitrary `suchThat` (any $ not . cleanBy cleanDeclaration)) $ \ds ->
Block ds `shouldNotSatisfy` cleanBy cleanDeclaration
it "doesn't report any block declarations with valid declarations inside" $ do
forAll (arbitrary `suchThat` (all $ cleanBy cleanDeclaration)) $ \ds ->
Block ds `shouldSatisfy` cleanBy cleanDeclaration
pend
describe "cleanCardReference" $ do
it "works the same as cleanCardName separately" $ do
forAll arbitrary $ \cnr ->
cleanBy cleanCardNameReference cnr === cleanBy cleanCardReference (CardName cnr)
it "works the same as cleanCardFile separately" $ do
forAll arbitrary $ \cfr ->
cleanBy cleanCardFileReference cfr === cleanBy cleanCardReference (CardFile cfr)
pend
describe "cleanCardNameReference" $ do
it "reports card name references with an invalid card name" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanCardName)) $ \cn ->
CardNameReference cn `shouldNotSatisfy` cleanBy cleanCardNameReference
it "doesn't report card name references with a valid card name" $ do
forAll (arbitrary `suchThat` cleanBy cleanCardName) $ \cn ->
CardNameReference cn `shouldSatisfy` cleanBy cleanCardNameReference
pend
describe "cleanCardFileReference" $ do
it "reports card file references with an invalid filepath" $ do
forAll (arbitrary `suchThat` (not . cleanBy cleanFilePath)) $ \fp ->
forAll arbitrary $ \cn ->
CardFileReference fp cn `shouldNotSatisfy` cleanBy cleanCardFileReference
it "reports card file references with an invalid card name" $ do
forAll arbitrary $ \fp ->
forAll (arbitrary `suchThat` (not . cleanBy cleanCardNameReference)) $ \cn ->
CardFileReference fp (Just cn) `shouldNotSatisfy` cleanBy cleanCardFileReference
it "doesn't report card file references with a valid card name reference and valid filepath" $ do
forAll (arbitrary `suchThat` cleanBy cleanFilePath) $ \fp ->
forAll (arbitrary `suchThat` cleanBy cleanCardNameReference) $ \cn ->
CardFileReference fp (Just cn) `shouldSatisfy` cleanBy cleanCardFileReference
pend
describe "cleanFilePath" $ do
it "reports empty an filepath" $ do
filePathDirty []
let nonNull = arbitrary `suchThat` (not . null)
it "reports filepaths with newlines" $ do
forAll (nonNull `suchThat` containsNewlineCharacter) filePathDirty
let withoutNewlines = nonNull `suchThat` (not . containsNewlineCharacter)
it "reports filepaths with multiple consequtive slashes" $ do
once $ forAll (withoutNewlines `suchThat` containsMultipleConsequtiveSlashes) filePathDirty
let c = filePathClean
it "doesn't report these valid filepaths" $ do
c "noextension"
c ".bashrc"
c "file.txt"
c "Some file with spaces.doc"
c "some/relative/filepath.file"
-- TODO(syd) Use the default config to generate this!
defaultCompilerState :: CompilerState
defaultCompilerState = CompilerState
{ state_deployment_kind_override = Nothing
, state_into = ""
, state_outof_prefix = []
}
singleCompileDecSpec :: Spec
singleCompileDecSpec = describe "compileDec" $ do
let s = defaultCompilerState
let c = defaultConfig
let sc = singleShouldCompileTo c s
let nonNull = arbitrary `suchThat` (not . null)
let validFilePath = nonNull `suchThat` (not . containsNewlineCharacter)
let easyFilePath = validFilePath `suchThat` (not . isPrefixOf ".")
let validFp = arbitrary `suchThat` cleanBy cleanFilePath
describe "Deploy" $ do
it "uses the exact right text in source and destination when given valid filepaths without a leading dot" $ do
forAll easyFilePath $ \from ->
forAll easyFilePath $ \to ->
sc (Deploy from to Nothing) (Put [from] to LinkDeployment)
it "handles filepaths with a leading dot correctly" $ do
pending
it "figures out the correct paths in these cases with default config and initial state" $ do
let d = (Deploy "from" "to" $ Just LinkDeployment)
sc d (Put ["from"] "to" LinkDeployment)
it "uses the alternates correctly" $ do
pending
it "uses the into's correctly" $ do
pending
it "uses the outof's correctly" $ do
pending
pend
describe "SparkOff" $ do
it "adds a single card file reference to the list of cards to spark later" $ do
forAll validFilePath $ \f ->
let cr = CardFile $ CardFileReference f Nothing
d = SparkOff cr
in compileSingleDec d s c `shouldBe` Right (s, ([], [cr]))
it "adds any card reference to the list" $ do
pending
pend
let shouldState = shouldResultInState c s
describe "IntoDir" $ do
it "adds the given directory to the into state" $ do
forAll validFp $ \fp ->
shouldState (IntoDir fp) $ s { state_into = fp }
it "compounds with the input state" $ do
pendingWith "Change the input state to an explicit list first"
pend
describe "OutofDir" $ do
it "adds the given directory to the outof state" $ do
forAll validFp $ \fp ->
shouldState (OutofDir fp) $ s { state_outof_prefix = [Literal fp] }
pend
describe "DeployKindOverride" $ do
it "modifies the internal deployment kind override" $ do
property $ \kind -> shouldState (DeployKindOverride kind) $ s { state_deployment_kind_override = Just kind }
pend
describe "Block" $ do
it "uses a separate scope for its sub-compilation" $ do
property $ \ds -> shouldState (Block ds) s
pend
describe "Alternatives" $ do
it "adds an alternatives prefix to the outof prefix in the compiler state" $ do
forAll (listOf validFilePath) $ \fps ->
shouldState (Alternatives fps) $ s { state_outof_prefix = [Alts fps] }
pend
runDefaultSparker :: Sparker a -> IO (Either SparkError a)
runDefaultSparker func = flip runReaderT defaultConfig $ runExceptT $ func
hopTests :: Spec
hopTests = do
describe "hop test" $ do
let dir = "test_resources/hop_test"
let root = dir </> "root.sus"
let hop1 = dir </> "hop1dir" </> "hop1.sus"
let hop2 = dir </> "hop1dir" </> "hop2dir" </> "hop2.sus"
let hop3 = dir </> "hop1dir" </> "hop2dir" </> "hop3dir" </> "hop3.sus"
it "compiles hop3 correctly" $ do
r <- runDefaultSparker $ compileJob $ CardFileReference hop3 Nothing
r `shouldBe` Right [Put ["z/delta"] "d/three" LinkDeployment]
it "compiles hop2 correctly" $ do
r <- runDefaultSparker $ compileJob $ CardFileReference hop2 Nothing
r `shouldBe` Right
[ Put ["y/gamma"] "c/two" LinkDeployment
, Put ["hop3dir/z/delta"] "d/three" LinkDeployment
]
it "compiles hop1 correctly" $ do
r <- runDefaultSparker $ compileJob $ CardFileReference hop1 Nothing
r `shouldBe` Right
[ Put ["x/beta"] "b/one" LinkDeployment
, Put ["hop2dir/y/gamma"] "c/two" LinkDeployment
, Put ["hop2dir/hop3dir/z/delta"] "d/three" LinkDeployment
]
it "compiles root correctly" $ do
r <- runDefaultSparker $ compileJob $ CardFileReference root Nothing
r `shouldBe` Right
[ Put ["u/alpha"] "a/zero" LinkDeployment
, Put ["hop1dir/x/beta"] "b/one" LinkDeployment
, Put ["hop1dir/hop2dir/y/gamma"] "c/two" LinkDeployment
, Put ["hop1dir/hop2dir/hop3dir/z/delta"] "d/three" LinkDeployment
]
exactTests :: Spec
exactTests = do
let runJsonSparker :: Sparker a -> IO (Either SparkError a)
runJsonSparker func = flip runReaderT (defaultConfig {conf_compile_format = FormatJson}) $ runExceptT func
describe "exact tests" $ do
let dir = "test_resources/exact_compile_test_src"
forFileInDirss [dir] $ \fp ->
if takeExtension fp == ".res"
then return ()
else do
it fp $ do
let orig = fp
let result = fp <.> "res"
ads <- runDefaultSparker $ compileJob $ CardFileReference orig Nothing
eds <- runJsonSparker $ inputCompiled result
ads `shouldBe` eds
compilerBlackBoxTests :: Spec
compilerBlackBoxTests = do
let tr = "test_resources"
describe "Correct succesful compile examples" $ do
let dirs = map (tr </>) ["shouldCompile", "hop_test"]
forFileInDirss dirs $ \f -> do
it f $ do
r <- runDefaultSparker $ compileJob $ CardFileReference f Nothing
r `shouldSatisfy` isRight
describe "Correct unsuccesfull compile examples" $ do
let dirs = map (tr </>) ["shouldNotParse", "shouldNotCompile"]
forFileInDirss dirs $ \f -> do
it f $ do
r <- runDefaultSparker $ compileJob $ CardFileReference f Nothing
r `shouldSatisfy` isLeft