Newer
Older
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
import System.Directory
import System.FilePath
import Test.Hspec
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import Test.Hspec.Glitter
import qualified Language.C as C
import qualified Text.PrettyPrint as P
import qualified Language.C.System.GCC as C
import ReduceC
import System.Process.Typed
spec :: Spec
spec = do
specSmallCases
specLargeCases
specLargeCases :: Spec
specLargeCases = do
cases <- runIO (listDirectory "test/cases/large")
let expected = "test" </> "expected" </> dropExtensions cname
onGlitter (expected </> "main.c") (`render` c) do
it "should be valid" . foldMap $ \cf -> do
validate cf
it "should be parsed equally" . foldMap $ \cf -> do
C.parseCFilePre cf >>= \case
Left err -> fail (show err)
Right c' -> c' $> () `shouldBe` c $> ()
onGlitter (expected </> "extract.c") (\fp -> render fp (IRTree.extract (defaultReduceC c))) do
pure ()
0 -> pure ()
n -> do
let idx = fromString (replicate n '1')
writeFile (expected </> "reduction" </> "r" <> idx <.> "c") ""
rec (n - 1)
listDirectory a >>= mapM_ \i -> do
let idx = fromString (drop 1 (dropExtension i))
render (expected </> "reduction" </> i) (fst $ IRTree.probe (defaultReduceC c) idx)
-- renderWithChoices
-- (expected </> "reduction" </> i)
-- (IRTree.probe (defaultReduceC c) idx)
when (takeExtension a == ".c") do
validate a
specSmallCases :: Spec
specSmallCases = do
cases <- runIO (listDirectory "test/cases/small")
forM_ cases \cname -> do
let cfrom = "test/cases/small" </> cname
describe cfrom do
c <- runIO $ parse cfrom
it "should be valid" . foldMap $ \cf -> do
validate cf
it "should be parsed equally" . foldMap $ \cf -> do
C.parseCFilePre cf >>= \case
Left err -> fail (show err)
Right c' -> c' $> () `shouldBe` c $> ()
describe "reduction" do
it "should extract itself" do
_ <- tryIOError (removeDirectoryRecursive a)
createDirectoryIfMissing True a
validate :: FilePath -> IO ()
validate fp = do
ExitFailure _ ->
expectationFailure $
"could not validate "
<> show fp
<> "\n"
ExitSuccess -> pure ()
render :: FilePath -> C.CTranslUnit -> IO ()
render cto c = do
createDirectoryIfMissing True (takeDirectory cto)
writeFile cto (P.render (C.pretty c) <> "\n")
renderWithChoices :: FilePath -> (C.CTranslUnit, [(Bool, (String, C.Position))]) -> IO ()
renderWithChoices file (c, a) = do
createDirectoryIfMissing True (takeDirectory file)
writeFile
file
( ( unlines
. map
( \(choice, (reason, pos)) ->
"// " <> bool "0" "1" choice <> " " <> reason <> " at " <> show pos
)
$ a
)
<> "\n"
)