rekado pushed a commit to branch python-team
in repository guix.
commit fa9f3680f54635a1ab40fc99d841e52dc748469c
Author: Lars-Dominik Braun <l...@6xq.net>
AuthorDate: Sun Jul 23 11:20:03 2023 +0200
guix: toml: Add TOML parser.
* guix/build/toml.scm: New file.
* tests/toml.scm: New file.
* Makefile.am: Register new files.
---
Makefile.am | 2 +
guix/build/toml.scm | 478 ++++++++++++++++++++++++++++++++++++++++++++++++++++
tests/toml.scm | 442 ++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 922 insertions(+)
diff --git a/Makefile.am b/Makefile.am
index cef972880c..a1c79ba71f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -283,6 +283,7 @@ MODULES = \
guix/build/qt-utils.scm \
guix/build/zig-build-system.scm \
guix/build/make-bootstrap.scm \
+ guix/build/toml.scm \
guix/search-paths.scm \
guix/packages.scm \
guix/import/cabal.scm \
@@ -589,6 +590,7 @@ SCM_TESTS = \
tests/system.scm \
tests/style.scm \
tests/texlive.scm \
+ tests/toml.scm \
tests/transformations.scm \
tests/ui.scm \
tests/union.scm \
diff --git a/guix/build/toml.scm b/guix/build/toml.scm
new file mode 100644
index 0000000000..d5ea01d001
--- /dev/null
+++ b/guix/build/toml.scm
@@ -0,0 +1,478 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Lars-Dominik Braun <l...@6xq.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;; This is a TOML parser adapted from the ABNF for v1.0.0 from
+;; https://github.com/toml-lang/toml/blob/1.0.0/toml.abnf
+;; The PEG grammar tries to follow the ABNF as closely as possible with
+;; few deviations commented.
+;;
+;; The semantics are defined in https://toml.io/en/v1.0.0
+;; Currently unimplemented:
+;; - Array of Tables
+
+(define-module (guix build toml)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 peg)
+ #:use-module (ice-9 textual-ports)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-35)
+ #:export (parse-toml parse-toml-file recursive-assoc-ref &file-not-consumed
&already-defined))
+
+(define-condition-type &toml-error &error toml-error?)
+(define-condition-type &file-not-consumed &toml-error file-not-consumed?)
+(define-condition-type &already-defined &toml-error already-defined?)
+
+;; Overall Structure
+(define-peg-pattern toml-file body (and expression
+ (* (and ignore-newline expression))))
+(define-peg-pattern expression body (or
+ (and ws keyval ws (? comment))
+ (and ws table ws (? comment))
+ (and ws (? comment))))
+
+;; Whitespace
+(define-peg-pattern ws none (* wschar))
+(define-peg-pattern wschar body (or " " "\t"))
+
+;; Newline
+(define-peg-pattern newline body (or "\n" "\r\n"))
+;; This newline’s content is ignored, so we don’t need a bunch of (ignore
newline).
+(define-peg-pattern ignore-newline none newline)
+
+;; Comment
+(define-peg-pattern non-ascii body (or (range #\x80 #\xd7ff)
+ (range #\xe000 #\x10ffff)))
+(define-peg-pattern non-eol body (or "\t" (range #\x20 #\x7f) non-ascii))
+
+(define-peg-pattern comment none (and "#" (* non-eol)))
+
+;; Key-Value pairs
+(define-peg-pattern keyval all (and key keyval-sep val))
+
+(define-peg-pattern key body (or dotted-key
+ simple-key))
+(define-peg-pattern simple-key all (or quoted-key
+ unquoted-key))
+(define-peg-pattern unquoted-key body (+ (or (range #\A #\Z)
+ (range #\a #\z)
+ (range #\0 #\9)
+ "-"
+ "_")))
+(define-peg-pattern quoted-key all (or basic-string
+ literal-string))
+(define-peg-pattern dotted-key body (and simple-key
+ (+ (and dot-sep simple-key))))
+(define-peg-pattern dot-sep none (and ws "." ws))
+(define-peg-pattern keyval-sep none (and ws "=" ws))
+
+(define-peg-pattern val body (or string
+ boolean
+ array
+ inline-table
+ date-time
+ float
+ integer))
+
+;; String
+(define-peg-pattern string all (or ml-basic-string
+ basic-string
+ ml-literal-string
+ literal-string))
+
+;; Basic String
+(define-peg-pattern basic-string body (and (ignore "\"")
+ (* basic-char)
+ (ignore "\"")))
+(define-peg-pattern basic-char body (or basic-unescaped escaped))
+(define-peg-pattern basic-unescaped body (or wschar
+ "\x21"
+ (range #\x23 #\x5B)
+ (range #\x5D #\x7E)
+ non-ascii))
+(define-peg-pattern escaped all (and
+ (ignore "\\")
+ (or "\"" "\\" "b" "f" "n" "r" "t"
+ (and (ignore "u")
+ HEXDIG HEXDIG HEXDIG HEXDIG)
+ (and (ignore "U")
+ HEXDIG HEXDIG HEXDIG HEXDIG
+ HEXDIG HEXDIG HEXDIG HEXDIG))))
+
+;; Multiline Basic String
+(define-peg-pattern ml-basic-string body (and
+ ml-basic-string-delim
+ (? ignore-newline)
+ ml-basic-body
+ ml-basic-string-delim))
+(define-peg-pattern ml-basic-string-delim none "\"\"\"")
+(define-peg-pattern ml-basic-body body (and
+ (* mlb-content)
+ (* (and mlb-quotes (+ mlb-content)))
+ (? mlb-quotes-final)))
+
+(define-peg-pattern mlb-content body (or mlb-char newline mlb-escaped-nl))
+(define-peg-pattern mlb-char body (or mlb-unescaped escaped))
+(define-peg-pattern mlb-quotes body (or "\"\"" "\""))
+;; We need to convince the parser to backtrack here, thus the additional
followed-by rule.
+(define-peg-pattern mlb-quotes-final body (or (and "\"\"" (followed-by
+
ml-basic-string-delim))
+ (and "\"" (followed-by
+
ml-basic-string-delim))))
+(define-peg-pattern mlb-unescaped body (or wschar
+ "\x21"
+ (range #\x23 #\x5B)
+ (range #\x5D #\x7E)
+ non-ascii))
+;; Escaped newlines and following whitespace are removed from the output.
+(define-peg-pattern mlb-escaped-nl none (and "\\" ws newline
+ (* (or wschar newline))))
+
+;; Literal String
+(define-peg-pattern literal-string body (and (ignore "'")
+ (* literal-char)
+ (ignore "'")))
+(define-peg-pattern literal-char body (or "\x09"
+ (range #\x20 #\x26)
+ (range #\x28 #\x7E)
+ non-ascii))
+
+;; Multiline Literal String
+(define-peg-pattern ml-literal-string body (and
+ ml-literal-string-delim
+ (? ignore-newline)
+ ml-literal-body
+ ml-literal-string-delim))
+(define-peg-pattern ml-literal-string-delim none "'''")
+(define-peg-pattern ml-literal-body body (and
+ (* mll-content)
+ (* (and mll-quotes (+ mll-content)))
+ (? mll-quotes-final)))
+
+(define-peg-pattern mll-content body (or mll-char newline))
+(define-peg-pattern mll-char body (or "\x09"
+ (range #\x20 #\x26)
+ (range #\x28 #\x7E)
+ non-ascii))
+(define-peg-pattern mll-quotes body (or "''" "'"))
+;; We need to convince the parser to backtrack here, thus the additional
followed-by rule.
+(define-peg-pattern mll-quotes-final body (or (and "''" (followed-by
+
ml-literal-string-delim))
+ (and "'" (followed-by
+
ml-literal-string-delim))))
+
+;; Integer
+(define-peg-pattern integer all (or hex-int oct-int bin-int dec-int))
+
+(define-peg-pattern digit1-9 body (range #\1 #\9))
+(define-peg-pattern digit0-7 body (range #\0 #\7))
+(define-peg-pattern digit0-1 body (range #\0 #\1))
+(define-peg-pattern DIGIT body (range #\0 #\9))
+(define-peg-pattern HEXDIG body (or DIGIT
+ (range #\a #\f)
+ (range #\A #\F)))
+
+(define-peg-pattern dec-int all (and (? (or "-" "+")) unsigned-dec-int))
+(define-peg-pattern unsigned-dec-int body (or (and digit1-9 (+ (or DIGIT (and
(ignore "_") DIGIT))))
+ DIGIT))
+
+(define-peg-pattern hex-int all (and (ignore "0x")
+ HEXDIG
+ (* (or HEXDIG (and (ignore "_")
HEXDIG)))))
+(define-peg-pattern oct-int all (and (ignore "0o")
+ digit0-7
+ (* (or digit0-7 (and (ignore "_")
digit0-7)))))
+(define-peg-pattern bin-int all (and (ignore "0b")
+ digit0-1
+ (* (or digit0-1 (and (ignore "_")
digit0-1)))))
+
+;; Float
+(define-peg-pattern float all (or
+ (and float-int-part (or exp (and frac (?
exp))))
+ special-float))
+(define-peg-pattern float-int-part body dec-int)
+(define-peg-pattern frac body (and "." zero-prefixable-int))
+(define-peg-pattern zero-prefixable-int body (and DIGIT (* (or DIGIT (and
(ignore "_") DIGIT)))))
+
+(define-peg-pattern exp body (and (or "e" "E") float-exp-part))
+(define-peg-pattern float-exp-part body (and (? (or "-" "+"))
zero-prefixable-int))
+(define-peg-pattern special-float body (and (? (or "-" "+")) (or "inf" "nan")))
+
+;; Boolean
+(define-peg-pattern boolean all (or "true" "false"))
+
+;; Date and Time (as defined in RFC 3339)
+
+(define-peg-pattern date-time body (or offset-date-time
+ local-date-time
+ local-date
+ local-time))
+
+(define-peg-pattern date-fullyear all (and DIGIT DIGIT DIGIT DIGIT))
+(define-peg-pattern date-month all (and DIGIT DIGIT)) ; 01-12
+(define-peg-pattern date-mday all (and DIGIT DIGIT)) ; 01-28, 01-29, 01-30,
01-31 based on month/year
+(define-peg-pattern time-delim none (or "T" "t" " ")) ; T, t, or space
+(define-peg-pattern time-hour all (and DIGIT DIGIT)) ; 00-23
+(define-peg-pattern time-minute all (and DIGIT DIGIT)) ; 00-59
+(define-peg-pattern time-second all (and DIGIT DIGIT)) ; 00-58, 00-59, 00-60
based on leap second rules
+(define-peg-pattern time-secfrac all (and (ignore ".") (+ DIGIT)))
+(define-peg-pattern time-numoffset body (and (or "+" "-")
+ time-hour
+ (ignore ":")
+ time-minute))
+(define-peg-pattern time-offset all (or "Z" time-numoffset))
+
+(define-peg-pattern partial-time body (and time-hour
+ (ignore ":")
+ time-minute
+ (ignore ":")
+ time-second
+ (? time-secfrac)))
+(define-peg-pattern full-date body (and date-fullyear
+ (ignore "-")
+ date-month
+ (ignore "-")
+ date-mday))
+(define-peg-pattern full-time body (and partial-time time-offset))
+
+;; Offset Date-Time
+(define-peg-pattern offset-date-time all (and full-date time-delim full-time))
+
+;; Local Date-Time
+(define-peg-pattern local-date-time all (and full-date time-delim
partial-time))
+
+;; Local Date
+(define-peg-pattern local-date all full-date)
+
+;; Local Time
+(define-peg-pattern local-time all partial-time)
+
+;; Array
+(define-peg-pattern array all (and (ignore "[")
+ (? array-values)
+ (ignore ws-comment-newline)
+ (ignore "]")))
+
+(define-peg-pattern array-values body (or
+ (and ws-comment-newline
+ val
+ ws-comment-newline
+ (ignore ",")
+ array-values)
+ (and ws-comment-newline
+ val
+ ws-comment-newline
+ (ignore (? ",")))))
+
+(define-peg-pattern ws-comment-newline none (* (or wschar (and (? comment)
ignore-newline))))
+
+;; Table
+(define-peg-pattern table all (or array-table
+ std-table))
+
+;; Standard Table
+(define-peg-pattern std-table all (and (ignore "[") ws key ws (ignore "]")))
+(define-peg-pattern array-table all (and (ignore "[[") ws key ws (ignore
"]]")))
+
+;; Inline Table
+(define-peg-pattern inline-table all (and (ignore "{")
+ (* ws)
+ (? inline-table-keyvals)
+ (* ws)
+ (ignore "}")))
+(define-peg-pattern inline-table-sep none (and ws "," ws))
+(define-peg-pattern inline-table-keyvals body (and keyval
+ (? (and inline-table-sep
inline-table-keyvals))))
+
+
+;; Parsing
+
+(define (recursive-acons key value alist)
+ "Add a VALUE to ALIST of alists descending into keys according to the
+list in KEY. For instance of KEY is (a b) this would create
+alist[a][b] = value."
+ (match key
+ (((? string? key))
+ (if (assoc-ref alist key)
+ (raise (condition (&already-defined)))
+ (alist-cons key value alist)))
+ ((elem rest ...) (match (assoc-ref alist elem)
+ (#f
+ (acons elem (recursive-acons rest value '()) alist))
+ (old-value
+ (acons elem (recursive-acons rest value old-value)
(alist-delete elem alist)))))
+ (() alist)))
+
+(define (recursive-assoc-ref alist key)
+ "Retrieve a value from ALIST of alists, descending into each value of
+the list KEY. For instance a KEY (a b) would retrieve alist[a][b]."
+ (match key
+ (((? string? key)) (assoc-ref alist key))
+ ((elem rest ...) (recursive-assoc-ref (assoc-ref alist elem) rest))))
+
+(define (eval-toml-file parse-tree)
+ "Convert toml parse tree to alist."
+
+ (define (assoc-ref->number alist key)
+ (and=> (and=> (assq-ref alist key) car) string->number))
+
+ (define (eval-date rest)
+ (let ((args (keyword-flatten '(date-fullyear
+ date-month
+ date-mday
+ time-hour
+ time-minute
+ time-second
+ time-secfrac
+ time-offset)
+ rest)))
+ (make-date
+ (assoc-ref->number args 'time-secfrac)
+ (assoc-ref->number args 'time-second)
+ (assoc-ref->number args 'time-minute)
+ (assoc-ref->number args 'time-hour)
+ (assoc-ref->number args 'date-mday)
+ (assoc-ref->number args 'date-month)
+ (assoc-ref->number args 'date-fullyear)
+ (match (assq-ref args 'time-offset)
+ (("Z") 0)
+ ((sign ('time-hour hour) ('time-minute minute))
+ (* (+
+ (* (string->number (string-append sign hour)) 60)
+ (string->number minute)) 60))
+ (#f #f)))))
+
+ (define (eval-value value)
+ "Evaluate right-hand-side of 'keyval token (i.e., a value)."
+ (match value
+ (('boolean "true")
+ #t)
+ (('boolean "false")
+ #f)
+ (('integer ('dec-int int))
+ (string->number int 10))
+ (('integer ('hex-int int))
+ (string->number int 16))
+ (('integer ('oct-int int))
+ (string->number int 8))
+ (('integer ('bin-int int))
+ (string->number int 2))
+ (('float ('dec-int int) b)
+ (string->number (string-append int b) 10))
+ (('float other)
+ (match other
+ ("inf" +inf.0)
+ ("+inf" +inf.0)
+ ("-inf" -inf.0)
+ ("nan" +nan.0)
+ ("+nan" +nan.0)
+ ("-nan" -nan.0)))
+ (('offset-date-time rest ...)
+ (eval-date rest))
+ (('local-date-time rest ...)
+ (eval-date rest))
+ (('local-date rest ...)
+ (eval-date rest))
+ (('local-time rest ...)
+ (eval-date rest))
+ (('string str ...)
+ (apply string-append
+ (map (match-lambda
+ (('escaped "\"") "\"")
+ (('escaped "\\") "\\")
+ (('escaped "b") "\b")
+ (('escaped "t") "\t")
+ (('escaped "n") "\n")
+ (('escaped (? (lambda (x) (>= (string-length x) 4)) u))
+ (list->string (list (integer->char (string->number u
16)))))
+ ((? string? s) s))
+ (keyword-flatten '(escaped) str))))
+ ('string "")
+ (('array tails ...)
+ (map eval-value (keyword-flatten '(boolean integer float string array
+ inline-table offset-date-time
+ local-date-time local-date
+ local-time)
+ tails)))
+ ('array (list))
+ (('inline-table tails ...)
+ (eval (keyword-flatten '(keyval) tails) '() '()))))
+
+ (define (ensure-list value)
+ (if (list? value)
+ value
+ (list value)))
+
+ (define (simple-key->list keys)
+ (map
+ (match-lambda
+ (('simple-key 'quoted-key) "")
+ (('simple-key ('quoted-key k)) k)
+ (('simple-key (? string? k)) k)
+ (other (raise-exception `(invalid-simple-key ,other))))
+ (keyword-flatten '(simple-key) keys)))
+
+ (define (skip-keyval tails)
+ "Skip key-value pairs in tails until the next table."
+ (match tails
+ ((('keyval key val) tails ...)
+ (skip-keyval tails))
+ (('keyval keyval)
+ '())
+ (other other)))
+
+ (define (eval parse-tree current-table result)
+ "Evaluate toml file body."
+
+ (match parse-tree
+ ((('table ('std-table names ...)) tails ...)
+ (eval tails (simple-key->list names) result))
+ ((('table ('array-table names ...)) tails ...)
+ ;; Not implemented.
+ (eval (skip-keyval tails) '() result))
+ ((('keyval key val) tails ...)
+ (recursive-acons
+ (append current-table (ensure-list (simple-key->list key)))
+ (eval-value val)
+ (eval tails current-table result)))
+ (('keyval key val)
+ (recursive-acons
+ (append current-table (ensure-list (simple-key->list key)))
+ (eval-value val)
+ result))
+ (()
+ '())))
+
+ (eval parse-tree '() '()))
+
+(define (parse-toml str)
+ "Parse and evaluate toml document from string STR."
+
+ (let* ((match (match-pattern toml-file str))
+ (end (peg:end match))
+ (tree (peg:tree match))
+ (flat-tree (keyword-flatten '(table keyval) tree)))
+ (if (eq? end (string-length str))
+ (eval-toml-file flat-tree)
+ (raise (condition (&file-not-consumed))))))
+
+(define (parse-toml-file file)
+ "Parse and evaluate toml document from file FILE."
+
+ (parse-toml (call-with-input-file file get-string-all)))
+
diff --git a/tests/toml.scm b/tests/toml.scm
new file mode 100644
index 0000000000..cd731cd2f0
--- /dev/null
+++ b/tests/toml.scm
@@ -0,0 +1,442 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Lars-Dominik Braun <l...@6xq.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-toml)
+ #:use-module (guix build toml)
+ #:use-module (guix tests)
+ #:use-module (srfi srfi-19) ; For datetime.
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
+
+(test-begin "toml")
+
+;; Tests taken from https://toml.io/en/v1.0.0
+
+(test-error "parse-toml: Unspecified key"
+ &file-not-consumed
+ (parse-toml "key = # INVALID"))
+
+(test-error "parse-toml: Missing EOL"
+ &file-not-consumed
+ (parse-toml "first = \"Tom\" last = \"Preston-Werner\" # INVALID"))
+
+(test-equal "parse-toml: Bare keys"
+ '(("key" . "value") ("bare_key" . "value") ("bare-key" . "value") ("1234" .
"value"))
+ (parse-toml "key = \"value\"
+bare_key = \"value\"
+bare-key = \"value\"
+1234 = \"value\""))
+
+(test-equal "parse-toml: Quoted keys"
+ '(("127.0.0.1" . "value")
+ ("character encoding" . "value")
+ ("ʎǝʞ" . "value")
+ ("key2" . "value")
+ ("quoted \"value\"" . "value"))
+ (parse-toml "\"127.0.0.1\" = \"value\"
+\"character encoding\" = \"value\"
+\"ʎǝʞ\" = \"value\"
+'key2' = \"value\"
+'quoted \"value\"' = \"value\""))
+
+(test-equal "parse-toml: No key"
+ #f
+ (parse-toml "= \"no key name\""))
+
+(test-equal "parse-toml: Empty key"
+ '(("" . "blank"))
+ (parse-toml "\"\" = \"blank\""))
+
+(test-equal "parse-toml: Dotted keys"
+ '(("name" . "Orange")
+ ("physical" ("color" . "orange")
+ ("shape" . "round"))
+ ("site" ("google.com" . #t)))
+ (parse-toml "name = \"Orange\"
+physical.color = \"orange\"
+physical.shape = \"round\"
+site.\"google.com\" = true"))
+
+(test-equal "parse-toml: Dotted keys with whitespace"
+ '(("fruit" ("name" . "banana") ("color" . "yellow") ("flavor" . "banana")))
+ (parse-toml "fruit.name = \"banana\" # this is best practice
+fruit. color = \"yellow\" # same as fruit.color
+fruit . flavor = \"banana\" # same as fruit.flavor"))
+
+(test-error "parse-toml: Multiple keys"
+ &already-defined
+ (parse-toml "name = \"Tom\"
+name = \"Pradyun\""))
+
+(test-equal "parse-toml: Implicit tables"
+ '(("fruit" ("apple" ("smooth" . #t)) ("orange" . 2)))
+ (parse-toml "fruit.apple.smooth = true
+fruit.orange = 2"))
+
+(test-error "parse-toml: Write to value"
+ &already-defined
+ (parse-toml "fruit.apple = 1
+fruit.apple.smooth = true"))
+
+(test-equal "parse-toml: String"
+ '(("str" . "I'm a string. \"You can quote me\".
Name\tJos\u00E9\nLocation\tSF."))
+ (parse-toml "str = \"I'm a string. \\\"You can quote me\\\".
Name\\tJos\\u00E9\\nLocation\\tSF.\""))
+
+(test-equal "parse-toml: Empty string"
+ '(("str1" . "")
+ ("str2" . "")
+ ("str3" . "")
+ ("str4" . ""))
+ (parse-toml "str1 = \"\"
+str2 = ''
+str3 = \"\"\"\"\"\"
+str4 = ''''''"))
+
+(test-equal "parse-toml: Multi-line basic strings"
+ '(("str1" . "Roses are red\nViolets are blue")
+ ("str2" . "The quick brown fox jumps over the lazy dog.")
+ ("str3" . "The quick brown fox jumps over the lazy dog.")
+ ("str4" . "Here are two quotation marks: \"\". Simple enough.")
+ ("str5" . "Here are three quotation marks: \"\"\".")
+ ("str6" . "Here are fifteen quotation marks:
\"\"\"\"\"\"\"\"\"\"\"\"\"\"\".")
+ ("str7" . "\"This,\" she said, \"is just a pointless statement.\""))
+ (parse-toml "str1 = \"\"\"
+Roses are red
+Violets are blue\"\"\"
+
+str2 = \"\"\"
+The quick brown \\
+
+
+ fox jumps over \\
+ the lazy dog.\"\"\"
+
+str3 = \"\"\"\\
+ The quick brown \\
+ fox jumps over \\
+ the lazy dog.\\
+ \"\"\"
+
+str4 = \"\"\"Here are two quotation marks: \"\". Simple enough.\"\"\"
+# str5 = \"\"\"Here are three quotation marks: \"\"\".\"\"\" # INVALID
+str5 = \"\"\"Here are three quotation marks: \"\"\\\".\"\"\"
+str6 = \"\"\"Here are fifteen quotation marks:
\"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\".\"\"\"
+
+# \"This,\" she said, \"is just a pointless statement.\"
+str7 = \"\"\"\"This,\" she said, \"is just a pointless statement.\"\"\"\""))
+
+(test-equal "parse-toml: Literal string"
+ '(("winpath" . "C:\\Users\\nodejs\\templates")
+ ("winpath2" . "\\\\ServerX\\admin$\\system32\\")
+ ("quoted" . "Tom \"Dubs\" Preston-Werner")
+ ("regex" . "<\\i\\c*\\s*>"))
+ (parse-toml "winpath = 'C:\\Users\\nodejs\\templates'
+winpath2 = '\\\\ServerX\\admin$\\system32\\'
+quoted = 'Tom \"Dubs\" Preston-Werner'
+regex = '<\\i\\c*\\s*>'"))
+
+(test-equal "parse-toml: Multi-line literal strings"
+ '(("regex2" . "I [dw]on't need \\d{2} apples")
+ ("lines" . "The first newline is\ntrimmed in raw strings.\n All other
whitespace\n is preserved.\n")
+ ("quot15" . "Here are fifteen quotation marks:
\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"")
+ ("apos15" . "Here are fifteen apostrophes: '''''''''''''''")
+ ("str" . "'That,' she said, 'is still pointless.'"))
+ (parse-toml "regex2 = '''I [dw]on't need \\d{2} apples'''
+lines = '''
+The first newline is
+trimmed in raw strings.
+ All other whitespace
+ is preserved.
+'''
+quot15 = '''Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"'''
+
+# apos15 = '''Here are fifteen apostrophes: '''''''''''''''''' # INVALID
+apos15 = \"Here are fifteen apostrophes: '''''''''''''''\"
+
+# 'That,' she said, 'is still pointless.'
+str = ''''That,' she said, 'is still pointless.''''"))
+
+(test-equal "parse-toml: Decimal integer"
+ '(("int1" . 99) ("int2" . 42) ("int3" . 0) ("int4" . -17))
+ (parse-toml "int1 = +99
+int2 = 42
+int3 = 0
+int4 = -17"))
+
+(test-equal "parse-toml: Decimal integer underscores"
+ '(("int5" . 1000) ("int6" . 5349221) ("int7" . 5349221) ("int8" . 12345))
+ (parse-toml "int5 = 1_000
+int6 = 5_349_221
+int7 = 53_49_221 # Indian number system grouping
+int8 = 1_2_3_4_5 # VALID but discouraged"))
+
+(test-equal "parse-toml: Hexadecimal"
+ `(("hex1" . ,#xdeadbeef) ("hex2" . ,#xdeadbeef) ("hex3" . ,#xdeadbeef))
+ (parse-toml "hex1 = 0xDEADBEEF
+hex2 = 0xdeadbeef
+hex3 = 0xdead_beef"))
+
+(test-equal "parse-toml: Octal"
+ `(("oct1" . ,#o01234567) ("oct2" . #o755))
+ (parse-toml "oct1 = 0o01234567
+oct2 = 0o755"))
+
+(test-equal "parse-toml: Binary"
+ `(("bin1" . ,#b11010110))
+ (parse-toml "bin1 = 0b11010110"))
+
+(test-equal "parse-toml: Float"
+ '(("flt1" . 1.0)
+ ("flt2" . 3.1415)
+ ("flt3" . -0.01)
+ ("flt4" . 5e+22)
+ ("flt5" . 1e06)
+ ("flt6" . -2e-2)
+ ("flt7" . 6.626e-34)
+ ("flt8" . 224617.445991228))
+ (parse-toml "# fractional
+flt1 = +1.0
+flt2 = 3.1415
+flt3 = -0.01
+
+# exponent
+flt4 = 5e+22
+flt5 = 1e06
+flt6 = -2E-2
+
+# both
+flt7 = 6.626e-34
+
+flt8 = 224_617.445_991_228"))
+
+(test-equal "parse-toml: Float"
+ '(("sf1" . +inf.0)
+ ("sf2" . +inf.0)
+ ("sf3" . -inf.0)
+ ("sf4" . +nan.0)
+ ("sf5" . +nan.0)
+ ("sf6" . -nan.0))
+ (parse-toml "# infinity
+sf1 = inf # positive infinity
+sf2 = +inf # positive infinity
+sf3 = -inf # negative infinity
+
+# not a number
+sf4 = nan # actual sNaN/qNaN encoding is implementation-specific
+sf5 = +nan # same as `nan`
+sf6 = -nan # valid, actual encoding is implementation-specific"))
+
+(test-equal "parse-toml: Boolean"
+ '(("bool1" . #t)
+ ("bool2" . #f))
+ (parse-toml "bool1 = true
+bool2 = false"))
+
+(test-equal "parse-toml: Offset date-time"
+ `(("odt1" . ,(make-date #f 0 32 7 27 5 1979 0))
+ ("odt2" . ,(make-date #f 0 32 0 27 5 1979 (* -7 60 60)))
+ ("odt3" . ,(make-date 999999 0 32 0 27 5 1979 (* 7 60 60)))
+ ("odt4" . ,(make-date #f 0 32 7 27 5 1979 0)))
+ (parse-toml "odt1 = 1979-05-27T07:32:00Z
+odt2 = 1979-05-27T00:32:00-07:00
+odt3 = 1979-05-27T00:32:00.999999+07:00
+odt4 = 1979-05-27 07:32:00Z"))
+
+(test-equal "parse-toml: Local date-time"
+ `(("ldt1" . ,(make-date #f 0 32 7 27 5 1979 #f))
+ ("ldt2" . ,(make-date 999999 0 32 0 27 5 1979 #f)))
+ (parse-toml "ldt1 = 1979-05-27T07:32:00
+ldt2 = 1979-05-27T00:32:00.999999"))
+
+(test-equal "parse-toml: Local date"
+ `(("ld1" . ,(make-date #f #f #f #f 27 5 1979 #f)))
+ (parse-toml "ld1 = 1979-05-27"))
+
+(test-equal "parse-toml: Local time"
+ `(("lt1" . ,(make-date #f 0 32 7 #f #f #f #f))
+ ("lt2" . ,(make-date 999999 0 32 0 #f #f #f #f)))
+ (parse-toml "lt1 = 07:32:00
+lt2 = 00:32:00.999999"))
+
+(test-equal "parse-toml: Arrays"
+ '(("integers" 1 2 3)
+ ("colors" "red" "yellow" "green")
+ ("nested_arrays_of_ints" (1 2) (3 4 5))
+ ("nested_mixed_array" (1 2) ("a" "b" "c"))
+ ("string_array" "all" "strings")
+ ("numbers" 0.1 0.2 0.5 1 2 5)
+ ("contributors" "Foo Bar <f...@example.com>" (("name" . "Baz Qux") ("email"
. "baz...@example.com") ("url" . "https://example.com/bazqux";)))
+ ("integers2" 1 2 3)
+ ("integers3" 1 2))
+ (parse-toml "integers = [ 1, 2, 3 ]
+colors = [ \"red\", \"yellow\", \"green\" ]
+nested_arrays_of_ints = [ [ 1, 2 ], [3, 4, 5] ]
+nested_mixed_array = [ [ 1, 2 ], [\"a\", \"b\", \"c\"] ]
+string_array = [ \"all\", 'strings' ]
+
+# Mixed-type arrays are allowed
+numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ]
+contributors = [
+ \"Foo Bar <f...@example.com>\",
+ { name = \"Baz Qux\", email = \"baz...@example.com\", url =
\"https://example.com/bazqux\"; }
+]
+
+integers2 = [
+ 1, 2, 3
+]
+
+integers3 = [
+ 1,
+ 2, # this is ok
+]"))
+
+(test-equal "parse-toml: Tables"
+ '(("table-1" ("key1" . "some string")
+ ("key2" . 123))
+ ("table-2" ("key1" . "another string")
+ ("key2" . 456)))
+ (parse-toml "[table-1]
+key1 = \"some string\"
+key2 = 123
+
+[table-2]
+key1 = \"another string\"
+key2 = 456"))
+
+
+(test-equal "parse-toml: Dotted table"
+ '(("dog" ("tater.man" ("type" ("name" . "pug")))))
+ (parse-toml "[dog.\"tater.man\"]
+type.name = \"pug\""))
+
+
+(test-equal "parse-toml: Dotted table with whitespace"
+ '(("a" ("b" ("c" ("x" . 1))))
+ ("d" ("e" ("f" ("x" . 1))))
+ ("g" ("h" ("i" ("x" . 1))))
+ ("j" ("ʞ" ("l" ("x" . 1)))))
+ (parse-toml "[a.b.c] # this is best practice
+x=1
+[ d.e.f ] # same as [d.e.f]
+x=1
+[ g . h . i ] # same as [g.h.i]
+x=1
+[ j . \"ʞ\" . 'l' ] # same as [j.\"ʞ\".'l']
+x=1"))
+
+;; XXX: technically this is not allowed, but we permit it.
+(test-equal "parse-toml: Multiple tables"
+ '(("fruit" ("apple" . "red") ("orange" . "orange")))
+ (parse-toml "[fruit]
+apple = \"red\"
+
+[fruit]
+orange = \"orange\""))
+
+(test-equal "parse-toml: Assignment to non-table"
+ #f
+ (parse-toml "[fruit]
+apple = \"red\"
+
+[fruit.apple]
+texture = \"smooth\""))
+
+(test-equal "parse-toml: Dotted keys create tables"
+ '(("fruit" ("apple" ("color" . "red") ("taste" ("sweet" . #t)))))
+ (parse-toml "fruit.apple.color = \"red\"
+fruit.apple.taste.sweet = true"))
+
+(test-equal "parse-toml: Inline tables"
+ '(("name" ("first" . "Tom") ("last" . "Preston-Werner"))
+ ("point" ("x" . 1) ("y" . 2))
+ ("animal" ("type" ("name" . "pug"))))
+ (parse-toml "name = { first = \"Tom\", last = \"Preston-Werner\" }
+point = { x = 1, y = 2 }
+animal = { type.name = \"pug\" }"))
+
+(test-error "parse-toml: Invalid assignment to inline table"
+ #t
+ (parse-toml "[product]
+type = { name = \"Nail\" }
+type.edible = false # INVALID"))
+
+;; We do not catch this semantic error yet.
+(test-expect-fail 1)
+(test-error "parse-toml: Invalid assignment to implicit table"
+ #f
+ (parse-toml "[product]
+type.name = \"Nail\"
+type = { edible = false } # INVALID"))
+
+;; Not implemented.
+(test-expect-fail 1)
+(test-equal "parse-toml: Array of tables"
+ '(("products" (("name" . "Hammer") ("sku" . 738594937))
+ ()
+ (("name" . "Nail") ("sku" . 284758393) ("color" . "gray"))))
+ (parse-toml "[[products]]
+name = \"Hammer\"
+sku = 738594937
+
+[[products]] # empty table within the array
+
+[[products]]
+name = \"Nail\"
+sku = 284758393
+
+color = \"gray\""))
+
+;; Not implemented.
+(test-expect-fail 1)
+(test-equal "parse-toml: Array of tables"
+ '(("fruits" ((("name" . "apple")
+ ("physical" (("color" . "red") ("shape" . "round")))
+ ("varieties" ((("name" . "red delicious")) (("name" . "granny
smith")))))
+ (("name" . "banana")
+ ("varieties" (((("name" . "plantain")))))))))
+ (parse-toml "[[fruits]]
+name = \"apple\"
+
+[fruits.physical] # subtable
+color = \"red\"
+shape = \"round\"
+
+[[fruits.varieties]] # nested array of tables
+name = \"red delicious\"
+
+[[fruits.varieties]]
+name = \"granny smith\"
+
+
+[[fruits]]
+name = \"banana\"
+
+[[fruits.varieties]]
+name = \"plantain\""))
+
+;; Not implemented.
+(test-expect-fail 1)
+(test-error "parse-toml: Assignment to statically defined array"
+ #f
+ (parse-toml "fruits = []
+
+[[fruits]]
+x=1"))
+
+(test-end "toml")
+
