mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 02:40:28 +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 = print "Hello world"
|
||||
main = do
|
||||
-- ING.prettyPrint singleApplyGraph
|
||||
-- ING.prettyPrint singleApplyGraph
|
||||
renderDrawings drawingsAndNames
|
||||
_ <- runTestTT allUnitTests
|
||||
pure ()
|
||||
|
@ -7,14 +7,15 @@ import Test.HUnit
|
||||
import qualified Data.Graph.Inductive.Graph as ING
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
|
||||
import Data.List(foldl', sort)
|
||||
import Data.List(foldl', sort, sortOn)
|
||||
|
||||
import Translate(stringToSyntaxGraph)
|
||||
import TranslateCore(syntaxGraphToFglGraph, SyntaxGraph(..), Reference)
|
||||
import Types(SgNamedNode, Edge(..), SyntaxNode(..),
|
||||
IngSyntaxGraph, NodeName(..), LikeApplyFlavor(..), NameAndPort(..))
|
||||
import qualified GraphAlgorithms
|
||||
import Util(fromMaybeError)
|
||||
import Util(fromMaybeError, mapFst)
|
||||
import GraphAlgorithms(collapseNodes)
|
||||
|
||||
-- Unit Test Helpers --
|
||||
|
||||
@ -56,13 +57,17 @@ renameSource nameMap (str, ref) = (str, newRef) where
|
||||
Left _ -> ref
|
||||
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 Add unit tests for renameGraph
|
||||
renameGraph :: SyntaxGraph -> SyntaxGraph
|
||||
renameGraph (SyntaxGraph nodes edges sinks sources embedMap) =
|
||||
SyntaxGraph (sort renamedNodes) renamedEdges sinks renamedSources embedMap
|
||||
SyntaxGraph renamedNodes renamedEdges sinks renamedSources embedMap
|
||||
where
|
||||
(renamedNodes, nameMap, _) = foldl' renameNode ([], [], 0) nodes
|
||||
(renamedNodes, nameMap, _) = foldl' renameNode ([], [], 0) $ sortOn removeNames nodes
|
||||
renamedEdges = sort $ fmap (renameEdge nameMap) edges
|
||||
renamedSources = sort $ fmap (renameSource nameMap) sources
|
||||
|
||||
@ -168,8 +173,71 @@ infixTests = TestList [
|
||||
letTests = TestList [
|
||||
TestLabel "letTests1" $ assertEqualSyntaxGraphs [
|
||||
"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
|
||||
|
@ -191,33 +191,22 @@ lambdaTests = [
|
||||
|
||||
letTests :: [String]
|
||||
letTests = [
|
||||
"y = let {z = (\\x -> y x)} in z",
|
||||
"y = let {z x = y x} in z ",
|
||||
"y = x where x = f 3 y",
|
||||
"y x1 = let {x2 = x1; x3 = x2; x4 = f x3} in x4",
|
||||
-- TODO fix. See UnitTests/letTests
|
||||
"y x = f x x",
|
||||
"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 = b; b = a; d = f a} in d",
|
||||
"y = let {a = b; b = a} in a",
|
||||
"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"
|
||||
"y = let x = x in x"
|
||||
]
|
||||
|
||||
operatorTests :: [String]
|
||||
operatorTests = [
|
||||
"y = 1 + 2",
|
||||
"y = map (++ 1) 3"
|
||||
]
|
||||
|
||||
@ -226,12 +215,15 @@ otherTests = [
|
||||
"y = f 1 'c' 2.3 \"foobar\"",
|
||||
"fact x = if (x == 0) 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 x1 x2 x3 = if f x1 then g x2 else h x3",
|
||||
"y x1 x2 x3 = if x1 then x2 else x3",
|
||||
"y = if b then x else n",
|
||||
"y2 = f x1 x2 x3 x4",
|
||||
"y = x",
|
||||
"y x = y x",
|
||||
"y = f 3 y",
|
||||
"y = f x",
|
||||
"y = f (g x)",
|
||||
"y = f (g x1 x2) x3",
|
||||
@ -279,6 +271,7 @@ translateStringToDrawing s = do
|
||||
putStr "\n\n"
|
||||
-- printAction
|
||||
renderIngSyntaxGraph drawing
|
||||
-- renderIngSyntaxGraph fglGraph
|
||||
|
||||
visualTranslateTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double)
|
||||
visualTranslateTests = do
|
||||
|
Loading…
Reference in New Issue
Block a user