1-----------------------------------------------------------------------------
2-- |
3-- Module    : TestSuite.CodeGeneration.CgTests
4-- Copyright : (c) Levent Erkok
5-- License   : BSD3
6-- Maintainer: erkokl@gmail.com
7-- Stability : experimental
8--
9-- Test suite for code-generation features
10-----------------------------------------------------------------------------
11
12{-# LANGUAGE ScopedTypeVariables #-}
13
14{-# OPTIONS_GHC -Wall -Werror #-}
15
16module TestSuite.CodeGeneration.CgTests(tests) where
17
18import Data.SBV.Internals
19
20import Utils.SBVTestFramework
21
22-- Test suite
23tests :: TestTree
24tests = testGroup "CodeGeneration.CgTests" [
25   goldenVsStringShow "selChecked"   $ genSelect True  "selChecked"
26 , goldenVsStringShow "selUnchecked" $ genSelect False "selUnChecked"
27 , goldenVsStringShow "codeGen1"       foo
28 ]
29 where thd (_, _, r) = r
30
31       genSelect b n = thd <$> compileToC' n (do
32                         cgSetDriverValues [65]
33                         cgPerformRTCs b
34                         let sel :: SWord8 -> SWord8
35                             sel x = select [1, x+2] 3 x
36                         x <- cgInput "x"
37                         cgReturn $ sel x)
38       foo = thd <$> compileToC' "foo" (do
39                        cgSetDriverValues $ repeat 0
40                        (x::SInt16)    <- cgInput "x"
41                        (ys::[SInt64]) <- cgInputArr 45 "xArr"
42                        cgOutput "z" (5 :: SWord16)
43                        cgOutputArr "zArr" (replicate 7 (x+1))
44                        cgOutputArr "yArr" ys
45                        cgReturn (x*2))
46