diff --git a/test/AllTests.hs b/test/AllTests.hs index 5c1a820..8900b6e 100644 --- a/test/AllTests.hs +++ b/test/AllTests.hs @@ -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 () diff --git a/test/UnitTests.hs b/test/UnitTests.hs index c2c1220..3b739ab 100644 --- a/test/UnitTests.hs +++ b/test/UnitTests.hs @@ -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 diff --git a/test/VisualTranslateTests.hs b/test/VisualTranslateTests.hs index 4e4759c..0b85b12 100644 --- a/test/VisualTranslateTests.hs +++ b/test/VisualTranslateTests.hs @@ -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