mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Add more let unit tests.
This commit is contained in:
parent
aeb877ced7
commit
d24642dfe8
@ -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 ()
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user