Add more let unit tests.

This commit is contained in:
Robbie Gleichman 2016-12-13 23:13:43 -08:00
parent aeb877ced7
commit d24642dfe8
3 changed files with 86 additions and 25 deletions

View File

@ -31,7 +31,7 @@ renderDrawings = mapM_ saveDrawing where
main :: IO () main :: IO ()
--main = print "Hello world" --main = print "Hello world"
main = do main = do
-- ING.prettyPrint singleApplyGraph -- ING.prettyPrint singleApplyGraph
renderDrawings drawingsAndNames renderDrawings drawingsAndNames
_ <- runTestTT allUnitTests _ <- runTestTT allUnitTests
pure () pure ()

View File

@ -7,14 +7,15 @@ import Test.HUnit
import qualified Data.Graph.Inductive.Graph as ING import qualified Data.Graph.Inductive.Graph as ING
import qualified Data.Graph.Inductive.PatriciaTree as FGR import qualified Data.Graph.Inductive.PatriciaTree as FGR
import Data.List(foldl', sort) import Data.List(foldl', sort, sortOn)
import Translate(stringToSyntaxGraph) import Translate(stringToSyntaxGraph)
import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..), Reference) import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..), Reference)
import Types(SgNamedNode, Edge(..), SyntaxNode(..), import Types(SgNamedNode, Edge(..), SyntaxNode(..),
IngSyntaxGraph, NodeName(..), LikeApplyFlavor(..), NameAndPort(..)) IngSyntaxGraph, NodeName(..), LikeApplyFlavor(..), NameAndPort(..))
import qualified GraphAlgorithms import qualified GraphAlgorithms
import Util(fromMaybeError) import Util(fromMaybeError, mapFst)
import GraphAlgorithms(collapseNodes)
-- Unit Test Helpers -- -- Unit Test Helpers --
@ -56,13 +57,17 @@ renameSource nameMap (str, ref) = (str, newRef) where
Left _ -> ref Left _ -> ref
Right namePort@(NameAndPort _ _) -> Right $ renameNamePort nameMap namePort Right namePort@(NameAndPort _ _) -> Right $ renameNamePort nameMap namePort
-- TODO May want to remove names for sub-nodes
removeNames :: SgNamedNode -> SyntaxNode
removeNames (_, syntaxNode) = syntaxNode
-- TODO Rename sinks and embedMap -- TODO Rename sinks and embedMap
-- TODO Add unit tests for renameGraph -- TODO Add unit tests for renameGraph
renameGraph :: SyntaxGraph -> SyntaxGraph renameGraph :: SyntaxGraph -> SyntaxGraph
renameGraph (SyntaxGraph nodes edges sinks sources embedMap) = renameGraph (SyntaxGraph nodes edges sinks sources embedMap) =
SyntaxGraph (sort renamedNodes) renamedEdges sinks renamedSources embedMap SyntaxGraph renamedNodes renamedEdges sinks renamedSources embedMap
where where
(renamedNodes, nameMap, _) = foldl' renameNode ([], [], 0) nodes (renamedNodes, nameMap, _) = foldl' renameNode ([], [], 0) $ sortOn removeNames nodes
renamedEdges = sort $ fmap (renameEdge nameMap) edges renamedEdges = sort $ fmap (renameEdge nameMap) edges
renamedSources = sort $ fmap (renameSource nameMap) sources renamedSources = sort $ fmap (renameSource nameMap) sources
@ -168,8 +173,71 @@ infixTests = TestList [
letTests = TestList [ letTests = TestList [
TestLabel "letTests1" $ assertEqualSyntaxGraphs [ TestLabel "letTests1" $ assertEqualSyntaxGraphs [
"y = f 1", "y = f 1",
"y = let x = 1 in f x" "y = let x = 1 in f x",
"y = let {b = a; a = 1} in f b"
] ]
,
assertEqualSyntaxGraphs [
"y = 2",
"y = let z = 2 in z",
"y = let {z = 2; z2 = z} in z2"
]
,
assertEqualSyntaxGraphs [
"y = f y",
"y = let x = f x in x"
]
,
assertEqualSyntaxGraphs [
"y = f 7 5",
"y = let {a = 7; b = f a 5} in b"
]
,
assertEqualSyntaxGraphs [
"y x = x",
"y x = let z = x in z"
]
,
assertEqualSyntaxGraphs [
"fibs = let {y = cons 0 (cons 1 (zipWith (+) y (tail y)))} in y",
"fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))"
]
,
assertEqualSyntaxGraphs [
"y x = y x",
"y = let {z = (\\x -> y x)} in z",
"y = let {z x = y x} in z "
]
,
assertEqualSyntaxGraphs [
"y = f 3 y",
"y = x where x = f 3 y",
"y = let x = f 3 y in x"
]
,
assertEqualSyntaxGraphs [
"y x = f x",
"y x1 = let {x2 = x1; x3 = x2; x4 = f x3} in x4"
]
,
-- TODO Fix this test. The second line has two apply icons instead of one.
-- See VisualTranslateTests/letTests
-- assertEqualSyntaxGraphs [
-- "y x1 = (f x1) x1",
-- "y x1 = let x2 = f x1 in x2 x1"
-- ]
assertEqualSyntaxGraphs [
"y x = 3",
"y x = let x = 3 in x"
]
-- TODO Fix test. Second line should use compose apply.
-- See VisualTranslateTests/letTests
-- assertEqualSyntaxGraphs [
-- "y = g $ f y",
-- "y = let {a = f b; b = g a} in b"
-- ]
] ]
-- Yes, the commas get their own line -- Yes, the commas get their own line

View File

@ -191,33 +191,22 @@ lambdaTests = [
letTests :: [String] letTests :: [String]
letTests = [ letTests = [
"y = let {z = (\\x -> y x)} in z", -- TODO fix. See UnitTests/letTests
"y = let {z x = y x} in z ", "y x = f x x",
"y = x where x = f 3 y",
"y x1 = let {x2 = x1; x3 = x2; x4 = f x3} in x4",
"y x1 = let x2 = f x1 in x2 x1", "y x1 = let x2 = f x1 in x2 x1",
"y x = let x = 3 in x",
-- TODO fix. See UnitTests/letTests
"y = g $ f y",
"y = let {a = f b; b = g a} in b",
"y = let {a= 1; x = let {a = 27; x = f a 2} in x} in x", "y = let {a= 1; x = let {a = 27; x = f a 2} in x} in x",
"y = let {a = b; b = a; d = f a} in d", "y = let {a = b; b = a; d = f a} in d",
"y = let {a = b; b = a} in a", "y = let {a = b; b = a} in a",
"y = let x = x in x", "y = let x = x in x"
-- TODO fix the lack of embedding.
"y = let {fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))} in fibs",
"fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))",
"y = let x = f x in x",
"y = f y",
"y = let {a = f b; b = g a} in b",
"y = let {a = 48; b = a + 3} in b",
"y = let {b = a; a = 84} in f b",
"y = let {x = 1} in f x",
"y = let z = 2 in z",
"y = let {z = 3; z2 = z} in z2",
"y x = let z = x in z"
] ]
operatorTests :: [String] operatorTests :: [String]
operatorTests = [ operatorTests = [
"y = 1 + 2",
"y = map (++ 1) 3" "y = map (++ 1) 3"
] ]
@ -226,12 +215,15 @@ otherTests = [
"y = f 1 'c' 2.3 \"foobar\"", "y = f 1 'c' 2.3 \"foobar\"",
"fact x = if (x == 0) then 1 else (x * fact (x - 1))", "fact x = if (x == 0) then 1 else (x * fact (x - 1))",
"fact x = if ((==) 0 x) then 1 else (x * fact ((-) x 1))", "fact x = if ((==) 0 x) then 1 else (x * fact ((-) x 1))",
"fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))",
"y x = if x then (if z then q else x) else w", "y x = if x then (if z then q else x) else w",
"y x1 x2 x3 = if f x1 then g x2 else h x3", "y x1 x2 x3 = if f x1 then g x2 else h x3",
"y x1 x2 x3 = if x1 then x2 else x3", "y x1 x2 x3 = if x1 then x2 else x3",
"y = if b then x else n", "y = if b then x else n",
"y2 = f x1 x2 x3 x4", "y2 = f x1 x2 x3 x4",
"y = x", "y = x",
"y x = y x",
"y = f 3 y",
"y = f x", "y = f x",
"y = f (g x)", "y = f (g x)",
"y = f (g x1 x2) x3", "y = f (g x1 x2) x3",
@ -279,6 +271,7 @@ translateStringToDrawing s = do
putStr "\n\n" putStr "\n\n"
-- printAction -- printAction
renderIngSyntaxGraph drawing renderIngSyntaxGraph drawing
-- renderIngSyntaxGraph fglGraph
visualTranslateTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double) visualTranslateTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double)
visualTranslateTests = do visualTranslateTests = do