parse meta vars

test/Gyehoek/Test/Golden.hs

@@ -35,12 +35,6 @@ brokenStackifyTests =
   -- , "callcc-nested1" -- requires closure-conversion
   -- ]
 
-brokenReaderTests =
-  [ "delimited-identifier"
-  , "string-line-continuation"
-  , "peculiar-identifier-dot"
-  ]
-
 test_root :: IO TestTree
 test_root = do
   all_cases <- listDirectory "golden/exec"
@@ -91,22 +85,3 @@ stackifyTests files = do
        resultfile
        action
        printProcResult
-
-test_reader :: IO TestTree
-test_reader = do
-  all_cases <- listDirectory "golden/read"
-  let tests = all_cases
-            & fmap ("golden/read"</>)
-  pure . testGroup "reader" $ tests <&> \test ->
-    let testname = takeFileName test
-        scmfile = test </> "source.scm"
-        resultfile = test </> "read"
-        action = runEff $ Read.readFile scmfile
-    in maybeBroken testname brokenReaderTests $ goldenVsAction
-        testname
-        resultfile
-        action
-        (view strict . pShowNoColor)
-
--- readTests files = pure . testGroup "reader" $ files <&> \test ->
---   let

test/Gyehoek/Test/Sexp/Read.hs

@@ -0,0 +1,58 @@
+module Gyehoek.Test.Sexp.Read where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Silver
+import System.FilePath
+import Data.List (List)
+import System.Directory
+import Gyehoek.Prelude
+import qualified Gyehoek.Sexp.Read as Read
+import Gyehoek.TestUtil
+import Gyehoek.Jalmot (runJalmotIO)
+import Text.Pretty.Simple (pShowNoColor)
+import Gyehoek.Sexp.Syntax
+import Test.Tasty.HUnit
+import Control.Exception (tryWithContext, ExceptionWithContext (..), rethrowIO)
+import Gyehoek.Jalmot
+
+
+brokenReaderTests :: List String
+brokenReaderTests =
+  [ "delimited-identifier"
+  , "string-line-continuation"
+  , "peculiar-identifier-dot"
+  ]
+
+test_golden :: IO TestTree
+test_golden = do
+  all_cases <- listDirectory "golden/read"
+  let tests = all_cases
+            & fmap ("golden/read"</>)
+  pure . testGroup "reader" $ tests <&> \test ->
+    let testname = takeFileName test
+        scmfile = test </> "source.scm"
+        resultfile = test </> "read"
+        action = runJalmotIO $ Read.readFile scmfile
+    in markIfBroken testname brokenReaderTests $ goldenVsAction
+        testname
+        resultfile
+        action
+        (view strict . pShowNoColor)
+
+readString1 = runJalmotIO . Read.readString1
+
+test_invalidIdentifiers :: TestTree
+test_invalidIdentifiers = testGroup "invalid identifiers"
+  [ testCase "dot" $ notIdentifier (readString1 ".")
+  , testCase "comma" $ notIdentifier (readString1 ",")
+  , testCase "pound" $ notIdentifier (readString1 "#")
+  , testCase "pound anything" $ notIdentifier (readString1 "#abc")
+  ]
+  where
+    notIdentifier m = tryWithContext m >>= \case
+      -- the reader is allowed to fail; we're just don't want it to
+      -- return a symbol.
+      Left (ExceptionWithContext _ (MkAJalmotCS _ (ReaderError _))) -> pure ()
+      Left e -> rethrowIO e
+      Right (Symbol s) -> assertFailure [i|got symbol #{s}|]
+      Right _ -> pure ()

test/Gyehoek/TestUtil.hs

@@ -0,0 +1,11 @@
+module Gyehoek.TestUtil
+  ( markIfBroken
+  ) where
+
+import Test.Tasty.ExpectedFailure (expectFail)
+import Data.Function
+import Test.Tasty (TestTree)
+
+
+markIfBroken :: Foldable f => String -> f String -> TestTree -> TestTree
+markIfBroken name brokenTests = applyWhen (name `elem` brokenTests) expectFail