summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorhdgarrood <>2019-07-05 19:53:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-07-05 19:53:00 (GMT)
commit47e475db976f0dd4837c1e911fc55c9f7242db65 (patch)
tree4ceaf76b55d63035771f4fa1d84feb4ead7bd94f /tests
parent63881df15dcdd909729b6c594568196b53ae89bb (diff)
version 0.13.20.13.2
Diffstat (limited to 'tests')
-rw-r--r--tests/TestBundle.hs2
-rw-r--r--tests/TestCst.hs35
-rw-r--r--tests/purs/failing/3689.purs6
-rw-r--r--tests/purs/layout/AdoIn.purs6
-rw-r--r--tests/purs/warning/CustomWarning4.purs2
-rw-r--r--tests/support/bower.json2
6 files changed, 34 insertions, 19 deletions
diff --git a/tests/TestBundle.hs b/tests/TestBundle.hs
index cbdcf68..ab209d5 100644
--- a/tests/TestBundle.hs
+++ b/tests/TestBundle.hs
@@ -74,7 +74,7 @@ assertBundles supportModules supportExterns supportForeigns inputFiles outputFil
js <- liftIO $ readUTF8File filename
mid <- guessModuleIdentifier filename
length js `seq` return (mid, Just filename, js)
- bundleSM input entryModule (Just $ "Main") "PS" (Just entryPoint)
+ bundleSM input entryModule (Just $ "Main") "PS" (Just entryPoint) Nothing
case bundled of
Right (_, js) -> do
writeUTF8File entryPoint js
diff --git a/tests/TestCst.hs b/tests/TestCst.hs
index abaddc0..b05bbee 100644
--- a/tests/TestCst.hs
+++ b/tests/TestCst.hs
@@ -67,15 +67,18 @@ litTests = testGroup "Literals"
, testProperty "Raw String (round trip)" $ roundTripTok . unRawString
]
-readTok :: Text -> Gen SourceToken
-readTok t = case CST.lex t of
+readTok' :: String -> Text -> Gen SourceToken
+readTok' failMsg t = case CST.lex t of
Right tok : _ ->
pure tok
Left (_, err) : _ ->
- fail $ "Failed to parse: " <> CST.prettyPrintError err
+ fail $ failMsg <> ": " <> CST.prettyPrintError err
[] ->
fail "Empty token stream"
+readTok :: Text -> Gen SourceToken
+readTok = readTok' "Failed to parse"
+
checkTok
:: (Text -> a -> Gen Bool)
-> (Token -> Maybe a)
@@ -91,7 +94,7 @@ roundTripTok :: Text -> Gen Bool
roundTripTok t = do
tok <- readTok t
let t' = CST.printTokens [tok]
- tok' <- readTok t'
+ tok' <- readTok' "Failed to re-parse" t'
pure $ tok == tok'
checkReadNum :: (Eq a, Read a) => Text -> a -> Gen Bool
@@ -168,23 +171,23 @@ genHex = PSSourceHex <$> do
genChar :: Gen PSSourceChar
genChar = PSSourceChar <$> do
- ch <- (toEnum :: Int -> Char) <$> resize 0xFFFF arbitrarySizedNatural
- ch' <- case ch of
- '\'' -> discard
- '\\' -> genCharEscape
- c -> pure $ Text.singleton c
- pure $ "'" <> ch' <> "'"
+ ch <- resize 0xFFFF arbitrarySizedNatural >>= (genStringChar '\'' . toEnum)
+ pure $ "'" <> ch <> "'"
genString :: Gen PSSourceString
genString = PSSourceString <$> do
- chs <- listOf $ arbitraryUnicodeChar >>= \case
- '"' -> discard
- '\n' -> discard
- '\r' -> discard
- '\\' -> genCharEscape
- c -> pure $ Text.singleton c
+ chs <- listOf $ arbitraryUnicodeChar >>= genStringChar '"'
pure $ "\"" <> Text.concat chs <> "\""
+genStringChar :: Char -> Char -> Gen Text
+genStringChar delimiter ch = frequency
+ [ (1, genCharEscape)
+ , (10, if ch `elem` [delimiter, '\n', '\r', '\\']
+ then discard
+ else pure $ Text.singleton ch
+ )
+ ]
+
genRawString :: Gen PSSourceRawString
genRawString = PSSourceRawString <$> do
chs <- listOf $ arbitraryUnicodeChar
diff --git a/tests/purs/failing/3689.purs b/tests/purs/failing/3689.purs
new file mode 100644
index 0000000..f11a581
--- /dev/null
+++ b/tests/purs/failing/3689.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith ErrorParsingModule
+module Main where
+
+test =
+ { "bad"
+ }
diff --git a/tests/purs/layout/AdoIn.purs b/tests/purs/layout/AdoIn.purs
index ba7a736..6513ee8 100644
--- a/tests/purs/layout/AdoIn.purs
+++ b/tests/purs/layout/AdoIn.purs
@@ -11,3 +11,9 @@ test = ado
foo <- bar $ let a = 42 in a
baz <- b
in bar
+
+test = ado
+ foo
+ let bar = let a = 42 in a
+ let baz = 42
+ in bar
diff --git a/tests/purs/warning/CustomWarning4.purs b/tests/purs/warning/CustomWarning4.purs
index 5ab9de6..c3511ca 100644
--- a/tests/purs/warning/CustomWarning4.purs
+++ b/tests/purs/warning/CustomWarning4.purs
@@ -6,7 +6,7 @@ module Main where
import Prim.TypeError (class Warn, Beside, QuoteLabel, Text)
import Prim
-import Type.Row (class RowToList, Cons, Nil)
+import Type.RowList (class RowToList, Cons, Nil)
data Label (l :: Symbol) = Label
diff --git a/tests/support/bower.json b/tests/support/bower.json
index 49a7349..56c8cc2 100644
--- a/tests/support/bower.json
+++ b/tests/support/bower.json
@@ -33,7 +33,7 @@
"purescript-tailrec": "4.0.0",
"purescript-tuples": "5.0.0",
"purescript-type-equality": "3.0.0",
- "purescript-typelevel-prelude": "4.0.1",
+ "purescript-typelevel-prelude": "5.0.0",
"purescript-unfoldable": "4.0.0",
"purescript-unsafe-coerce": "4.0.0"
}