Skip to content
Snippets Groups Projects
Commit 9a263465 authored by chrg's avatar chrg
Browse files

Semi-working version

parent 9e2c99b7
No related branches found
No related tags found
No related merge requests found
0 remove statement at ("test/cases/while-loops.c": line 4)
0 remove statement at ("test/cases/while-loops.c": line 3)
1 inline variable i at ("test/cases/while-loops.c": line 2)
// 1 inline variable i at ("test/cases/small/while-loops.c": line 2)
// 0 remove statement at ("test/cases/small/while-loops.c": line 3)
// 0 replace by zero at ("test/cases/small/while-loops.c": line 3)
// 0 reduce to left at ("test/cases/small/while-loops.c": line 3)
// 0 reduce to right at ("test/cases/small/while-loops.c": line 3)
int main()
{
while (0 < 10)
{
}
}
// 1 inline variable i at ("test/cases/small/while-loops.c": line 2)
// 0 remove statement at ("test/cases/small/while-loops.c": line 3)
// 0 replace by zero at ("test/cases/small/while-loops.c": line 3)
// 0 reduce to left at ("test/cases/small/while-loops.c": line 3)
// 1 reduce to right at ("test/cases/small/while-loops.c": line 3)
int main()
{
while (10)
{
}
}
// 1 inline variable i at ("test/cases/small/while-loops.c": line 2)
// 0 remove statement at ("test/cases/small/while-loops.c": line 3)
// 0 replace by zero at ("test/cases/small/while-loops.c": line 3)
// 1 reduce to left at ("test/cases/small/while-loops.c": line 3)
int main()
{
while (0)
{
}
}
// 1 inline variable i at ("test/cases/small/while-loops.c": line 2)
// 0 remove statement at ("test/cases/small/while-loops.c": line 3)
// 1 replace by zero at ("test/cases/small/while-loops.c": line 3)
int main() int main()
{ {
while (0 < 10) while (0)
{ {
} }
} }
1 remove statement at ("test/cases/while-loops.c": line 4)
0 remove statement at ("test/cases/while-loops.c": line 3)
1 inline variable i at ("test/cases/while-loops.c": line 2)
// 1 inline variable i at ("test/cases/small/while-loops.c": line 2)
// 1 remove statement at ("test/cases/small/while-loops.c": line 3)
int main() int main()
{ {
} }
1 remove statement at ("test/cases/while-loops.c": line 3)
1 inline variable i at ("test/cases/while-loops.c": line 2)
...@@ -17,10 +17,12 @@ import Test.Hspec.Glitter ...@@ -17,10 +17,12 @@ import Test.Hspec.Glitter
import qualified Language.C as C import qualified Language.C as C
import qualified Text.PrettyPrint as P import qualified Text.PrettyPrint as P
import qualified Control.Monad.IRTree as IRTree
import Control.Monad.RTree (extract, iinputs, probe) import Control.Monad.RTree (extract, iinputs, probe)
import Data.Bool import Data.Bool
import Data.Functor import Data.Functor
import Data.RPath import Data.RPath
import Data.String
import qualified Language.C.System.GCC as C import qualified Language.C.System.GCC as C
import ReduceC import ReduceC
import System.Directory.Internal.Prelude (tryIOError) import System.Directory.Internal.Prelude (tryIOError)
...@@ -28,10 +30,15 @@ import System.Process.Typed ...@@ -28,10 +30,15 @@ import System.Process.Typed
spec :: Spec spec :: Spec
spec = do spec = do
cases <- runIO (listDirectory "test/cases") specSmallCases
specLargeCases
specLargeCases :: Spec
specLargeCases = do
cases <- runIO (listDirectory "test/cases/large")
forM_ cases \cname -> do forM_ cases \cname -> do
let cfrom = "test/cases" </> cname let cfrom = "test/cases/large" </> cname
describe cfrom do describe cfrom do
c <- runIO $ parse cfrom c <- runIO $ parse cfrom
...@@ -48,24 +55,55 @@ spec = do ...@@ -48,24 +55,55 @@ spec = do
describe "reduction" do describe "reduction" do
it "should extract itself" do it "should extract itself" do
fmap ($> ()) (extract $ defaultReduceC c) `shouldBe` Just (c $> ()) IRTree.extract (defaultReduceC c) $> () `shouldBe` c $> ()
onGlitterWith
(expected </> "reduction/")
( \a () -> do
createDirectoryIfMissing True a
listDirectory a >>= mapM_ \i -> do
let idx = fromString (drop 1 (dropExtension i))
renderWithChoices
(expected </> "reduction" </> i)
(probe (defaultReduceC c) idx)
)
do
it "should validate all reductions" . mapM_ $ \a -> do
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
let expected = "test/expected" </> dropExtensions cname
onGlitterWith (expected </> "main.c") (\fp () -> render fp 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 $> ()
describe "reduction" do
it "should extract itself" do
extract (defaultReduceC c) $> () `shouldBe` c $> ()
onGlitterWith onGlitterWith
(expected </> "reduction/") (expected </> "reduction/")
( \a () -> do ( \a () -> do
_ <- tryIOError (removeDirectoryRecursive a) _ <- tryIOError (removeDirectoryRecursive a)
createDirectoryIfMissing True a createDirectoryIfMissing True a
forM_ (iinputs (defaultReduceC c)) \(i, c') -> do forM_ (iinputs (defaultReduceC c)) \(i, _) -> do
let rfile = expected </> "reduction" </> "r" <> debugShow i <.> "c" let rfile = expected </> "reduction" </> "r" <> debugShow i <.> "c"
maybe (writeFile rfile "") (render rfile) c' renderWithChoices rfile (probe (defaultReduceC c) i)
let cofile = expected </> "reduction" </> "r" <> debugShow i <.> "choices"
writeFile
cofile
( unlines
. map (\(choice, (reason, pos)) -> bool "0" "1" choice <> " " <> reason <> " at " <> show pos)
. snd
$ probe (defaultReduceC c) i
)
) )
do do
it "should validate all reductions" . mapM_ $ \a -> do it "should validate all reductions" . mapM_ $ \a -> do
...@@ -89,6 +127,24 @@ render cto c = do ...@@ -89,6 +127,24 @@ render cto c = do
createDirectoryIfMissing True (takeDirectory cto) createDirectoryIfMissing True (takeDirectory cto)
writeFile cto (P.render (C.pretty c) <> "\n") 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
)
. reverse
$ a
)
<> "\n"
<> P.render (C.pretty c)
<> "\n"
)
parse :: FilePath -> IO C.CTranslUnit parse :: FilePath -> IO C.CTranslUnit
parse cfrom = do parse cfrom = do
cf <- C.parseCFile (C.newGCC "clang") Nothing [] cfrom cf <- C.parseCFile (C.newGCC "clang") Nothing [] cfrom
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment