fortran-vars-0.4.0: test/EvalSpec.hs

-- TODO 2023-05-16 raehik: only tests the deprecated short circuit eval, which
-- doesn't yet have a parallel in fortran-src eval

module EvalSpec where

import           Test.Hspec

import           Prelude                 hiding ( EQ )
import qualified Data.Map                      as M
import           Language.Fortran.AST           ( A0
                                                , BinaryOp(..)
                                                , Expression(..)
                                                , UnaryOp(..)
                                                , Value(..)
                                                )
import           Language.Fortran.Util.Position ( SrcSpan(..)
                                                , Position(..)
                                                )

import qualified Language.Fortran.Vars.Eval.Deprecated as Deprecated
import           Language.Fortran.Vars.Types
                                                ( ExpVal(..)
                                                , SymbolTable
                                                )

dSpan :: SrcSpan
dSpan = let p = Position 0 0 0 "" Nothing in SrcSpan p p

dSym :: SymbolTable
dSym = M.empty

true, false :: Expression A0
true = ExpValue () dSpan $ ValLogical True Nothing
false = ExpValue () dSpan $ ValLogical False Nothing

foobar :: Expression A0
foobar = ExpValue () dSpan $ ValVariable "foobar"

spec :: Spec
spec = describe "Boolean constant folding" $ do
  it "Can handle Not" $ do
    let ex1 = ExpUnary () dSpan Not true
        ex2 = ExpUnary () dSpan Not false
    Deprecated.evalWithShortcircuit dSym ex1 `shouldBe` Right (Logical False)
    Deprecated.evalWithShortcircuit dSym ex2 `shouldBe` Right (Logical True)
  it "Can handle simple Or" $ do
    let ex1 = ExpBinary () dSpan Or true true
        ex2 = ExpBinary () dSpan Or true false
        ex3 = ExpBinary () dSpan Or false true
        ex4 = ExpBinary () dSpan Or false false
    Deprecated.evalWithShortcircuit dSym ex1 `shouldBe` Right (Logical True)
    Deprecated.evalWithShortcircuit dSym ex2 `shouldBe` Right (Logical True)
    Deprecated.evalWithShortcircuit dSym ex3 `shouldBe` Right (Logical True)
    Deprecated.evalWithShortcircuit dSym ex4 `shouldBe` Right (Logical False)
  it "Can handle simple And" $ do
    let ex1 = ExpBinary () dSpan And true true
        ex2 = ExpBinary () dSpan And true false
        ex3 = ExpBinary () dSpan And false true
        ex4 = ExpBinary () dSpan And false false
    Deprecated.evalWithShortcircuit dSym ex1 `shouldBe` Right (Logical True)
    Deprecated.evalWithShortcircuit dSym ex2 `shouldBe` Right (Logical False)
    Deprecated.evalWithShortcircuit dSym ex3 `shouldBe` Right (Logical False)
    Deprecated.evalWithShortcircuit dSym ex4 `shouldBe` Right (Logical False)
  it "Can handle Or with variable" $ do
    let ex1 = ExpBinary () dSpan Or true foobar
        ex2 = ExpBinary () dSpan Or foobar true
    Deprecated.evalWithShortcircuit dSym ex1 `shouldBe` Right (Logical True)
    Deprecated.evalWithShortcircuit dSym ex2 `shouldBe` Right (Logical True)
  it "Can handle And with variable" $ do
    let ex1 = ExpBinary () dSpan And false foobar
        ex2 = ExpBinary () dSpan And foobar false
    Deprecated.evalWithShortcircuit dSym ex1 `shouldBe` Right (Logical False)
    Deprecated.evalWithShortcircuit dSym ex2 `shouldBe` Right (Logical False)
  it "Can handle more complicated trees" $ do
    -- (foobar .AND. .TRUE.) .AND.
    --    (foobar .AND. (.FALSE. .OR. (foobar .AND. .FALSE.)))
    let lhs = ExpBinary () dSpan And foobar true
        ex1 = ExpBinary () dSpan And foobar false
        ex2 = ExpBinary () dSpan Or false ex1
        rhs = ExpBinary () dSpan And foobar ex2
        ex  = ExpBinary () dSpan And lhs rhs
    Deprecated.evalWithShortcircuit dSym ex `shouldBe` Right (Logical False)
  it "Can handle .NOT. (foobar .AND. .FALSE.)" $ do
    let ex1 = ExpBinary () dSpan And foobar false
        ex  = ExpUnary () dSpan Not ex1
    Deprecated.evalWithShortcircuit dSym ex `shouldBe` Right (Logical True)
  it "Can handle conditions with non-logical logic" $ do
    -- .TRUE. .EQ. 1
    let vx = ExpValue () dSpan $ ValInteger "1" Nothing
        ex = ExpBinary () dSpan EQ true vx
    Deprecated.evalWithShortcircuit dSym ex `shouldBe` Right (Logical True)