From 4ca91adcbd26dfa5f102244f8170c5c74f5200db Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Mon, 8 Feb 2016 14:25:49 +0100 Subject: testsuite: Rework handling of output sanitization Previously un-cleaned artifacts were kept as reference output, making it difficult to tell what has changed and causing spurious changes in the version control history. Here we rework this, cleaning the output during acceptance. To accomplish this it was necessary to move to strict I/O to ensure the reference handle was closed before accept attempts to open the reference file. --- hypsrc-test/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'hypsrc-test') diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs index 0490be47..01cc5429 100644 --- a/hypsrc-test/Main.hs +++ b/hypsrc-test/Main.hs @@ -13,7 +13,8 @@ import Test.Haddock.Xhtml checkConfig :: CheckConfig Xml checkConfig = CheckConfig - { ccfgRead = \_ input -> strip <$> parseXml input + { ccfgRead = parseXml + , ccfgClean = \_ -> strip , ccfgDump = dumpXml , ccfgEqual = (==) } -- cgit v1.2.3 From 60b4f394bcd27a097f1a97d460cddc27ead59ba7 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Mon, 8 Feb 2016 15:09:21 +0100 Subject: test: Compare on dump For reasons I don't understand the Xml representations differ despite their textual representations being identical. --- html-test/Main.hs | 3 ++- hypsrc-test/Main.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'hypsrc-test') diff --git a/html-test/Main.hs b/html-test/Main.hs index 02a86d43..67dbeec6 100755 --- a/html-test/Main.hs +++ b/html-test/Main.hs @@ -2,6 +2,7 @@ import Data.Char +import Data.Function (on) import System.Environment import System.FilePath @@ -15,7 +16,7 @@ checkConfig = CheckConfig { ccfgRead = parseXml , ccfgClean = stripIfRequired , ccfgDump = dumpXml - , ccfgEqual = (==) + , ccfgEqual = (==) `on` dumpXml } diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs index 01cc5429..d3ab79a8 100644 --- a/hypsrc-test/Main.hs +++ b/hypsrc-test/Main.hs @@ -3,6 +3,7 @@ import Data.Char import Data.List +import Data.Function (on) import System.Environment import System.FilePath @@ -16,7 +17,7 @@ checkConfig = CheckConfig { ccfgRead = parseXml , ccfgClean = \_ -> strip , ccfgDump = dumpXml - , ccfgEqual = (==) + , ccfgEqual = (==) `on` dumpXml } where strip = stripAnchors' . stripLinks' . stripFooter -- cgit v1.2.3 From a427f597e081ce37a881e6612efeab7ef0bb0dac Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Mon, 8 Feb 2016 14:37:49 +0100 Subject: hypsrc-test: Accept test output And fix impredicative Polymorphism testcase. --- hypsrc-test/ref/src/Classes.html | 161 ++- hypsrc-test/ref/src/Constructors.html | 77 +- hypsrc-test/ref/src/Identifiers.html | 127 +- hypsrc-test/ref/src/Literals.html | 13 +- hypsrc-test/ref/src/Operators.html | 129 ++- hypsrc-test/ref/src/Polymorphism.html | 2036 +++++++++++++++++++++++++++++++++ hypsrc-test/ref/src/Records.html | 185 ++- hypsrc-test/ref/src/Types.html | 19 +- hypsrc-test/src/Polymorphism.hs | 8 +- 9 files changed, 2374 insertions(+), 381 deletions(-) create mode 100644 hypsrc-test/ref/src/Polymorphism.html (limited to 'hypsrc-test') diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html index 74a7a427..abff8877 100644 --- a/hypsrc-test/ref/src/Classes.html +++ b/hypsrc-test/ref/src/Classes.html @@ -1,4 +1,3 @@ - a barbar :: a bazbaz (a, a bar baz x (x, x [a bar baz a a quuxquux (a, a-> a quux (x, y [x, y norfnorf [a-> a norf norf [a quux p plughplugh :: p a a-> p b b-> p (a-> b (b-> a plughLeft aconst aRight aconst aLeft bconst bRight bconst b +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html index 86a482f6..e35ca0b1 100644 --- a/hypsrc-test/ref/src/Constructors.html +++ b/hypsrc-test/ref/src/Constructors.html @@ -1,4 +1,3 @@ - foo n* n foo, xs= xs, xsreverse xs x (f1_ n, f2 f3 x'+ n f1+ aux f3 aux fx f2 fx f3 x'$ x +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html index 7680b3ef..f52db4ab 100644 --- a/hypsrc-test/ref/src/Identifiers.html +++ b/hypsrc-test/ref/src/Identifiers.html @@ -1,4 +1,3 @@ - x y= x+ x y x* y+ y x y= y+ x x y- x+ y x y= x* y* y* y* x x x x x x x y z| x x| y y| z z(-x(-y(-z x y z x y z x y z +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Literals.html b/hypsrc-test/ref/src/Literals.html index a009a502..dfcefc97 100644 --- a/hypsrc-test/ref/src/Literals.html +++ b/hypsrc-test/ref/src/Literals.html @@ -1,4 +1,3 @@ - Num a=> aFractional a=> a[[a +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html index fe690db2..8ce0b9ce 100644 --- a/hypsrc-test/ref/src/Operators.html +++ b/hypsrc-test/ref/src/Operators.html @@ -1,4 +1,3 @@ - [a [a [a a b= a++ b++ a [a [a [a a b= b a [a [a [a) a= a) a_:b= a (a b[[a [a [a a b b) a[[a[[a[[a a b [a b (a b:: a-> b (c (a, b a b (a, b +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Polymorphism.html b/hypsrc-test/ref/src/Polymorphism.html new file mode 100644 index 00000000..602246e0 --- /dev/null +++ b/hypsrc-test/ref/src/Polymorphism.html @@ -0,0 +1,2036 @@ +

{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Polymorphism where
+
+
+foo :: a -> a -> a
+foo = undefined
+
+foo' :: forall a. a -> a -> a
+foo' = undefined
+
+bar :: a -> b -> (a, b)
+bar = undefined
+
+bar' :: forall a b. a -> b -> (a, b)
+bar' = undefined
+
+baz :: a -> (a -> [a -> a] -> b) -> b
+baz = undefined
+
+baz' :: forall a b. a -> (a -> [a -> a] -> b) -> b
+baz' = undefined
+
+quux :: a -> (forall a. a -> a) -> a
+quux x f = f x
+
+quux' :: forall a. a -> (forall a. a -> a) -> a
+quux' x f = f x
+
+
+num :: Num a => a -> a -> a
+num = undefined
+
+num' :: forall a. Num a => a -> a -> a
+num' = undefined
+
+eq :: (Eq a, Eq b) => [a] -> [b] -> (a, b)
+eq = undefined
+
+eq' :: forall a b. (Eq a, Eq b) => [a] -> [b] -> (a, b)
+eq' = undefined
+
+mon :: Monad m => (a -> m a) -> m a
+mon = undefined
+
+mon' :: forall m a. Monad m => (a -> m a) -> m a
+mon' = undefined
+
+
+norf :: a -> (forall a. Ord a => a -> a) -> a
+norf x f = x
+
+norf' :: forall a. a -> (forall a. Ord a => a -> a) -> a
+norf' x f = x
+
+
+plugh :: forall a. a -> a
+plugh x = x :: a
+
+thud :: forall a b. (a -> b) -> a -> (a, b)
+thud f x =
+    (x :: a, y) :: (a, b)
+  where
+    y = (f :: a -> b) x :: b
+

\ No newline at end of file diff --git a/hypsrc-test/ref/src/Records.html b/hypsrc-test/ref/src/Records.html index eb4e0fbb..7d23d114 100644 --- a/hypsrc-test/ref/src/Records.html +++ b/hypsrc-test/ref/src/Records.html @@ -1,4 +1,3 @@ - x y{ xx = x, yy = y{ xx = x, yy = y= x* x+ y* y{ x x, y y = y* y+ x* x p d= p{ xx = xx p+ d p d= p{ yy = yy p+ d x y p aux p (dx, dy (x, y aux= p{ xx = x+ dx, yy = y+ dy +> \ No newline at end of file diff --git a/hypsrc-test/ref/src/Types.html b/hypsrc-test/ref/src/Types.html index d59f61f8..a8be9e78 100644 --- a/hypsrc-test/ref/src/Types.html +++ b/hypsrc-test/ref/src/Types.html @@ -1,4 +1,3 @@ - a b a b +> \ No newline at end of file diff --git a/hypsrc-test/src/Polymorphism.hs b/hypsrc-test/src/Polymorphism.hs index a74ac492..3f0103bf 100644 --- a/hypsrc-test/src/Polymorphism.hs +++ b/hypsrc-test/src/Polymorphism.hs @@ -24,10 +24,10 @@ baz' :: forall a b. a -> (a -> [a -> a] -> b) -> b baz' = undefined quux :: a -> (forall a. a -> a) -> a -quux = undefined +quux x f = f x quux' :: forall a. a -> (forall a. a -> a) -> a -quux' = undefined +quux' x f = f x num :: Num a => a -> a -> a @@ -50,10 +50,10 @@ mon' = undefined norf :: a -> (forall a. Ord a => a -> a) -> a -norf = undefined +norf x f = x norf' :: forall a. a -> (forall a. Ord a => a -> a) -> a -norf' = undefined +norf' x f = x plugh :: forall a. a -> a -- cgit v1.2.3