Add token-snapshot tests

src/Visp.Compiler/CoreParser.fs

@@ -113,6 +113,13 @@ let state = { Todo = () }
 
             reraise ()
 
+    let debugLexFile filePath =
+        let (stream, reader, lexbuf) = UnicodeFileAsLexbuf(filePath, None)
+        use _ = stream
+        use _ = reader
+        let args = mkDefaultLextArgs ()
+        ParseUtils.debugTokenOutput args lexbuf |> List.ofSeq
+
     let getTokens str fileName =
         let lexbuf = LexBuffer<_>.FromString str
         lexbuf.EndPos <- Position.FirstLine fileName

src/Visp.Compiler/ParseUtils.fs

@@ -124,6 +124,12 @@ let parseStringToExpr fileName str =
         reraise ()
 
 let debugTokenOutput args (lexbuf: LexBuffer<_>) =
+    let debugToken =
+        function
+        | STRING(text, kind, cont) ->
+            Syntax.StringWriterUtils.writeDebugStringType "STRING" text kind cont
+        | it -> sprintf "%A" it
+
     seq {
         let tokenizer = mkTokenizerWithArgs args
 
@@ -132,8 +138,8 @@ let debugTokenOutput args (lexbuf: LexBuffer<_>) =
 
             yield
                 sprintf
-                    "%A %A %i %i %A"
-                    next
+                    "%s %A %i %i %A"
+                    (debugToken next)
                     args.mode
                     args.depth
                     args.ContextCount

src/Visp.Compiler/Syntax/Syntax.fs

@@ -119,6 +119,28 @@ type SyntaxWriteUtilThreadStatics =
         with get () = SyntaxWriteUtilThreadStatics.normalizeLineEndings
         and set v = SyntaxWriteUtilThreadStatics.normalizeLineEndings <- v
 
+module StringWriterUtils =
+    let inline writeDebugStringType (name: string) (text: string) kind range =
+        let sb = PooledStringBuilder.Get()
+        // Reserve capacity for the text + all the extra data being written
+        sb.EnsureCapacity(text.Length + 60) |> ignore
+        sb.Append name |> ignore
+        sb.Append " (\"" |> ignore
+
+        for ch in text do
+            match ch with
+            | '\r' when SyntaxWriteUtilThreadStatics.NormalizeLineEndings -> ()
+            | it -> ignore (sb.Append it)
+
+        sb.Append "\", " |> ignore
+        sb.Append(sprintf "%A" kind) |> ignore
+        sb.Append(", ") |> ignore
+        sb.Append(sprintf "%A" range) |> ignore
+
+        sb.Append ")" |> ignore
+
+        sb.ToStringAndReturn()
+
 [<NoEquality; NoComparison; RequireQualifiedAccess; StructuredFormatDisplay("{StructuredText}")>]
 type SynConst =
     | Unit
@@ -159,25 +181,7 @@ type SynConst =
         | Int32 it -> sprintf "Int32 %A" it
         | Char it -> sprintf "Char %A" it
         | Decimal it -> sprintf "Decimal %A" it
-        | String(text, k, r) ->
-            let sb = PooledStringBuilder.Get()
-            // Reserve capacity for the text + all the extra data being written
-            sb.EnsureCapacity(text.Length + 60) |> ignore
-            sb.Append "String (\"" |> ignore
-
-            for ch in text do
-                match ch with
-                | '\r' when SyntaxWriteUtilThreadStatics.NormalizeLineEndings -> ()
-                | it -> ignore (sb.Append it)
-
-            sb.Append "\", " |> ignore
-            sb.Append(sprintf "%A" k) |> ignore
-            sb.Append(", ") |> ignore
-            sb.Append(sprintf "%A" r) |> ignore
-
-            sb.Append ")" |> ignore
-
-            sb.ToStringAndReturn()
+        | String(text, k, r) -> StringWriterUtils.writeDebugStringType "String" text k r
 
 type SynTyped = SynTyped of name: SynSymbol * argtype: SynType * range: range
 

tests/Visp.Compiler.UnitTests/TestUtils.fs

@@ -44,6 +44,21 @@ let inline private verify (out: string) dir (param: string) =
         return! (task |> Async.AwaitTask)
     }
 
+let runTokenTest (name: string) =
+    async {
+        parseCoreLibs ()
+        let path = getVispFilePath name
+
+        try
+            let parsed = CoreParser.debugLexFile path
+            let nameParam = name.Replace('/', '_').Replace('\\', '_')
+            Syntax.SyntaxWriteUtilThreadStatics.NormalizeLineEndings <- true
+            let output = parsed |> String.concat "\n"
+            return! verify output "token-snapshots" nameParam
+        with :? ParseHelpers.SyntaxError as syn ->
+            return raise <| (LexHelpers.syntaxErrorToParseError syn)
+    }
+
 let runStructuredOutputTest (name: string) =
     async {
         parseCoreLibs ()