content: {-# LANGUAGE OverloadedLists   #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes       #-}
  
  module Test.Machine.Evaluate.Errors (tests) where
  
  
  
  import Test.Tasty
  
  import Stg.Language
  import Stg.Machine.Types
  import Stg.Parser.QuasiQuoter
  
  import Test.Machine.Evaluate.TestTemplates.MachineState
  import Test.Orphans                                     ()
  
  
  
  tests :: TestTree
  tests = testGroup "Error conditions"
      [ updatableClosureWithArgs
      , returnIntWithEmptyReturnStack
      , updateClosureWithPrimitive
      , functionArgumentNotInScope
      , constructorArgumentNotInScope
      , primitiveArgumentNotInScope
      , algebraicReturnToPrimitiveAlts
      , primReturnToAlgAlts
      , loopEnterBlackHole
      , functionScrutinee
      , testGroup "Invalid operations"
          [ divisionByZero
          , moduloZero ]
      , badConArity
      ]
  
  updatableClosureWithArgs :: TestTree
  updatableClosureWithArgs = machineStateTest defSpec
      { testName = "Updatable closure with arguments"
      , source = Program (Binds
          [(Var "main",
              LambdaForm [] Update [Var "x"] (AppF (Var "x") []) )])
      , successPredicate = \state -> case stgInfo state of
          Info (StateError UpdatableClosureWithArgs) _ -> True
          _otherwise -> False }
  
  returnIntWithEmptyReturnStack :: TestTree
  returnIntWithEmptyReturnStack = machineStateTest defSpec
      { testName = "Closure with primitive body"
      , source = [stg| main = \ -> case 1# of v -> v |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError ReturnIntWithEmptyReturnStack) _ -> True
          _otherwise -> False }
  
  updateClosureWithPrimitive :: TestTree
  updateClosureWithPrimitive = machineStateTest defSpec
      { testName = "Closure update with primitive"
      , source = [stg| main = \ => case 1# of v -> v |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError UpdateClosureWithPrimitive) _ -> True
          _otherwise -> False }
  
  functionArgumentNotInScope :: TestTree
  functionArgumentNotInScope = machineStateTest defSpec
      { testName = "Function argument not in scope"
      , source = [stg| main = \ -> main x |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError VariablesNotInScope{}) _ -> True
          _otherwise -> False }
  
  constructorArgumentNotInScope :: TestTree
  constructorArgumentNotInScope = machineStateTest defSpec
      { testName = "Function argument not in scope"
      , source = [stg| main = \ -> Con x |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError VariablesNotInScope{}) _ -> True
          _otherwise -> False }
  
  primitiveArgumentNotInScope :: TestTree
  primitiveArgumentNotInScope = machineStateTest defSpec
      { testName = "Primitive function argument not in scope"
      , source = [stg| main = \ -> case +# x y of default -> Foo |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError VariablesNotInScope{}) _ -> True
          _otherwise -> False }
  
  algebraicReturnToPrimitiveAlts :: TestTree
  algebraicReturnToPrimitiveAlts = machineStateTest defSpec
      { testName = "Algebraic scrutinee with primitive alts"
      , source = [stg| main = \ -> case Con of 1# -> A; default -> B |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError AlgReturnToPrimAlts) _ -> True
          _otherwise -> False }
  
  primReturnToAlgAlts :: TestTree
  primReturnToAlgAlts = machineStateTest defSpec
      { testName = "Primitive scrutinee with algebraic alts"
      , source = [stg| main = \ -> case 1# of Con -> A; default -> B |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError PrimReturnToAlgAlts) _ -> True
          _otherwise -> False }
  
  loopEnterBlackHole :: TestTree
  loopEnterBlackHole = machineStateTest defSpec
      { testName = "Loop on entering black hole"
      , source = [stg| main = \ => main |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError EnterBlackhole) _ -> True
          _otherwise -> False }
  
  functionScrutinee :: TestTree
  functionScrutinee = machineStateTest defSpec
      { testName = "Function scrutinee"
      , failWithInfo = False
      , source = [stg|
          id = \x -> x;
          main = \ => case id of
              default -> Success
          |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError NonAlgPrimScrutinee) _ -> True
          _otherwise -> False }
  
  divisionByZero :: TestTree
  divisionByZero = machineStateTest defSpec
      { testName = "Division by zero"
      , failWithInfo = False
      , source = [stg|
          main = \ => case /# 1# 0# of
              default -> Failure
          |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError DivisionByZero) _ -> True
          _otherwise -> False }
  
  moduloZero :: TestTree
  moduloZero = machineStateTest defSpec
      { testName = "Modulo by zero"
      , failWithInfo = False
      , source = [stg|
          main = \ => case %# 1# 0# of
              default -> Failure
          |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError DivisionByZero) _ -> True
          _otherwise -> False }
  
  badConArity :: TestTree
  badConArity = machineStateTest defSpec
      { testName = "Bad constructor arity"
      , failWithInfo = False
      , source = [stg|
          x = \ -> Unit;
          y = \ -> Unit;
          main = \ => case Cons x y of
              Cons x -> Bad;
              default -> Baaad
          |]
      , successPredicate = \state -> case stgInfo state of
          Info (StateError BadConArity{}) _ -> True
          _otherwise -> False }
  