diff --git a/borrowed/guile-json/AUTHORS b/borrowed/guile-json/AUTHORS index 3343d4c788..2cfddfccc8 100644 --- a/borrowed/guile-json/AUTHORS +++ b/borrowed/guile-json/AUTHORS @@ -1,8 +1,11 @@ Aleix Conchillo Flaque is the author and current -maintainer of guile-json. More details at . +maintainer of guile-json. List of contributors (in alphabetical order): +Ludovic Courtès +Jason Douglas Earl +Christopher Lam Jan Nieuwenhuizen Ian Price David Thompson diff --git a/borrowed/guile-json/COPYING.LESSER b/borrowed/guile-json/COPYING.LESSER deleted file mode 100644 index 65c5ca88a6..0000000000 --- a/borrowed/guile-json/COPYING.LESSER +++ /dev/null @@ -1,165 +0,0 @@ - GNU LESSER GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - - This version of the GNU Lesser General Public License incorporates -the terms and conditions of version 3 of the GNU General Public -License, supplemented by the additional permissions listed below. - - 0. Additional Definitions. - - As used herein, "this License" refers to version 3 of the GNU Lesser -General Public License, and the "GNU GPL" refers to version 3 of the GNU -General Public License. - - "The Library" refers to a covered work governed by this License, -other than an Application or a Combined Work as defined below. - - An "Application" is any work that makes use of an interface provided -by the Library, but which is not otherwise based on the Library. -Defining a subclass of a class defined by the Library is deemed a mode -of using an interface provided by the Library. - - A "Combined Work" is a work produced by combining or linking an -Application with the Library. The particular version of the Library -with which the Combined Work was made is also called the "Linked -Version". - - The "Minimal Corresponding Source" for a Combined Work means the -Corresponding Source for the Combined Work, excluding any source code -for portions of the Combined Work that, considered in isolation, are -based on the Application, and not on the Linked Version. - - The "Corresponding Application Code" for a Combined Work means the -object code and/or source code for the Application, including any data -and utility programs needed for reproducing the Combined Work from the -Application, but excluding the System Libraries of the Combined Work. - - 1. Exception to Section 3 of the GNU GPL. - - You may convey a covered work under sections 3 and 4 of this License -without being bound by section 3 of the GNU GPL. - - 2. Conveying Modified Versions. - - If you modify a copy of the Library, and, in your modifications, a -facility refers to a function or data to be supplied by an Application -that uses the facility (other than as an argument passed when the -facility is invoked), then you may convey a copy of the modified -version: - - a) under this License, provided that you make a good faith effort to - ensure that, in the event an Application does not supply the - function or data, the facility still operates, and performs - whatever part of its purpose remains meaningful, or - - b) under the GNU GPL, with none of the additional permissions of - this License applicable to that copy. - - 3. Object Code Incorporating Material from Library Header Files. - - The object code form of an Application may incorporate material from -a header file that is part of the Library. You may convey such object -code under terms of your choice, provided that, if the incorporated -material is not limited to numerical parameters, data structure -layouts and accessors, or small macros, inline functions and templates -(ten or fewer lines in length), you do both of the following: - - a) Give prominent notice with each copy of the object code that the - Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the object code with a copy of the GNU GPL and this license - document. - - 4. Combined Works. - - You may convey a Combined Work under terms of your choice that, -taken together, effectively do not restrict modification of the -portions of the Library contained in the Combined Work and reverse -engineering for debugging such modifications, if you also do each of -the following: - - a) Give prominent notice with each copy of the Combined Work that - the Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the Combined Work with a copy of the GNU GPL and this license - document. - - c) For a Combined Work that displays copyright notices during - execution, include the copyright notice for the Library among - these notices, as well as a reference directing the user to the - copies of the GNU GPL and this license document. - - d) Do one of the following: - - 0) Convey the Minimal Corresponding Source under the terms of this - License, and the Corresponding Application Code in a form - suitable for, and under terms that permit, the user to - recombine or relink the Application with a modified version of - the Linked Version to produce a modified Combined Work, in the - manner specified by section 6 of the GNU GPL for conveying - Corresponding Source. - - 1) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (a) uses at run time - a copy of the Library already present on the user's computer - system, and (b) will operate properly with a modified version - of the Library that is interface-compatible with the Linked - Version. - - e) Provide Installation Information, but only if you would otherwise - be required to provide such information under section 6 of the - GNU GPL, and only to the extent that such information is - necessary to install and execute a modified version of the - Combined Work produced by recombining or relinking the - Application with a modified version of the Linked Version. (If - you use option 4d0, the Installation Information must accompany - the Minimal Corresponding Source and Corresponding Application - Code. If you use option 4d1, you must provide the Installation - Information in the manner specified by section 6 of the GNU GPL - for conveying Corresponding Source.) - - 5. Combined Libraries. - - You may place library facilities that are a work based on the -Library side by side in a single library together with other library -facilities that are not Applications and are not covered by this -License, and convey such a combined library under terms of your -choice, if you do both of the following: - - a) Accompany the combined library with a copy of the same work based - on the Library, uncombined with any other library facilities, - conveyed under the terms of this License. - - b) Give prominent notice with the combined library that part of it - is a work based on the Library, and explaining where to find the - accompanying uncombined form of the same work. - - 6. Revised Versions of the GNU Lesser General Public License. - - The Free Software Foundation may publish revised and/or new versions -of the GNU Lesser General Public License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the -Library as you received it specifies that a certain numbered version -of the GNU Lesser General Public License "or any later version" -applies to it, you have the option of following the terms and -conditions either of that published version or of any later version -published by the Free Software Foundation. If the Library as you -received it does not specify a version number of the GNU Lesser -General Public License, you may choose any version of the GNU Lesser -General Public License ever published by the Free Software Foundation. - - If the Library as you received it specifies that a proxy can decide -whether future versions of the GNU Lesser General Public License shall -apply, that proxy's public statement of acceptance of any version is -permanent authorization for you to choose that version for the -Library. diff --git a/borrowed/guile-json/Makefile.am b/borrowed/guile-json/Makefile.am new file mode 100644 index 0000000000..996f18b8eb --- /dev/null +++ b/borrowed/guile-json/Makefile.am @@ -0,0 +1,51 @@ +# +# Makefile.am +# +# Copyright (C) 2013-2018 Aleix Conchillo Flaque +# +# This file is part of guile-json. +# +# guile-json 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. +# +# guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +# + +SUBDIRS = json tests + +ACLOCAL_AMFLAGS = -I build-aux + +PKG_LIST_VERSION=$(shell echo $(PACKAGE_VERSION) | sed "s/\./ /g") + +dist-hook: + $(SHELL) $(top_srcdir)/ChangeLog > $(top_distdir)/ChangeLog + cp $(top_srcdir)/pkg-list.scm.in $(top_distdir)/pkg-list.scm + # '' is to make OS X happy + sed -i '' "s/%VERSION%/$(PKG_LIST_VERSION)/g" $(top_distdir)/pkg-list.scm + +GOBJECTS = $(SOURCES:%.scm=%.go) + +moddir=$(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION) +objdir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_nodist_obj_DATA = $(GOBJECTS) + +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(top_builddir)/env $(GUILD) compile $(GUILE_WARNINGS) -o "$@" "$<" + +SOURCES = json.scm + +CLEANFILES = $(GOBJECTS) + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) diff --git a/borrowed/guile-json/NEWS b/borrowed/guile-json/NEWS index d4317c1a77..0d431a9b1f 100644 --- a/borrowed/guile-json/NEWS +++ b/borrowed/guile-json/NEWS @@ -1,4 +1,96 @@ + +* Version ?? (??) + + - Complex numbers, inf and nan are not allowed anymore as valid numbers when + building JSON. + (Fixes #32) + + +* Version 3.1.0 (Dec 31, 2018) + + - scm->json and scm->json-string now support an additional key argument + #:unicode. If #:unicode is set to true unicode characters will be escaped + when needed, otherwise characters won't be escaped (which now becomes the + default). + + +* Version 3.0.0 (Dec 29, 2018) + + - This is another breaking change release. + + - JSON objects are now defined as alists (instead of hash tables) and JSON + arrays are now defined as vectors (instead of lists). Both of these + changes are mainly to use types that have read syntax. This will simplify + things for the user when defining JSON objects which is probably the most + common case. + + - Fixed and issue when parsing only JSON numbers. + + - Added unit tests. + + +* Version 2.0.0 (Dec 12, 2018) + + - This is a breaking change release. It is not possible anymore to specify a + JSON object using alists. Instead alist->hash-table needs to be explicitly + used. This makes the bidirectional mapping between Guile hash-tables and + JSON objects consistent. + + +* Version 1.3.2 (Dec 2, 2018) + + - Don't use GUILE_SITE and GUILE_SITE_CCACHE, build them as before. Print a + helper message at the end of configure output to help users to install in + Guile system's directory. + + +* Version 1.3.1 (Dec 1, 2018) + + - Fix guile.m4 to allow multiple candidates for guild, guile-config and + guile-tools. + + - Use GUILE_SITE as the variable instead of GUILE_SITE_DIR. + (Fixes #20) + + +* Version 1.3.0 (Nov 28, 2018) + + - Properly use guile.m4 macros to install to the right paths. + (thanks to Jason Douglas Earl) + + +* Version 1.2.0 (Aug 22, 2018) + + - Switch to GPLv3. + + +* Version 1.1.1 (Aug 14, 2018) + + - Don't output extra spaces except with pretty printing. + + +* Version 1.1.0 (Jul 26, 2018) + + - Install .go files to $(libdir)/guile. + (thanks to Ludovic Courtès) + + +* Version 1.0.1 (May 24, 2018) + + - Fixes an issue while handling alists with #nil at the beginning. + + +* Version 1.0.0 (May 23, 2018) + + - Support 4-byte unicode characters. + (thanks to Christopher Lam) + + - Remove deprecated `json` macro. + + - Dual GPLv3 and LGPLv3 license. + + * Version 0.6.0 (Jan 16, 2017) - Deprecate json macro in favor of scheme data types. diff --git a/borrowed/guile-json/README b/borrowed/guile-json/README deleted file mode 100644 index 920f85ce9f..0000000000 --- a/borrowed/guile-json/README +++ /dev/null @@ -1,158 +0,0 @@ - -* guile-json - -guile-json is a JSON module for Guile. It supports parsing and -building JSON documents according to the http://json.org -specification. These are the main features: - -- Mostly complies with http://json.org specification (see UTF-8 below). - -- Build JSON documents programmatically using scheme data types. - -- Supports UTF-8 (doesn't fully support unicode hexadecimal digits). - -- Allows JSON pretty printing. - - -* Installation - -guile-json is freely available for download under the terms of the GNU -Lesser General Public License version 3 (LGPLv3+). - -Download the latest tarball and untar it: - -- [[http://download.savannah.gnu.org/releases/guile-json/guile-json-0.6.0.tar.gz][guile-json-0.6.0.tar.gz]] - -Then, run the typical sequence: - - : $ ./configure --prefix= - : $ make - : $ sudo make install - -Where should preferably be the same as your system Guile -installation directory (e.g. /usr). - -If everything installed successfully you should be up and running: - - : $ guile - : scheme@(guile-user)> (use-modules (json)) - : scheme@(guile-user)> (scm->json '(1 2 3)) - : [1, 2, 3] - -It might be that you installed guile-json somewhere differently than -your system's Guile. If so, you need to indicate Guile where to find -guile-json, for example: - - : $ GUILE_LOAD_PATH=/usr/local/share/guile/site guile - -A pkg-list.scm file is also provided for users of the -Guildhall/Dorodango packaging system. - - -* Usage - -guile-json provides a few procedures to parse and build a JSON -document. A JSON document is transformed into or from native Guile -values according to the following table: - -| JSON | Guile | -|--------+-------------| -| string | string | -| number | number | -| object | hash-table* | -| array | list | -| true | #t | -| false | #f | -| null | #nil | - -*Note* (*): Association lists are also tranformed to JSON objects, in -this case ordered will be preserved. - -To start using guile-json procedures and macros you first need to load -the module: - - : scheme@(guile-user)> (use-modules (json)) - - -** Procedures - -- (*json->scm* #:optional port) : Reads a JSON document from the given - port, or from the current input port if none is given. - - - /port/ : is optional, it defaults to the current input port. - -- (*json-string->scm* str) : Reads a JSON document from the given - string. - -- (*scm->json* native #:optional port #:key escape pretty) : Creates a - JSON document from the given native Guile value. The JSON document is - written into the given port, or to the current output port if non is - given. - - - /port/ : it defaults to the current output port. - - /escape/ : if true, the slash (/ solidus) character will be escaped. - - /pretty/ : if true, the JSON document will be pretty printed. - -- (*scm->json-string* native #:key escape pretty) : Creates a JSON - document from the given native Guile value into a string. - - - /escape/ : if true, the slash (/ solidus) character will be escaped. - - /pretty/ : if true, the JSON document will be pretty printed. - - -** Exceptions - -A /json-invalid/ exception is thrown if an error is found during the -JSON parsing. Since version 0.2.0, the /json-invalid/ exception has a -single parser argument (see predicate and accessors below). The line or -column where the error occured can be easily obtained from the parser -port (calling /port-line/ or /port-column/ on the port). - -- (*json-parser?* parser) : Tells whether the given argument is a JSON - parser record type. - -- (*json-parser-port* parser) : Get the port that the parser was reading - from. - - -** Examples - -- Build the string "hello world": - - : scheme@(guile-user)> (scm->json "hello world") - : "hello world" - -- Build the [1, 2, 3] array: - - : scheme@(guile-user)> (scm->json '(1 2 3)) - : [1, 2, 3] - -- Build the [1, 2, 3, 4] array using unquote-splicing: - - : scheme@(guile-user)> (define values '(2 3)) - : scheme@(guile-user)> (scm->json `(1 ,@values 4)) - : [1, 2, 3, 4] - -- Build the object { "project" : "foo", "author" : "bar" } using an - association list (see how symbols can also be used): - - : scheme@(guile-user)> (scm->json '(("project" . "foo") (author . bar))) - : {"project" : "foo","author" : "bar"} - -- Build again the same object { "project" : "foo", "author" : "bar" } - using a hash table: - - : scheme@(guile-user)> (scm->json (alist->hash-table '((project . foo) (author . bar)))) - : {"project" : "foo","author" : "bar"} - -- Build the object { "values" : [ 234, 98.56 ] }: - - : scheme@(guile-user)> (scm->json '(("values" 234 98.56))) - : {"values" : [234, 98.56]} - -- Build the object { "values" : [ 234, 98.56 ] } again, this time using - a variable: - - : scheme@(guile-user)> (define values '(234 98.56)) - : scheme@(guile-user)> (scm->json `(("values" ,@values))) - : {"values" : [234, 98.56]} diff --git a/borrowed/guile-json/README b/borrowed/guile-json/README new file mode 120000 index 0000000000..314e17d431 --- /dev/null +++ b/borrowed/guile-json/README @@ -0,0 +1 @@ +README.org \ No newline at end of file diff --git a/borrowed/guile-json/README.org b/borrowed/guile-json/README.org new file mode 100644 index 0000000000..be669e3f32 --- /dev/null +++ b/borrowed/guile-json/README.org @@ -0,0 +1,165 @@ + +* guile-json + +guile-json is a JSON module for Guile. It supports parsing and +building JSON documents according to the http://json.org +specification. + +- Complies with http://json.org specification. + +- Builds JSON documents programmatically using scheme data types. + +- Allows JSON pretty printing. + + +* Installation + +Download the latest tarball and untar it: + +- [[http://download.savannah.gnu.org/releases/guile-json/guile-json-3.1.0.tar.gz][guile-json-3.1.0.tar.gz]] + +If you are cloning the repository make sure you run this first: + + : $ autoreconf -vif + +Then, run the typical sequence: + + : $ ./configure --prefix= + : $ make + : $ sudo make install + +Where should preferably be the same as your system Guile +installation directory (e.g. /usr). + +If everything installed successfully you should be up and running: + + : $ guile + : scheme@(guile-user)> (use-modules (json)) + : scheme@(guile-user)> (scm->json #(1 2 3)) + : [1,2,3] + +It might be that you installed guile-json somewhere differently than +your system's Guile. If so, you need to indicate Guile where to find +guile-json, for example: + + : $ GUILE_LOAD_PATH=/usr/local/share/guile/site guile + +A pkg-list.scm file is also provided for users of the +Guildhall/Dorodango packaging system. + + +* Usage + +guile-json provides a few procedures to parse and build a JSON +document. A JSON document is transformed into or from native Guile +values according to the following table: + +| JSON | Guile | +|--------+--------| +| string | string | +| number | number | +| object | alist | +| array | vector | +| true | #t | +| false | #f | +| null | #nil | + +To start using guile-json procedures and macros you first need to load +the module: + + : scheme@(guile-user)> (use-modules (json)) + + +** Procedures + +- (*json->scm* #:optional port) : Reads a JSON document from the given + port, or from the current input port if none is given. + + - /port/ : is optional, it defaults to the current input port. + +- (*json-string->scm* str) : Reads a JSON document from the given + string. + +- (*scm->json* native #:optional port #:key escape unicode pretty) : Creates a + JSON document from the given native Guile value. The JSON document is + written into the given port, or to the current output port if non is + given. + + - /port/ : it defaults to the current output port. + - /escape/ : if true, the slash (/ solidus) character will be escaped. + - /unicode/ : if true, unicode characters will be escaped when needed. + - /pretty/ : if true, the JSON document will be pretty printed. + +- (*scm->json-string* native #:key escape unicode pretty) : Creates a JSON + document from the given native Guile value into a string. + + - /escape/ : if true, the slash (/ solidus) character will be escaped. + - /unicode/ : if true, unicode characters will be escaped when needed. + - /pretty/ : if true, the JSON document will be pretty printed. + + Note that when using alists to build JSON objects, symbols or numbers might + be used as keys and they both will be converted to strings. + + +** Exceptions + +A /json-invalid/ exception is thrown if an error is found during the +JSON parsing. Since version 0.2.0, the /json-invalid/ exception has a +single parser argument (see predicate and accessors below). The line or +column where the error occured can be easily obtained from the parser +port (calling /port-line/ or /port-column/ on the port). + +- (*json-parser?* parser) : Tells whether the given argument is a JSON + parser record type. + +- (*json-parser-port* parser) : Get the port that the parser was reading + from. + + +** Examples + +- Build the string "hello world": + + : > (scm->json "hello world ") + : "hello world" + +- Build the [1, 2, 3] array: + + : > (scm->json #(1 2 3)) + : [1,2,3] + +- Build the object { "project" : "foo", "author" : "bar" } using an alist. See + how symbols can also be used: + + : > (scm->json '((project . foo) (author . bar))) + : {"project":"foo","author":"bar"} + +- Build the object { "values" : [ 234, 98.56 ] }: + + : > (scm->json '(("values" . #(234 98.56)))) + : {"values":[234,98.56]} + +- Build the object { "values" : [ 234, 98.56 ] } again, this time using + a variable: + + : > (define values #(234 98.56)) + : > (scm->json `(("values" . ,values))) + : {"values":[234,98.56]} + + +* License + +Copyright (C) 2013-2018 Aleix Conchillo Flaque + +guile-json 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. + +guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. diff --git a/borrowed/guile-json/configure.ac b/borrowed/guile-json/configure.ac new file mode 100644 index 0000000000..fbc1affab4 --- /dev/null +++ b/borrowed/guile-json/configure.ac @@ -0,0 +1,67 @@ +# +# configure.ac +# +# Copyright (C) 2013-2018 Aleix Conchillo Flaque +# +# This file is part of guile-json. +# +# guile-json 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. +# +# guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +# + +AC_INIT([guile-json], [3.1.0], [aconchillo@gmail.com]) +AC_CONFIG_MACRO_DIRS([m4]) +AC_CONFIG_SRCDIR(json.scm) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability]) +AM_SILENT_RULES([yes]) + +dnl We require pkg.m4 (from pkg-config) and guile.m4. +dnl Make sure they are available. +m4_pattern_forbid([PKG_CHECK_MODULES]) +m4_pattern_forbid([^GUILE_PKG]) + +dnl Check for Guile 2.x. +GUILE_PKG([3.0 2.2 2.0]) +GUILE_PROGS +GUILE_SITE_DIR + +dnl Guile prefix and libdir. +GUILE_PREFIX=`$PKG_CONFIG --print-errors --variable=prefix guile-$GUILE_EFFECTIVE_VERSION` +GUILE_LIBDIR=`$PKG_CONFIG --print-errors --variable=libdir guile-$GUILE_EFFECTIVE_VERSION` +AC_SUBST(GUILE_PREFIX) +AC_SUBST(GUILE_LIBDIR) + +AC_CONFIG_FILES([Makefile json/Makefile tests/Makefile]) +AC_CONFIG_FILES([env], [chmod +x env]) + +AC_OUTPUT + +dnl This is just for printing $libdir below. +LIBDIR=`eval echo $libdir` +LIBDIR=`eval echo $LIBDIR` +AC_SUBST([LIBDIR]) + +echo +echo "*** $PACKAGE $VERSION has been successfully configured ***" +echo +echo "$PACKAGE is using:" +echo +echo " --prefix=$prefix --libdir=$LIBDIR" +echo +echo "If you want to install in Guile system's directory re-run with:" +echo +echo " --prefix=$GUILE_PREFIX --libdir=$GUILE_LIBDIR" +echo + +# configure.ac ends here diff --git a/borrowed/guile-json/env.in b/borrowed/guile-json/env.in new file mode 100644 index 0000000000..a7355a2ecd --- /dev/null +++ b/borrowed/guile-json/env.in @@ -0,0 +1,35 @@ +#!/bin/sh +# +# Copyright (C) 2018 Aleix Conchillo Flaque +# +# This file is part of guile-json. +# +# guile-json 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. +# +# guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +# + +if test -z "$GUILE_LOAD_PATH"; then + GUILE_LOAD_PATH="@abs_top_srcdir@" +else + GUILE_LOAD_PATH="@abs_top_srcdir@":$GUILE_LOAD_PATH +fi + +if test -z "$GUILE_LOAD_COMPILED_PATH"; then + GUILE_LOAD_COMPILED_PATH="@abs_top_builddir@" +else + GUILE_LOAD_COMPILED_PATH="@abs_top_builddir@":$GUILE_LOAD_COMPILED_PATH +fi + +export GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH + +exec "$@" diff --git a/borrowed/guile-json/json.scm b/borrowed/guile-json/json.scm index 8e45f93400..3ca8dc026d 100644 --- a/borrowed/guile-json/json.scm +++ b/borrowed/guile-json/json.scm @@ -1,23 +1,21 @@ ;;; (json) --- Guile JSON implementation. -;; Copyright (C) 2013 Aleix Conchillo Flaque +;; Copyright (C) 2013-2018 Aleix Conchillo Flaque ;; ;; This file is part of guile-json. ;; -;; guile-json is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 3 of the License, or (at your option) any later version. +;; guile-json 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. ;; -;; guile-json 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 -;; Lesser General Public License for more details. +;; guile-json 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 Lesser General Public -;; License along with guile-json; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301 USA +;; You should have received a copy of the GNU General Public License +;; along with guile-json. If not, see https://www.gnu.org/licenses/. ;;; Commentary: @@ -27,8 +25,7 @@ (define-module (json) #:use-module (json builder) - #:use-module (json parser) - #:use-module (json syntax)) + #:use-module (json parser)) (define-syntax re-export-modules (syntax-rules () @@ -39,7 +36,6 @@ ...)))) (re-export-modules (json builder) - (json parser) - (json syntax)) + (json parser)) ;;; (json) ends here diff --git a/borrowed/guile-json/json/Makefile.am b/borrowed/guile-json/json/Makefile.am new file mode 100644 index 0000000000..adf5972152 --- /dev/null +++ b/borrowed/guile-json/json/Makefile.am @@ -0,0 +1,39 @@ +# +# Makefile.am +# +# Copyright (C) 2013-2018 Aleix Conchillo Flaque +# +# This file is part of guile-json. +# +# guile-json 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. +# +# guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +# + +moddir=$(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/json +objdir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/json + +SOURCES = builder.scm parser.scm + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_nodist_obj_DATA = $(GOBJECTS) + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) + +CLEANFILES = $(GOBJECTS) + +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(top_builddir)/env $(GUILD) compile $(GUILE_WARNINGS) -o "$@" "$<" diff --git a/borrowed/guile-json/json/builder.scm b/borrowed/guile-json/json/builder.scm index d235d65179..6060ac0ea1 100644 --- a/borrowed/guile-json/json/builder.scm +++ b/borrowed/guile-json/json/builder.scm @@ -1,24 +1,22 @@ ;;; (json builder) --- Guile JSON implementation. -;; Copyright (C) 2013 Aleix Conchillo Flaque +;; Copyright (C) 2013-2019 Aleix Conchillo Flaque ;; Copyright (C) 2015,2016 Jan Nieuwenhuizen ;; ;; This file is part of guile-json. ;; -;; guile-json is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 3 of the License, or (at your option) any later version. +;; guile-json 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. ;; -;; guile-json 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 -;; Lesser General Public License for more details. +;; guile-json 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 Lesser General Public -;; License along with guile-json; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301 USA +;; You should have received a copy of the GNU General Public License +;; along with guile-json. If not, see https://www.gnu.org/licenses/. ;;; Commentary: @@ -29,6 +27,7 @@ (define-module (json builder) #:use-module (ice-9 format) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) #:use-module (rnrs bytevectors) #:export (scm->json scm->json-string)) @@ -87,17 +86,22 @@ ;; Object builder functions ;; -(define (build-object-pair p port escape pretty level) +(define (build-object-pair p port escape unicode pretty level) (display (indent-string pretty level) port) - (json-build-string (car p) port escape) - (display " : " port) - (json-build (cdr p) port escape pretty level)) + (json-build-string (car p) port escape unicode) + (build-space port pretty) + (display ":" port) + (build-space port pretty) + (json-build (cdr p) port escape unicode pretty level)) (define (build-newline port pretty) (cond (pretty (newline port)))) +(define (build-space port pretty) + (cond (pretty (display " " port)))) + (define (indent-string pretty level) - (if pretty (format #f "~v_" (* 4 level)) "")) + (if pretty (format #f "~v_" (* 2 level)) "")) ;; ;; Main builder functions @@ -120,18 +124,7 @@ ((symbol? x) (symbol->string x)) (else x))) -(define (atom? x) - (or (char? x) (number? x) (string? x) (symbol? x))) - -(define (json-alist? x) - (and (pair? x) - (let loop ((x x)) - (or (null? x) - (null? (car x)) - (and (pair? (car x)) (atom? (caar x)) - (loop (cdr x))))))) - -(define (json-build-string scm port escape) +(define (json-build-string scm port escape unicode) (display "\"" port) (display (list->string @@ -146,47 +139,49 @@ ((#\cr) '(#\\ #\r)) ((#\ht) '(#\\ #\t)) ((#\/) (if escape `(#\\ ,c) (list c))) - (else (string->list (build-char-string c))))) + (else (if unicode (string->list (build-char-string c)) (list c))))) (string->list (->string scm))))) port) (display "\"" port)) -(define (json-build-array scm port escape pretty level) +(define (json-build-array scm port escape unicode pretty level) (display "[" port) (unless (null? scm) - (json-build (car scm) port escape pretty (+ level 1)) - (for-each (lambda (v) - (display ", " port) - (json-build v port escape pretty (+ level 1))) - (cdr scm))) + (vector-for-each (lambda (i v) + (if (> i 0) (display "," port)) + (build-space port pretty) + (json-build v port escape unicode pretty (+ level 1))) + scm)) (display "]" port)) -(define (json-build-object scm port escape pretty level) - (build-newline port pretty) +(define (json-build-object scm port escape unicode pretty level) + (cond ((> level 0) + (build-newline port pretty))) (simple-format port "~A{" (indent-string pretty level)) (build-newline port pretty) (let ((pairs scm)) (unless (null? pairs) - (build-object-pair (car pairs) port escape pretty (+ level 1)) + (build-object-pair (car pairs) port escape unicode pretty (+ level 1)) (for-each (lambda (p) (display "," port) (build-newline port pretty) - (build-object-pair p port escape pretty (+ level 1))) + (build-object-pair p port escape unicode pretty (+ level 1))) (cdr pairs)))) (build-newline port pretty) (simple-format port "~A}" (indent-string pretty level))) -(define (json-build scm port escape pretty level) +(define (json-number? number) + (and (number? number) (eqv? (imag-part number) 0) (finite? number))) + +(define (json-build scm port escape unicode pretty level) (cond ((eq? scm #nil) (json-build-null port)) ((boolean? scm) (json-build-boolean scm port)) - ((number? scm) (json-build-number scm port)) - ((symbol? scm) (json-build-string (symbol->string scm) port escape)) - ((string? scm) (json-build-string scm port escape)) - ((json-alist? scm) (json-build-object scm port escape pretty level)) - ((list? scm) (json-build-array scm port escape pretty level)) - ((hash-table? scm) - (json-build-object (hash-map->list cons scm) port escape pretty level)) + ((json-number? scm) (json-build-number scm port)) + ((symbol? scm) (json-build-string (symbol->string scm) port escape unicode)) + ((string? scm) (json-build-string scm port escape unicode)) + ((vector? scm) (json-build-array scm port escape unicode pretty level)) + ((pair? scm) (json-build-object scm port escape unicode pretty level)) (else (throw 'json-invalid)))) ;; @@ -195,18 +190,25 @@ (define* (scm->json scm #:optional (port (current-output-port)) - #:key (escape #f) (pretty #f)) - "Creates a JSON document from native. The argument @var{scm} contains -the native value of the JSON document. Takes one optional argument, -@var{port}, which defaults to the current output port where the JSON -document will be written." - (json-build scm port escape pretty 0)) + #:key (escape #f) (unicode #f) (pretty #f)) + "Creates a JSON document from native. The argument @var{scm} contains the +native value of the JSON document. Takes one optional argument, @var{port}, +which defaults to the current output port where the JSON document will be +written. It also takes a few key arguments: @var{escape}: if true, the +slash (/ solidus) character will be escaped, @{unicode} : if true, unicode +characters will be escaped when needed and @{pretty}: if true, the JSON +document will be pretty printed. -(define* (scm->json-string scm #:key (escape #f) (pretty #f)) - "Creates a JSON document from native into a string. The argument -@var{scm} contains the native value of the JSON document." +Note that when using alists to build JSON objects, symbols or numbers might be +used as keys and they both will be converted to strings. +" + (json-build scm port escape unicode pretty 0)) + +(define* (scm->json-string scm #:key (escape #f) (unicode #f) (pretty #f)) + "Creates a JSON document from native into a string. The argument @var{scm} +contains the native value of the JSON document." (call-with-output-string (lambda (p) - (scm->json scm p #:escape escape #:pretty pretty)))) + (scm->json scm p #:escape escape #:unicode unicode #:pretty pretty)))) ;;; (json builder) ends here diff --git a/borrowed/guile-json/json/parser.scm b/borrowed/guile-json/json/parser.scm index e285803c9d..eae6d482a5 100644 --- a/borrowed/guile-json/json/parser.scm +++ b/borrowed/guile-json/json/parser.scm @@ -1,23 +1,21 @@ ;;; (json parser) --- Guile JSON implementation. -;; Copyright (C) 2013 Aleix Conchillo Flaque +;; Copyright (C) 2013-2018 Aleix Conchillo Flaque ;; ;; This file is part of guile-json. ;; -;; guile-json is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 3 of the License, or (at your option) any later version. +;; guile-json 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. ;; -;; guile-json 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 -;; Lesser General Public License for more details. +;; guile-json 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 Lesser General Public -;; License along with guile-json; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301 USA +;; You should have received a copy of the GNU General Public License +;; along with guile-json. If not, see https://www.gnu.org/licenses/. ;;; Commentary: @@ -79,76 +77,85 @@ (define (read-exp-part parser) (let ((c (parser-peek-char parser)) (s "")) - (case c - ;; Stop parsing if whitespace found. - ((#\ht #\vt #\lf #\cr #\sp) s) - ;; We might be in an array or object, so stop here too. - ((#\, #\] #\}) s) - ;; We might have the exponential part - ((#\e #\E) - (let ((ch (parser-read-char parser)) ; current char - (sign (read-sign parser)) - (digits (read-digits parser))) - ;; If we don't have sign or digits, we have an invalid - ;; number. - (if (not (and (string-null? sign) - (string-null? digits))) - (string-append s (string ch) sign digits) - #f))) - ;; If we have a character different than e or E, we have an - ;; invalid number. - (else #f)))) + (cond + ((eof-object? c) s) + (else + (case c + ;; Stop parsing if whitespace found. + ((#\ht #\vt #\lf #\cr #\sp) s) + ;; We might be in an array or object, so stop here too. + ((#\, #\] #\}) s) + ;; We might have the exponential part + ((#\e #\E) + (let ((ch (parser-read-char parser)) ; current char + (sign (read-sign parser)) + (digits (read-digits parser))) + ;; If we don't have sign or digits, we have an invalid + ;; number. + (if (not (and (string-null? sign) + (string-null? digits))) + (string-append s (string ch) sign digits) + #f))) + ;; If we have a character different than e or E, we have an + ;; invalid number. + (else #f)))))) (define (read-real-part parser) (let ((c (parser-peek-char parser)) (s "")) - (case c - ;; Stop parsing if whitespace found. - ((#\ht #\vt #\lf #\cr #\sp) s) - ;; We might be in an array or object, so stop here too. - ((#\, #\] #\}) s) - ;; If we read . we might have a real number - ((#\.) - (let ((ch (parser-read-char parser)) - (digits (read-digits parser))) - ;; If we have digits, try to read the exponential part, - ;; otherwise we have an invalid number. - (cond - ((not (string-null? digits)) - (let ((exp (read-exp-part parser))) - (cond - (exp (string-append s (string ch) digits exp)) - (else #f)))) - (else #f)))) - ;; If we have a character different than . we might continue - ;; processing. - (else #f)))) + (cond + ((eof-object? c) s) + (else + (case c + ;; Stop parsing if whitespace found. + ((#\ht #\vt #\lf #\cr #\sp) s) + ;; We might be in an array or object, so stop here too. + ((#\, #\] #\}) s) + ;; If we read . we might have a real number + ((#\.) + (let ((ch (parser-read-char parser)) + (digits (read-digits parser))) + ;; If we have digits, try to read the exponential part, + ;; otherwise we have an invalid number. + (cond + ((not (string-null? digits)) + (let ((exp (read-exp-part parser))) + (cond + (exp (string-append s (string ch) digits exp)) + (else #f)))) + (else #f)))) + ;; If we have a character different than . we might continue + ;; processing. + (else #f)))))) (define (read-number parser) (let loop ((c (parser-peek-char parser)) (s "")) - (case c - ;; Stop parsing if whitespace found. - ((#\ht #\vt #\lf #\cr #\sp) s) - ;; We might be in an array or object, so stop here too. - ((#\, #\] #\}) s) - ((#\-) - (let ((ch (parser-read-char parser))) - (loop (parser-peek-char parser) - (string-append s (string ch))))) - ((#\0) - (let ((ch (parser-read-char parser))) - (string-append s - (string ch) - (or (read-real-part parser) - (throw 'json-invalid parser))))) - ((#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) - (let ((ch (parser-read-char parser))) - (string-append s - (string ch) - (read-digits parser) - (or (read-real-part parser) - (read-exp-part parser) - (throw 'json-invalid parser))))) - (else (throw 'json-invalid parser))))) + (cond + ((eof-object? c) s) + (else + (case c + ;; Stop parsing if whitespace found. + ((#\ht #\vt #\lf #\cr #\sp) s) + ;; We might be in an array or object, so stop here too. + ((#\, #\] #\}) s) + ((#\-) + (let ((ch (parser-read-char parser))) + (loop (parser-peek-char parser) + (string-append s (string ch))))) + ((#\0) + (let ((ch (parser-read-char parser))) + (string-append s + (string ch) + (or (read-real-part parser) + (throw 'json-invalid parser))))) + ((#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) + (let ((ch (parser-read-char parser))) + (string-append s + (string ch) + (read-digits parser) + (or (read-real-part parser) + (read-exp-part parser) + (throw 'json-invalid parser))))) + (else (throw 'json-invalid parser))))))) ;; ;; Object parsing helpers @@ -171,8 +178,7 @@ (else (throw 'json-invalid parser)))))) (define (read-object parser) - (let loop ((c (parser-peek-char parser)) - (pairs (make-hash-table))) + (let loop ((c (parser-peek-char parser)) (pairs '())) (case c ;; Skip whitespaces ((#\ht #\vt #\lf #\cr #\sp) @@ -185,8 +191,7 @@ ;; Read one pair and continue ((#\") (let ((pair (read-pair parser))) - (hash-set! pairs (car pair) (cdr pair)) - (loop (parser-peek-char parser) pairs))) + (loop (parser-peek-char parser) (cons pair pairs)))) ;; Skip comma and read more pairs ((#\,) (parser-read-char parser) @@ -208,7 +213,7 @@ ;; end of array ((#\]) (parser-read-char parser) - values) + (list->vector values)) ;; this can be any json object (else (let ((value (json-read parser))) diff --git a/borrowed/guile-json/m4/guile.m4 b/borrowed/guile-json/m4/guile.m4 new file mode 100644 index 0000000000..f18dcd1d13 --- /dev/null +++ b/borrowed/guile-json/m4/guile.m4 @@ -0,0 +1,394 @@ +## Autoconf macros for working with Guile. +## +## Copyright (C) 1998,2001, 2006, 2010, 2012, 2013, 2014 Free Software Foundation, Inc. +## +## This library is free software; you can redistribute it and/or +## modify it under the terms of the GNU Lesser General Public License +## as published by the Free Software Foundation; either version 3 of +## the License, or (at your option) any later version. +## +## This library 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 +## Lesser General Public License for more details. +## +## You should have received a copy of the GNU Lesser General Public +## License along with this library; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301 USA + +# serial 11 + +## Index +## ----- +## +## GUILE_PKG -- find Guile development files +## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs +## GUILE_FLAGS -- set flags for compiling and linking with Guile +## GUILE_SITE_DIR -- find path to Guile "site" directories +## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value +## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module +## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module +## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable +## GUILE_MODULE_EXPORTS -- check if a module exports a variable +## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable + +## Code +## ---- + +## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged +## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory). + +# GUILE_PKG -- find Guile development files +# +# Usage: GUILE_PKG([VERSIONS]) +# +# This macro runs the @code{pkg-config} tool to find development files +# for an available version of Guile. +# +# By default, this macro will search for the latest stable version of +# Guile (e.g. 2.2), falling back to the previous stable version +# (e.g. 2.0) if it is available. If no guile-@var{VERSION}.pc file is +# found, an error is signalled. The found version is stored in +# @var{GUILE_EFFECTIVE_VERSION}. +# +# If @code{GUILE_PROGS} was already invoked, this macro ensures that the +# development files have the same effective version as the Guile +# program. +# +# @var{GUILE_EFFECTIVE_VERSION} is marked for substitution, as by +# @code{AC_SUBST}. +# +AC_DEFUN([GUILE_PKG], + [PKG_PROG_PKG_CONFIG + _guile_versions_to_search="m4_default([$1], [2.2 2.0 1.8])" + if test -n "$GUILE_EFFECTIVE_VERSION"; then + _guile_tmp="" + for v in $_guile_versions_to_search; do + if test "$v" = "$GUILE_EFFECTIVE_VERSION"; then + _guile_tmp=$v + fi + done + if test -z "$_guile_tmp"; then + AC_MSG_FAILURE([searching for guile development files for versions $_guile_versions_to_search, but previously found $GUILE version $GUILE_EFFECTIVE_VERSION]) + fi + _guile_versions_to_search=$GUILE_EFFECTIVE_VERSION + fi + GUILE_EFFECTIVE_VERSION="" + _guile_errors="" + for v in $_guile_versions_to_search; do + if test -z "$GUILE_EFFECTIVE_VERSION"; then + AC_MSG_NOTICE([checking for guile $v]) + PKG_CHECK_EXISTS([guile-$v], [GUILE_EFFECTIVE_VERSION=$v], []) + fi + done + + if test -z "$GUILE_EFFECTIVE_VERSION"; then + AC_MSG_ERROR([ +No Guile development packages were found. + +Please verify that you have Guile installed. If you installed Guile +from a binary distribution, please verify that you have also installed +the development packages. If you installed it yourself, you might need +to adjust your PKG_CONFIG_PATH; see the pkg-config man page for more. +]) + fi + AC_MSG_NOTICE([found guile $GUILE_EFFECTIVE_VERSION]) + AC_SUBST([GUILE_EFFECTIVE_VERSION]) + ]) + +# GUILE_FLAGS -- set flags for compiling and linking with Guile +# +# Usage: GUILE_FLAGS +# +# This macro runs the @code{pkg-config} tool to find out how to compile +# and link programs against Guile. It sets four variables: +# @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, and +# @var{GUILE_LTLIBS}. +# +# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that +# uses Guile header files. This is almost always just one or more @code{-I} +# flags. +# +# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program +# against Guile. This includes @code{-lguile-@var{VERSION}} for the +# Guile library itself, and may also include one or more @code{-L} flag +# to tell the compiler where to find the libraries. But it does not +# include flags that influence the program's runtime search path for +# libraries, and will therefore lead to a program that fails to start, +# unless all necessary libraries are installed in a standard location +# such as @file{/usr/lib}. +# +# @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to +# libtool, respectively, to link a program against Guile. It includes flags +# that augment the program's runtime search path for libraries, so that shared +# libraries will be found at the location where they were during linking, even +# in non-standard locations. @var{GUILE_LIBS} is to be used when linking the +# program directly with the compiler, whereas @var{GUILE_LTLIBS} is to be used +# when linking the program is done through libtool. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_FLAGS], + [AC_REQUIRE([GUILE_PKG]) + PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION]) + + dnl GUILE_CFLAGS and GUILE_LIBS are already defined and AC_SUBST'd by + dnl PKG_CHECK_MODULES. But GUILE_LIBS to pkg-config is GUILE_LDFLAGS + dnl to us. + + GUILE_LDFLAGS=$GUILE_LIBS + + dnl Determine the platform dependent parameters needed to use rpath. + dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs + dnl the file gnulib/build-aux/config.rpath. + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LIBS], [$GUILE_LDFLAGS], []) + GUILE_LIBS="$GUILE_LDFLAGS $GUILE_LIBS" + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes]) + GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS" + + AC_SUBST([GUILE_EFFECTIVE_VERSION]) + AC_SUBST([GUILE_CFLAGS]) + AC_SUBST([GUILE_LDFLAGS]) + AC_SUBST([GUILE_LIBS]) + AC_SUBST([GUILE_LTLIBS]) + ]) + +# GUILE_SITE_DIR -- find path to Guile site directories +# +# Usage: GUILE_SITE_DIR +# +# This looks for Guile's "site" directories. The variable @var{GUILE_SITE} will +# be set to Guile's "site" directory for Scheme source files (usually something +# like PREFIX/share/guile/site). @var{GUILE_SITE_CCACHE} will be set to the +# directory for compiled Scheme files also known as @code{.go} files +# (usually something like +# PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/site-ccache). +# @var{GUILE_EXTENSION} will be set to the directory for compiled C extensions +# (usually something like +# PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/extensions). The latter two +# are set to blank if the particular version of Guile does not support +# them. Note that this macro will run the macros @code{GUILE_PKG} and +# @code{GUILE_PROGS} if they have not already been run. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_SITE_DIR], + [AC_REQUIRE([GUILE_PKG]) + AC_REQUIRE([GUILE_PROGS]) + AC_MSG_CHECKING(for Guile site directory) + GUILE_SITE=`$PKG_CONFIG --print-errors --variable=sitedir guile-$GUILE_EFFECTIVE_VERSION` + AC_MSG_RESULT($GUILE_SITE) + if test "$GUILE_SITE" = ""; then + AC_MSG_FAILURE(sitedir not found) + fi + AC_SUBST(GUILE_SITE) + AC_MSG_CHECKING([for Guile site-ccache directory using pkgconfig]) + GUILE_SITE_CCACHE=`$PKG_CONFIG --variable=siteccachedir guile-$GUILE_EFFECTIVE_VERSION` + if test "$GUILE_SITE_CCACHE" = ""; then + AC_MSG_RESULT(no) + AC_MSG_CHECKING([for Guile site-ccache directory using interpreter]) + GUILE_SITE_CCACHE=`$GUILE -c "(display (if (defined? '%site-ccache-dir) (%site-ccache-dir) \"\"))"` + if test $? != "0" -o "$GUILE_SITE_CCACHE" = ""; then + AC_MSG_RESULT(no) + GUILE_SITE_CCACHE="" + AC_MSG_WARN([siteccachedir not found]) + fi + fi + AC_MSG_RESULT($GUILE_SITE_CCACHE) + AC_SUBST([GUILE_SITE_CCACHE]) + AC_MSG_CHECKING(for Guile extensions directory) + GUILE_EXTENSION=`$PKG_CONFIG --print-errors --variable=extensiondir guile-$GUILE_EFFECTIVE_VERSION` + AC_MSG_RESULT($GUILE_EXTENSION) + if test "$GUILE_EXTENSION" = ""; then + GUILE_EXTENSION="" + AC_MSG_WARN(extensiondir not found) + fi + AC_SUBST(GUILE_EXTENSION) + ]) + +# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs +# +# Usage: GUILE_PROGS([VERSION]) +# +# This macro looks for programs @code{guile} and @code{guild}, setting +# variables @var{GUILE} and @var{GUILD} to their paths, respectively. +# The macro will attempt to find @code{guile} with the suffix of +# @code{-X.Y}, followed by looking for it with the suffix @code{X.Y}, and +# then fall back to looking for @code{guile} with no suffix. If +# @code{guile} is still not found, signal an error. The suffix, if any, +# that was required to find @code{guile} will be used for @code{guild} +# as well. +# +# By default, this macro will search for the latest stable version of +# Guile (e.g. 2.2). x.y or x.y.z versions can be specified. If an older +# version is found, the macro will signal an error. +# +# The effective version of the found @code{guile} is set to +# @var{GUILE_EFFECTIVE_VERSION}. This macro ensures that the effective +# version is compatible with the result of a previous invocation of +# @code{GUILE_FLAGS}, if any. +# +# As a legacy interface, it also looks for @code{guile-config} and +# @code{guile-tools}, setting @var{GUILE_CONFIG} and @var{GUILE_TOOLS}. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_PROGS], + [_guile_required_version="m4_default([$1], [$GUILE_EFFECTIVE_VERSION])" + if test -z "$_guile_required_version"; then + _guile_required_version=2.2 + fi + + _guile_candidates=guile + _tmp= + for v in `echo "$_guile_required_version" | tr . ' '`; do + if test -n "$_tmp"; then _tmp=$_tmp.; fi + _tmp=$_tmp$v + _guile_candidates="guile-$_tmp guile$_tmp $_guile_candidates" + done + + AC_PATH_PROGS(GUILE,[$_guile_candidates]) + if test -z "$GUILE"; then + AC_MSG_ERROR([guile required but not found]) + fi + + _guile_suffix=`echo "$GUILE" | sed -e 's,^.*/guile\(.*\)$,\1,'` + _guile_effective_version=`$GUILE -c "(display (effective-version))"` + if test -z "$GUILE_EFFECTIVE_VERSION"; then + GUILE_EFFECTIVE_VERSION=$_guile_effective_version + elif test "$GUILE_EFFECTIVE_VERSION" != "$_guile_effective_version"; then + AC_MSG_ERROR([found development files for Guile $GUILE_EFFECTIVE_VERSION, but $GUILE has effective version $_guile_effective_version]) + fi + + _guile_major_version=`$GUILE -c "(display (major-version))"` + _guile_minor_version=`$GUILE -c "(display (minor-version))"` + _guile_micro_version=`$GUILE -c "(display (micro-version))"` + _guile_prog_version="$_guile_major_version.$_guile_minor_version.$_guile_micro_version" + + AC_MSG_CHECKING([for Guile version >= $_guile_required_version]) + _major_version=`echo $_guile_required_version | cut -d . -f 1` + _minor_version=`echo $_guile_required_version | cut -d . -f 2` + _micro_version=`echo $_guile_required_version | cut -d . -f 3` + if test "$_guile_major_version" -gt "$_major_version"; then + true + elif test "$_guile_major_version" -eq "$_major_version"; then + if test "$_guile_minor_version" -gt "$_minor_version"; then + true + elif test "$_guile_minor_version" -eq "$_minor_version"; then + if test -n "$_micro_version"; then + if test "$_guile_micro_version" -lt "$_micro_version"; then + AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) + fi + fi + elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then + # Allow prereleases that have the right effective version. + true + else + as_fn_error $? "Guile $_guile_required_version required, but $_guile_prog_version found" "$LINENO" 5 + fi + elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then + # Allow prereleases that have the right effective version. + true + else + AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) + fi + AC_MSG_RESULT([$_guile_prog_version]) + + AC_PATH_PROGS(GUILD,[guild$_guile_suffix guild]) + AC_SUBST(GUILD) + + AC_PATH_PROGS(GUILE_CONFIG,[guile-config$_guile_suffix guile-config]) + AC_SUBST(GUILE_CONFIG) + if test -n "$GUILD"; then + GUILE_TOOLS=$GUILD + else + AC_PATH_PROGS(GUILE_TOOLS,[guile-tools$_guile_suffix guile-tools]) + fi + AC_SUBST(GUILE_TOOLS) + ]) + +# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value +# +# Usage: GUILE_CHECK_RETVAL(var,check) +# +# @var{var} is a shell variable name to be set to the return value. +# @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and +# returning either 0 or non-#f to indicate the check passed. +# Non-0 number or #f indicates failure. +# Avoid using the character "#" since that confuses autoconf. +# +AC_DEFUN([GUILE_CHECK], + [AC_REQUIRE([GUILE_PROGS]) + $GUILE -c "$2" > /dev/null 2>&1 + $1=$? + ]) + +# GUILE_MODULE_CHECK -- check feature of a Guile Scheme module +# +# Usage: GUILE_MODULE_CHECK(var,module,featuretest,description) +# +# @var{var} is a shell variable name to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v. +# @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING). +# +AC_DEFUN([GUILE_MODULE_CHECK], + [AC_MSG_CHECKING([if $2 $4]) + GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3)))) + if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi + AC_MSG_RESULT($$1) + ]) + +# GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module +# +# Usage: GUILE_MODULE_AVAILABLE(var,module) +# +# @var{var} is a shell variable name to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# +AC_DEFUN([GUILE_MODULE_AVAILABLE], + [GUILE_MODULE_CHECK($1,$2,0,is available) + ]) + +# GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable +# +# Usage: GUILE_MODULE_REQUIRED(symlist) +# +# @var{symlist} is a list of symbols, WITHOUT surrounding parens, +# like: ice-9 common-list. +# +AC_DEFUN([GUILE_MODULE_REQUIRED], + [GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1)) + if test "$ac_guile_module_required" = "no" ; then + AC_MSG_ERROR([required guile module not found: ($1)]) + fi + ]) + +# GUILE_MODULE_EXPORTS -- check if a module exports a variable +# +# Usage: GUILE_MODULE_EXPORTS(var,module,modvar) +# +# @var{var} is a shell variable to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{modvar} is the Guile Scheme variable to check. +# +AC_DEFUN([GUILE_MODULE_EXPORTS], + [GUILE_MODULE_CHECK($1,$2,$3,exports `$3') + ]) + +# GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable +# +# Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar) +# +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{modvar} is the Guile Scheme variable to check. +# +AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT], + [GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2) + if test "$guile_module_required_export" = "no" ; then + AC_MSG_ERROR([module $1 does not export $2; required]) + fi + ]) + +## guile.m4 ends here diff --git a/borrowed/guile-json/pkg-list.scm.in b/borrowed/guile-json/pkg-list.scm.in new file mode 100644 index 0000000000..4b90963d0a --- /dev/null +++ b/borrowed/guile-json/pkg-list.scm.in @@ -0,0 +1,29 @@ +;; +;; Copyright (C) 2013-2018 Aleix Conchillo Flaque +;; +;; This file is part of guile-json. +;; +;; guile-json 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. +;; +;; guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +;; + +(package (json (%VERSION%)) + (depends (srfi-1)) + (synopsis "JSON parser/writer for Guile") + (description + "guile-json supports the parsing and writing of JSON from Guile." + "It aims to be fully compliant with the json.org specification, and" + "is released under the GPLv3.") + (homepage "https://github.com/aconchillo/guile-json") + (libraries "json.scm" "json") + (documentation "README" "COPYING")) diff --git a/borrowed/guile-json/tests/Makefile.am b/borrowed/guile-json/tests/Makefile.am new file mode 100644 index 0000000000..bd3a801571 --- /dev/null +++ b/borrowed/guile-json/tests/Makefile.am @@ -0,0 +1,31 @@ +# +# Makefile.am +# +# Copyright (C) 2018 Aleix Conchillo Flaque +# +# This file is part of guile-json. +# +# guile-json 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. +# +# guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. +# + +TESTS = test-builder.scm test-parser.scm + +TEST_EXTENSIONS = .scm + +SCM_LOG_COMPILER = $(GUILE) +AM_SCM_LOG_FLAGS = --no-auto-compile -L $(top_srcdir) + +CLEANFILES = $(TESTS:%.scm=%.log) + +EXTRA_DIST = $(TESTS) runner.scm diff --git a/borrowed/guile-json/tests/runner.scm b/borrowed/guile-json/tests/runner.scm new file mode 100644 index 0000000000..b934c4f693 --- /dev/null +++ b/borrowed/guile-json/tests/runner.scm @@ -0,0 +1,57 @@ +;;; (tests runner) --- Guile JSON implementation. + +;; Copyright (C) 2018 Aleix Conchillo Flaque +;; +;; This file is part of guile-json. +;; +;; guile-json 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. +;; +;; guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. + +;;; Commentary: + +;; Test runner. This has been copied from GNU Cash. + +;;; Code: + +(define-module (tests runner) + #:use-module (srfi srfi-64) + #:export (json:test-runner)) + +(define (json:test-runner) + (let ((runner (test-runner-null)) + (num-passed 0) + (num-failed 0)) + (test-runner-on-test-end! runner + (lambda (runner) + (format #t "[~a] line:~a, test: ~a\n" + (test-result-ref runner 'result-kind) + (test-result-ref runner 'source-line) + (test-runner-test-name runner)) + (case (test-result-kind runner) + ((pass xpass) (set! num-passed (1+ num-passed))) + ((fail xfail) + (if (test-result-ref runner 'expected-value) + (format #t "~a\n -> expected: ~s\n -> obtained: ~s\n" + (string-join (test-runner-group-path runner) "/") + (test-result-ref runner 'expected-value) + (test-result-ref runner 'actual-value))) + (set! num-failed (1+ num-failed))) + (else #t)))) + (test-runner-on-final! runner + (lambda (runner) + (format #t "Source:~a\npass = ~a, fail = ~a\n" + (test-result-ref runner 'source-file) num-passed num-failed) + (zero? num-failed))) + runner)) + +;;; (tests runner) ends here diff --git a/borrowed/guile-json/tests/test-builder.scm b/borrowed/guile-json/tests/test-builder.scm new file mode 100644 index 0000000000..673d94b064 --- /dev/null +++ b/borrowed/guile-json/tests/test-builder.scm @@ -0,0 +1,82 @@ +;;; (tests test-builder) --- Guile JSON implementation. + +;; Copyright (C) 2018, 2019 Aleix Conchillo Flaque +;; +;; This file is part of guile-json. +;; +;; guile-json 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. +;; +;; guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. + +;;; Commentary: + +;; Unit tests the JSON builder + +;;; Code: + +(define-module (tests test-builder) + #:use-module (srfi srfi-64) + #:use-module (json) + #:use-module (tests runner)) + +(test-runner-factory json:test-runner) + +(test-begin "test-builder") + +;; Numbers +(test-equal "1234" (scm->json-string 1234)) +(test-equal "-1234" (scm->json-string -1234)) +(test-equal "-54.897" (scm->json-string -54.897)) +(test-equal "1000.0" (scm->json-string 1e3)) +(test-equal "0.001" (scm->json-string 1e-3)) +(test-equal "0.5" (scm->json-string 1/2)) +(test-equal "0.75" (scm->json-string 3/4)) +(test-error #t (scm->json-string 1+2i)) +(test-error #t (scm->json-string +inf.0)) +(test-error #t (scm->json-string -inf.0)) +(test-error #t (scm->json-string +nan.0)) + + +;; Strings +(test-equal "\"hello guile!\"" (scm->json-string "hello guile!")) +(test-equal "\"你好 guile!\"" (scm->json-string "你好 guile!")) +(test-equal "\"\\u4f60\\u597d guile!\"" (scm->json-string "你好 guile!" #:unicode #t)) +(test-equal "\"\"" (scm->json-string "")) +(test-equal "\"<\\/script>\"" (scm->json-string "" #:escape #t)) + +;; Boolean +(test-equal "true" (scm->json-string #t)) +(test-equal "false" (scm->json-string #f)) + +;; Null +(test-equal "null" (scm->json-string #nil)) + +;; Arrays +(test-equal "[]" (scm->json-string #())) +(test-equal "[1,2,3,4]" (scm->json-string #(1 2 3 4))) +(test-equal "[1,2,[3,4],[5,6,[7,8]]]" (scm->json-string #(1 2 #(3 4) #(5 6 #(7 8))))) +(test-equal "[1,\"two\",3,\"four\"]" (scm->json-string #(1 "two" 3 "four"))) + +;; Objects +(test-equal "{\"foo\":\"bar\"}" (scm->json-string '((foo . bar)))) +(test-equal "{\"foo\":\"bar\"}" (scm->json-string '(("foo" . "bar")))) +(test-equal "{\"foo\":[1,2,3]}" (scm->json-string '((foo . #(1 2 3))))) +(test-equal "{\"foo\":{\"bar\":[1,2,3]}}" (scm->json-string '((foo . ((bar . #(1 2 3))))))) +(test-equal "{\"foo\":[1,{\"two\":\"three\"}]}" (scm->json-string '((foo . #(1 (("two" . "three"))))))) +(test-equal "{\"title\":\"A book\",\"author\":\"An author\",\"price\":29.99}" + (scm->json-string '((title . "A book") + (author . "An author") + (price . 29.99)))) + +(exit (if (test-end "test-builder") 0 1)) + +;;; (tests test-builder) ends here diff --git a/borrowed/guile-json/tests/test-parser.scm b/borrowed/guile-json/tests/test-parser.scm new file mode 100644 index 0000000000..e3acb80d28 --- /dev/null +++ b/borrowed/guile-json/tests/test-parser.scm @@ -0,0 +1,76 @@ +;;; (tests test-parser) --- Guile JSON implementation. + +;; Copyright (C) 2018 Aleix Conchillo Flaque +;; +;; This file is part of guile-json. +;; +;; guile-json 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. +;; +;; guile-json 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 guile-json. If not, see https://www.gnu.org/licenses/. + +;;; Commentary: + +;; Unit tests the JSON parser + +;;; Code: + +(define-module (tests test-parser) + #:use-module (srfi srfi-64) + #:use-module (json) + #:use-module (tests runner)) + +(test-runner-factory json:test-runner) + +(test-begin "test-parser") + +;; Numbers +(test-equal 1234 (json-string->scm "1234")) +(test-equal -1234 (json-string->scm "-1234")) +(test-equal -54.897 (json-string->scm "-54.897")) +(test-equal 1000.0 (json-string->scm "1e3")) +(test-equal 0.001 (json-string->scm "1E-3")) + +;; Strings +(test-equal "hello guile!" (json-string->scm "\"hello guile!\"")) +(test-equal "你好 guile!" (json-string->scm "\"你好 guile!\"")) +(test-equal "你好 guile!" (json-string->scm "\"\\u4f60\\u597d guile!\"")) + +;; Boolean +(test-equal #t (json-string->scm "true")) +(test-equal #f (json-string->scm "false")) + +;; Null +(test-equal #nil (json-string->scm "null")) + +;; Arrays +(test-equal #() (json-string->scm "[]")) +(test-equal #(1 2 3 4) (json-string->scm "[1,2,3,4]")) +(test-equal #(1 2 #(3 4) #(5 6 #(7 8))) (json-string->scm "[1,2,[3,4],[5,6,[7,8]]]" )) +(test-equal #(1 "two" 3 "four") (json-string->scm "[1,\"two\",3,\"four\"]")) + +;; Objects +(test-equal '(("foo" . "bar")) (json-string->scm "{\"foo\":\"bar\"}")) +(test-equal '(("foo" . "bar")) (json-string->scm "{\"foo\":\"bar\"}")) +(test-equal '(("foo" . #(1 2 3))) (json-string->scm "{\"foo\":[1,2,3]}")) +(test-equal '(("foo" . (("bar" . #(1 2 3))))) (json-string->scm "{\"foo\":{\"bar\":[1,2,3]}}")) +(test-equal '(("foo" . #(1 (("two" . "three"))))) (json-string->scm "{\"foo\":[1,{\"two\":\"three\"}]}")) + +;; Since the following JSON object contains more than one key-value pair, we +;; can't use "test-equal" directly since the output could be unordered. +(define book (json-string->scm "{\"title\":\"A book\",\"author\":\"An author\",\"price\":29.99}")) +(test-equal "A book" (assoc-ref book "title")) +(test-equal "An author" (assoc-ref book "author")) +(test-equal 29.99 (assoc-ref book "price")) + +(exit (if (test-end "test-parser") 0 1)) + +;;; (tests test-parser) ends here