Merge branch 'master' into core-updates
Conflicts: gnu/packages/libwebsockets.scm
This commit is contained in:
Ludovic Courtès
commit
829ecd002e
|
|
@ -66,7 +66,11 @@
|
|||
(long-description . ,(package-description package))
|
||||
(license . ,(package-license package))
|
||||
(home-page . ,(package-home-page package))
|
||||
(maintainers . ("bug-guix@gnu.org"))))
|
||||
(maintainers . ("bug-guix@gnu.org"))
|
||||
|
||||
;; Work around versions of 'hydra-eval-guile-jobs' before Hydra commit
|
||||
;; 61448ca (27 Feb. 2014) which used a default timeout of 2h.
|
||||
(timeout . 72000)))
|
||||
|
||||
(define (package-job store job-name package system)
|
||||
"Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
|
||||
|
|
|
|||
|
|
@ -132,7 +132,6 @@ GNU_SYSTEM_MODULES = \
|
|||
gnu/packages/libunistring.scm \
|
||||
gnu/packages/libusb.scm \
|
||||
gnu/packages/libunwind.scm \
|
||||
gnu/packages/libwebsockets.scm \
|
||||
gnu/packages/lightning.scm \
|
||||
gnu/packages/linux.scm \
|
||||
gnu/packages/lout.scm \
|
||||
|
|
@ -146,6 +145,7 @@ GNU_SYSTEM_MODULES = \
|
|||
gnu/packages/maths.scm \
|
||||
gnu/packages/mit-krb5.scm \
|
||||
gnu/packages/moe.scm \
|
||||
gnu/packages/mpd.scm \
|
||||
gnu/packages/mp3.scm \
|
||||
gnu/packages/multiprecision.scm \
|
||||
gnu/packages/mtools.scm \
|
||||
|
|
@ -206,6 +206,7 @@ GNU_SYSTEM_MODULES = \
|
|||
gnu/packages/tor.scm \
|
||||
gnu/packages/uucp.scm \
|
||||
gnu/packages/unrtf.scm \
|
||||
gnu/packages/upnp.scm \
|
||||
gnu/packages/valgrind.scm \
|
||||
gnu/packages/version-control.scm \
|
||||
gnu/packages/video.scm \
|
||||
|
|
|
|||
|
|
@ -105,14 +105,14 @@ tool to extract metadata from a file and print the results.")
|
|||
(define-public libmicrohttpd
|
||||
(package
|
||||
(name "libmicrohttpd")
|
||||
(version "0.9.32")
|
||||
(version "0.9.34")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"176qf3xhpq1wa3fd9h8b6996bjf83yna1b30lhb6ccrv67hvhm75"))))
|
||||
"122snbhhn10s8az46f0lrkirhj0k38lq7hmqav3n1prdzpabz8i9"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("curl" ,curl)
|
||||
|
|
|
|||
|
|
@ -1,73 +0,0 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; 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 (gnu packages libwebsockets)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module ((guix licenses)
|
||||
#:select (lgpl2.1))
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module ((gnu packages compression) #:select (zlib))
|
||||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages openssl))
|
||||
|
||||
(define-public libwebsockets
|
||||
(package
|
||||
(name "libwebsockets")
|
||||
(version "1.2")
|
||||
(source (origin
|
||||
;; The project does not publish tarballs, so we have to take
|
||||
;; things from Git.
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "git://git.libwebsockets.org/libwebsockets")
|
||||
(commit (string-append "v" version
|
||||
"-chrome26-firefox18"))))
|
||||
(sha256
|
||||
(base32
|
||||
"1293hbz8qj4p27m1qjf8dn97r10xjyiwdpq491m87zi025s558cl"))
|
||||
(file-name (string-append name "-" version))))
|
||||
|
||||
;; The package has both CMake and GNU build systems, but the latter is
|
||||
;; apparently better supported (CMake-generated makefiles lack an
|
||||
;; 'install' target, for instance.)
|
||||
(build-system gnu-build-system)
|
||||
|
||||
(arguments
|
||||
'(#:phases (alist-cons-before
|
||||
'configure 'bootstrap
|
||||
(lambda _
|
||||
(chmod "libwebsockets-api-doc.html" #o666)
|
||||
(zero? (system* "./autogen.sh")))
|
||||
%standard-phases)))
|
||||
(native-inputs `(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
("libtool" ,libtool "bin")
|
||||
("perl" ,perl))) ; to build the HTML doc
|
||||
(inputs `(("zlib" ,zlib)
|
||||
("openssl" ,openssl)))
|
||||
(synopsis "WebSockets library written in C")
|
||||
(description
|
||||
"libwebsockets is a library that allows C programs to establish client
|
||||
and server WebSockets connections---a protocol layered above HTTP that allows
|
||||
for efficient socket-like bidirectional reliable communication channels.")
|
||||
(home-page "http://libwebsockets.org/")
|
||||
|
||||
;; This is LGPLv2.1-only with extra exceptions specified in 'LICENSE'.
|
||||
(license lgpl2.1)))
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 David Thompson <dthompson2@worcester.edu>
|
||||
;;;
|
||||
;;; 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 (gnu packages mpd)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module ((guix licenses) #:prefix license:)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages avahi)
|
||||
#:use-module (gnu packages compression)
|
||||
#:use-module (gnu packages curl)
|
||||
#:use-module (gnu packages glib)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages mp3)
|
||||
#:use-module (gnu packages pkg-config)
|
||||
#:use-module (gnu packages pulseaudio)
|
||||
#:use-module (gnu packages sqlite)
|
||||
#:use-module (gnu packages video)
|
||||
#:use-module (gnu packages xiph)
|
||||
#:export (libmpdclient
|
||||
mpd))
|
||||
|
||||
(define libmpdclient
|
||||
(package
|
||||
(name "libmpdclient")
|
||||
(version "2.9")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://musicpd.org/download/libmpdclient/"
|
||||
(car (string-split version #\.))
|
||||
"/libmpdclient-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0csb9r3nlmbwpiryixjr5k33x3zqd61xjhwmlps3a6prck1n1xw2"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
;; FIXME: Needs doxygen.
|
||||
'(#:configure-flags '("--disable-documentation")))
|
||||
(synopsis "Music Player Daemon client library")
|
||||
(description "A stable, documented, asynchronous API library for
|
||||
interfacing MPD in the C, C++ & Objective C languages.")
|
||||
(home-page "http://www.musicpd.org/libs/libmpdclient/")
|
||||
(license license:bsd-3)))
|
||||
|
||||
(define mpd
|
||||
(package
|
||||
(name "mpd")
|
||||
(version "0.18.8")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri
|
||||
(string-append "http://musicpd.org/download/mpd/"
|
||||
(string-join (take (string-split
|
||||
version #\.) 2) ".")
|
||||
"/mpd-" version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"1ryqh0xf76xv4mpwy1gjwy275ar4wmbzifa9ccjim9r7lk2hgp5v"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("ao" ,ao)
|
||||
("alsa-lib" ,alsa-lib)
|
||||
("avahi" ,avahi)
|
||||
("curl" ,curl)
|
||||
("ffmpeg" ,ffmpeg)
|
||||
("flac" ,flac)
|
||||
("glib" ,glib)
|
||||
("lame" ,lame)
|
||||
("libid3tag" ,libid3tag)
|
||||
("libmad" ,libmad)
|
||||
("libmpdclient" ,libmpdclient)
|
||||
("libsamplerate" ,libsamplerate)
|
||||
("libsndfile" ,libsndfile)
|
||||
("libvorbis" ,libvorbis)
|
||||
("opus" ,opus)
|
||||
("pkg-config" ,pkg-config)
|
||||
("pulseaudio" ,pulseaudio)
|
||||
("sqlite" ,sqlite)
|
||||
("zlib" ,zlib)))
|
||||
;; Missing optional inputs:
|
||||
;; libyajl
|
||||
;; libcdio_paranoia
|
||||
;; libmms
|
||||
;; libadplug
|
||||
;; libaudiofile
|
||||
;; faad2
|
||||
;; fluidsynth
|
||||
;; libgme
|
||||
;; libshout
|
||||
;; libmpg123
|
||||
;; libmodplug
|
||||
;; libmpcdec
|
||||
;; libsidplay2
|
||||
;; libwavpack
|
||||
;; libwildmidi
|
||||
;; libtwolame
|
||||
;; libroar
|
||||
;; libjack
|
||||
;; OpenAL
|
||||
(synopsis "Music Player Daemon")
|
||||
(description "Music Player Daemon (MPD) is a flexible, powerful,
|
||||
server-side application for playing music. Through plugins and libraries it
|
||||
can play a variety of sound files while being controlled by its network
|
||||
protocol.")
|
||||
(home-page "http://www.musicpd.org/")
|
||||
(license license:gpl2)))
|
||||
|
|
@ -27,7 +27,7 @@
|
|||
(define-public parallel
|
||||
(package
|
||||
(name "parallel")
|
||||
(version "20140122")
|
||||
(version "20140222")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"17y72p7qwr7n0qy9nzxwhcn3q47829fd0d69gql2x6szlsxkk0xi"))))
|
||||
"0zb3hg92br6a53jn0pzfl16ffc1hfw81jk7nzw5spkshsdrcqx3y"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs `(("perl" ,perl)))
|
||||
(home-page "http://www.gnu.org/software/parallel/")
|
||||
|
|
|
|||
|
|
@ -0,0 +1,63 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
|
||||
;;;
|
||||
;;; 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 (gnu packages upnp)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages python)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix licenses)
|
||||
#:use-module (guix packages))
|
||||
|
||||
(define-public miniupnpc
|
||||
(package
|
||||
(name "miniupnpc")
|
||||
(version "1.9")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
"http://miniupnp.tuxfamily.org/files/miniupnpc-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32 "0r24jdqcyf839n30ppimdna0hvybscyziaad7ng99fw0x19y88r9"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("python" ,python-2)))
|
||||
(arguments
|
||||
;; The build system does not use a configure script but depends on
|
||||
;; `make'. Hence we should pass parameters to `make' instead and remove
|
||||
;; the configure phase.
|
||||
'(#:make-flags
|
||||
(list
|
||||
(string-append
|
||||
"SH=" (assoc-ref %build-inputs "bash") "/bin/sh")
|
||||
(string-append "INSTALLPREFIX=" (assoc-ref %outputs "out"))
|
||||
"CC=gcc")
|
||||
#:phases
|
||||
(alist-delete 'configure %standard-phases)))
|
||||
(home-page "http://miniupnp.free.fr/")
|
||||
(synopsis "Library implementing the client side UPnP protocol")
|
||||
(description
|
||||
"MiniUPnPc is a library is useful whenever an application needs to listen
|
||||
for incoming connections but is run behind a UPnP enabled router or firewall.
|
||||
Examples for such applications include: P2P applications, FTP clients for
|
||||
active mode, IRC (for DCC) or IM applications, network games, any server
|
||||
software.")
|
||||
(license
|
||||
(x11-style "file://LICENSE" "See 'LICENSE' file in the distribution"))))
|
||||
|
|
@ -35,14 +35,14 @@
|
|||
(define-public ffmpeg
|
||||
(package
|
||||
(name "ffmpeg")
|
||||
(version "2.1.3")
|
||||
(version "2.1.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"18qkdpka94rp44x17q7d2bvmw26spxf41c69nvzy31szsdzjwcqx"))))
|
||||
"00c1k84amgkc7vk5xkrg7z99q7jbfhbz3qk854cxnc38d2ynrd3z"))))
|
||||
(build-system gnu-build-system)
|
||||
(inputs
|
||||
`(("fontconfig" ,fontconfig)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013 Aljosha Papsch <misc@rpapsch.de>
|
||||
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -22,9 +23,12 @@
|
|||
#:renamer (symbol-prefix-proc 'l:))
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix download)
|
||||
#:use-module (guix git-download)
|
||||
#:use-module (guix build-system perl)
|
||||
#:use-module (guix build-system gnu)
|
||||
#:use-module (gnu packages apr)
|
||||
#:use-module (gnu packages autotools)
|
||||
#:use-module ((gnu packages compression) #:select (zlib))
|
||||
#:use-module (gnu packages openssl)
|
||||
#:use-module (gnu packages pcre)
|
||||
#:use-module (gnu packages perl))
|
||||
|
|
@ -66,6 +70,52 @@ related documentation.")
|
|||
(license l:asl2.0)
|
||||
(home-page "https://httpd.apache.org/")))
|
||||
|
||||
(define-public libwebsockets
|
||||
(package
|
||||
(name "libwebsockets")
|
||||
(version "1.2")
|
||||
(source (origin
|
||||
;; The project does not publish tarballs, so we have to take
|
||||
;; things from Git.
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "git://git.libwebsockets.org/libwebsockets")
|
||||
(commit (string-append "v" version
|
||||
"-chrome26-firefox18"))))
|
||||
(sha256
|
||||
(base32
|
||||
"1293hbz8qj4p27m1qjf8dn97r10xjyiwdpq491m87zi025s558cl"))
|
||||
(file-name (string-append name "-" version))))
|
||||
|
||||
;; The package has both CMake and GNU build systems, but the latter is
|
||||
;; apparently better supported (CMake-generated makefiles lack an
|
||||
;; 'install' target, for instance.)
|
||||
(build-system gnu-build-system)
|
||||
|
||||
(arguments
|
||||
'(#:phases (alist-cons-before
|
||||
'configure 'bootstrap
|
||||
(lambda _
|
||||
(chmod "libwebsockets-api-doc.html" #o666)
|
||||
(zero? (system* "./autogen.sh")))
|
||||
%standard-phases)))
|
||||
|
||||
(native-inputs `(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
("libtool" ,libtool "bin")
|
||||
("perl" ,perl))) ; to build the HTML doc
|
||||
(inputs `(("zlib" ,zlib)
|
||||
("openssl" ,openssl)))
|
||||
(synopsis "WebSockets library written in C")
|
||||
(description
|
||||
"libwebsockets is a library that allows C programs to establish client
|
||||
and server WebSockets connections---a protocol layered above HTTP that allows
|
||||
for efficient socket-like bidirectional reliable communication channels.")
|
||||
(home-page "http://libwebsockets.org/")
|
||||
|
||||
;; This is LGPLv2.1-only with extra exceptions specified in 'LICENSE'.
|
||||
(license l:lgpl2.1)))
|
||||
|
||||
(define-public perl-html-tagset
|
||||
(package
|
||||
(name "perl-html-tagset")
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -25,19 +26,20 @@
|
|||
#:use-module (gnu packages perl)
|
||||
#:use-module (gnu packages help2man)
|
||||
#:use-module (gnu packages ncurses)
|
||||
#:use-module (gnu packages bash))
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages pkg-config))
|
||||
|
||||
(define-public zile
|
||||
(package
|
||||
(name "zile")
|
||||
(version "2.4.9")
|
||||
(version "2.4.10")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/zile/zile-"
|
||||
version ".tar.gz"))
|
||||
(sha256
|
||||
(base32
|
||||
"0j801c28ypm924rw3lqyb6khxyslg6ycrv16wmmwcam0mk3mj6f7"))))
|
||||
"1ca2bkhl8k4n7a5d8g33ccs603p83a4h3vz9bwxcqxq43jjnwddn"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases (alist-cons-before
|
||||
|
|
@ -55,7 +57,8 @@
|
|||
("bash" ,bash)))
|
||||
(native-inputs
|
||||
`(("perl" ,perl)
|
||||
("help2man" ,help2man)))
|
||||
("help2man" ,help2man)
|
||||
("pkg-config" ,pkg-config)))
|
||||
(home-page "http://www.gnu.org/software/zile/")
|
||||
(synopsis "Zile is lossy Emacs, a lightweight Emacs clone")
|
||||
(description
|
||||
|
|
|
|||
|
|
@ -452,22 +452,22 @@ encoding conversion errors."
|
|||
(send (boolean keep-failed?) (boolean keep-going?)
|
||||
(boolean fallback?) (integer verbosity)
|
||||
(integer max-build-jobs) (integer max-silent-time))
|
||||
(if (>= (nix-server-minor-version server) 2)
|
||||
(send (boolean use-build-hook?)))
|
||||
(if (>= (nix-server-minor-version server) 4)
|
||||
(send (integer build-verbosity) (integer log-type)
|
||||
(boolean print-build-trace)))
|
||||
(if (>= (nix-server-minor-version server) 6)
|
||||
(send (integer build-cores)))
|
||||
(if (>= (nix-server-minor-version server) 10)
|
||||
(send (boolean use-substitutes?)))
|
||||
(if (>= (nix-server-minor-version server) 12)
|
||||
(send (string-list (fold-right (lambda (pair result)
|
||||
(match pair
|
||||
((h . t)
|
||||
(cons* h t result))))
|
||||
'()
|
||||
binary-caches))))
|
||||
(when (>= (nix-server-minor-version server) 2)
|
||||
(send (boolean use-build-hook?)))
|
||||
(when (>= (nix-server-minor-version server) 4)
|
||||
(send (integer build-verbosity) (integer log-type)
|
||||
(boolean print-build-trace)))
|
||||
(when (>= (nix-server-minor-version server) 6)
|
||||
(send (integer build-cores)))
|
||||
(when (>= (nix-server-minor-version server) 10)
|
||||
(send (boolean use-substitutes?)))
|
||||
(when (>= (nix-server-minor-version server) 12)
|
||||
(send (string-list (fold-right (lambda (pair result)
|
||||
(match pair
|
||||
((h . t)
|
||||
(cons* h t result))))
|
||||
'()
|
||||
binary-caches))))
|
||||
(let loop ((done? (process-stderr server)))
|
||||
(or done? (process-stderr server)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
test-approximate test-assert test-error test-apply test-with-runner
|
||||
test-match-nth test-match-all test-match-any test-match-name
|
||||
test-skip test-expect-fail test-read-eval-string
|
||||
test-runner-group-path test-group-with-cleanup
|
||||
test-runner-group-path test-group test-group-with-cleanup
|
||||
test-result-ref test-result-set! test-result-clear test-result-remove
|
||||
test-result-kind test-passed?
|
||||
test-log-to-file
|
||||
|
|
@ -35,5 +35,7 @@
|
|||
test-on-final-simple test-on-test-end-simple
|
||||
test-on-final-simple))
|
||||
|
||||
(cond-expand-provide (current-module) '(srfi-64))
|
||||
|
||||
;; Load Per Bothner's original SRFI-64 implementation.
|
||||
(load-from-path "srfi/srfi-64.upstream.scm")
|
||||
|
|
|
|||
|
|
@ -1,4 +1,8 @@
|
|||
;; Copyright (c) 2005, 2006 Per Bothner
|
||||
;; Copyright (c) 2005, 2006, 2007, 2012, 2013 Per Bothner
|
||||
;; Added "full" support for Chicken, Gauche, Guile and SISC.
|
||||
;; Alex Shinn, Copyright (c) 2005.
|
||||
;; Modified for Scheme Spheres by Álvaro Castro-Castilla, Copyright (c) 2012.
|
||||
;; Support for Guile 2 by Mark H Weaver <mhw@netris.org>, Copyright (c) 2014.
|
||||
;;
|
||||
;; Permission is hereby granted, free of charge, to any person
|
||||
;; obtaining a copy of this software and associated documentation
|
||||
|
|
@ -23,8 +27,14 @@
|
|||
(cond-expand
|
||||
(chicken
|
||||
(require-extension syntax-case))
|
||||
(guile
|
||||
(guile-2
|
||||
(use-modules (srfi srfi-9)
|
||||
;; In 2.0.9, srfi-34 and srfi-35 are not well integrated
|
||||
;; with either Guile's native exceptions or R6RS exceptions.
|
||||
;;(srfi srfi-34) (srfi srfi-35)
|
||||
(srfi srfi-39)))
|
||||
(guile
|
||||
(use-modules (ice-9 syncase) (srfi srfi-9)
|
||||
;;(srfi srfi-34) (srfi srfi-35) - not in Guile 1.6.7
|
||||
(srfi srfi-39)))
|
||||
(sisc
|
||||
|
|
@ -57,7 +67,7 @@
|
|||
test-approximate test-assert test-error test-apply test-with-runner
|
||||
test-match-nth test-match-all test-match-any test-match-name
|
||||
test-skip test-expect-fail test-read-eval-string
|
||||
test-runner-group-path test-group-with-cleanup
|
||||
test-runner-group-path test-group test-group-with-cleanup
|
||||
test-result-ref test-result-set! test-result-clear test-result-remove
|
||||
test-result-kind test-passed?
|
||||
test-log-to-file
|
||||
|
|
@ -108,7 +118,7 @@
|
|||
(> (vector-length obj) 1)
|
||||
(eq (vector-ref obj 0) %test-runner-cookie)))
|
||||
(define (alloc)
|
||||
(let ((runner (make-vector 22)))
|
||||
(let ((runner (make-vector 23)))
|
||||
(vector-set! runner 0 %test-runner-cookie)
|
||||
runner))
|
||||
(begin
|
||||
|
|
@ -156,19 +166,20 @@
|
|||
)
|
||||
|
||||
(define (test-runner-reset runner)
|
||||
(test-runner-pass-count! runner 0)
|
||||
(test-runner-fail-count! runner 0)
|
||||
(test-runner-xpass-count! runner 0)
|
||||
(test-runner-xfail-count! runner 0)
|
||||
(test-runner-skip-count! runner 0)
|
||||
(%test-runner-total-count! runner 0)
|
||||
(%test-runner-count-list! runner '())
|
||||
(%test-runner-run-list! runner #t)
|
||||
(%test-runner-skip-list! runner '())
|
||||
(%test-runner-fail-list! runner '())
|
||||
(%test-runner-skip-save! runner '())
|
||||
(%test-runner-fail-save! runner '())
|
||||
(test-runner-group-stack! runner '()))
|
||||
(test-result-alist! runner '())
|
||||
(test-runner-pass-count! runner 0)
|
||||
(test-runner-fail-count! runner 0)
|
||||
(test-runner-xpass-count! runner 0)
|
||||
(test-runner-xfail-count! runner 0)
|
||||
(test-runner-skip-count! runner 0)
|
||||
(%test-runner-total-count! runner 0)
|
||||
(%test-runner-count-list! runner '())
|
||||
(%test-runner-run-list! runner #t)
|
||||
(%test-runner-skip-list! runner '())
|
||||
(%test-runner-fail-list! runner '())
|
||||
(%test-runner-skip-save! runner '())
|
||||
(%test-runner-fail-save! runner '())
|
||||
(test-runner-group-stack! runner '()))
|
||||
|
||||
(define (test-runner-group-path runner)
|
||||
(reverse (test-runner-group-stack runner)))
|
||||
|
|
@ -232,7 +243,7 @@
|
|||
(else #t)))
|
||||
r))
|
||||
|
||||
(define (%test-specificier-matches spec runner)
|
||||
(define (%test-specifier-matches spec runner)
|
||||
(spec runner))
|
||||
|
||||
(define (test-runner-create)
|
||||
|
|
@ -243,7 +254,7 @@
|
|||
(let loop ((l list))
|
||||
(cond ((null? l) result)
|
||||
(else
|
||||
(if (%test-specificier-matches (car l) runner)
|
||||
(if (%test-specifier-matches (car l) runner)
|
||||
(set! result #t))
|
||||
(loop (cdr l)))))))
|
||||
|
||||
|
|
@ -311,12 +322,6 @@
|
|||
(log-file
|
||||
(cond-expand (mzscheme
|
||||
(open-output-file log-file-name 'truncate/replace))
|
||||
(guile-2
|
||||
(with-fluids ((%default-port-encoding
|
||||
"UTF-8"))
|
||||
(let ((p (open-output-file log-file-name)))
|
||||
(setvbuf p _IOLBF)
|
||||
p)))
|
||||
(else (open-output-file log-file-name)))))
|
||||
(display "%%%% Starting test " log-file)
|
||||
(display suite-name log-file)
|
||||
|
|
@ -469,7 +474,7 @@
|
|||
(if test-name (%test-write-result1 test-name log))
|
||||
(if source-file (%test-write-result1 source-file log))
|
||||
(if source-line (%test-write-result1 source-line log))
|
||||
(if source-file (%test-write-result1 source-form log))))))
|
||||
(if source-form (%test-write-result1 source-form log))))))
|
||||
|
||||
(define-syntax test-result-ref
|
||||
(syntax-rules ()
|
||||
|
|
@ -570,9 +575,10 @@
|
|||
((%test-evaluate-with-catch test-expression)
|
||||
(catch #t
|
||||
(lambda () test-expression)
|
||||
(lambda (key . args) #f)
|
||||
(lambda (key . args)
|
||||
(display-backtrace (make-stack #t) (current-error-port))))))))
|
||||
(test-result-set! (test-runner-current) 'actual-error
|
||||
(cons key args))
|
||||
#f))))))
|
||||
(kawa
|
||||
(define-syntax %test-evaluate-with-catch
|
||||
(syntax-rules ()
|
||||
|
|
@ -609,12 +615,27 @@
|
|||
(kawa
|
||||
(define (%test-syntax-file form)
|
||||
(syntax-source form))))
|
||||
(define-for-syntax (%test-source-line2 form)
|
||||
(define (%test-source-line2 form)
|
||||
(let* ((line (syntax-line form))
|
||||
(file (%test-syntax-file form))
|
||||
(line-pair (if line (list (cons 'source-line line)) '())))
|
||||
(cons (cons 'source-form (syntax-object->datum form))
|
||||
(if file (cons (cons 'source-file file) line-pair) line-pair)))))
|
||||
(guile-2
|
||||
(define (%test-source-line2 form)
|
||||
(let* ((src-props (syntax-source form))
|
||||
(file (and src-props (assq-ref src-props 'filename)))
|
||||
(line (and src-props (assq-ref src-props 'line)))
|
||||
(file-alist (if file
|
||||
`((source-file . ,file))
|
||||
'()))
|
||||
(line-alist (if line
|
||||
`((source-line . ,(+ line 1)))
|
||||
'())))
|
||||
(datum->syntax (syntax here)
|
||||
`((source-form . ,(syntax->datum form))
|
||||
,@file-alist
|
||||
,@line-alist)))))
|
||||
(else
|
||||
(define (%test-source-line2 form)
|
||||
'())))
|
||||
|
|
@ -645,10 +666,16 @@
|
|||
(%test-on-test-end r (comp exp res)))))
|
||||
(%test-report-result)))))
|
||||
|
||||
(define (%test-approximimate= error)
|
||||
(define (%test-approximate= error)
|
||||
(lambda (value expected)
|
||||
(and (>= value (- expected error))
|
||||
(<= value (+ expected error)))))
|
||||
(let ((rval (real-part value))
|
||||
(ival (imag-part value))
|
||||
(rexp (real-part expected))
|
||||
(iexp (imag-part expected)))
|
||||
(and (>= rval (- rexp error))
|
||||
(>= ival (- iexp error))
|
||||
(<= rval (+ rexp error))
|
||||
(<= ival (+ iexp error))))))
|
||||
|
||||
(define-syntax %test-comp1body
|
||||
(syntax-rules ()
|
||||
|
|
@ -662,12 +689,12 @@
|
|||
(%test-report-result)))))
|
||||
|
||||
(cond-expand
|
||||
((or kawa mzscheme)
|
||||
((or kawa mzscheme guile-2)
|
||||
;; Should be made to work for any Scheme with syntax-case
|
||||
;; However, I haven't gotten the quoting working. FIXME.
|
||||
(define-syntax test-end
|
||||
(lambda (x)
|
||||
(syntax-case (list x (list 'quote (%test-source-line2 x))) ()
|
||||
(syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
|
||||
(((mac suite-name) line)
|
||||
(syntax
|
||||
(%test-end suite-name line)))
|
||||
|
|
@ -676,7 +703,7 @@
|
|||
(%test-end #f line))))))
|
||||
(define-syntax test-assert
|
||||
(lambda (x)
|
||||
(syntax-case (list x (list 'quote (%test-source-line2 x))) ()
|
||||
(syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
|
||||
(((mac tname expr) line)
|
||||
(syntax
|
||||
(let* ((r (test-runner-get))
|
||||
|
|
@ -688,8 +715,8 @@
|
|||
(let* ((r (test-runner-get)))
|
||||
(test-result-alist! r line)
|
||||
(%test-comp1body r expr)))))))
|
||||
(define-for-syntax (%test-comp2 comp x)
|
||||
(syntax-case (list x (list 'quote (%test-source-line2 x)) comp) ()
|
||||
(define (%test-comp2 comp x)
|
||||
(syntax-case (list x (list (syntax quote) (%test-source-line2 x)) comp) ()
|
||||
(((mac tname expected expr) line comp)
|
||||
(syntax
|
||||
(let* ((r (test-runner-get))
|
||||
|
|
@ -709,18 +736,18 @@
|
|||
(lambda (x) (%test-comp2 (syntax equal?) x)))
|
||||
(define-syntax test-approximate ;; FIXME - needed for non-Kawa
|
||||
(lambda (x)
|
||||
(syntax-case (list x (list 'quote (%test-source-line2 x))) ()
|
||||
(syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
|
||||
(((mac tname expected expr error) line)
|
||||
(syntax
|
||||
(let* ((r (test-runner-get))
|
||||
(name tname))
|
||||
(test-result-alist! r (cons (cons 'test-name tname) line))
|
||||
(%test-comp2body r (%test-approximimate= error) expected expr))))
|
||||
(%test-comp2body r (%test-approximate= error) expected expr))))
|
||||
(((mac expected expr error) line)
|
||||
(syntax
|
||||
(let* ((r (test-runner-get)))
|
||||
(test-result-alist! r line)
|
||||
(%test-comp2body r (%test-approximimate= error) expected expr))))))))
|
||||
(%test-comp2body r (%test-approximate= error) expected expr))))))))
|
||||
(else
|
||||
(define-syntax test-end
|
||||
(syntax-rules ()
|
||||
|
|
@ -765,16 +792,30 @@
|
|||
(define-syntax test-approximate
|
||||
(syntax-rules ()
|
||||
((test-approximate tname expected expr error)
|
||||
(%test-comp2 (%test-approximimate= error) tname expected expr))
|
||||
(%test-comp2 (%test-approximate= error) tname expected expr))
|
||||
((test-approximate expected expr error)
|
||||
(%test-comp2 (%test-approximimate= error) expected expr))))))
|
||||
(%test-comp2 (%test-approximate= error) expected expr))))))
|
||||
|
||||
(cond-expand
|
||||
(guile
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
((%test-error r etype expr)
|
||||
(%test-comp1body r (catch #t (lambda () expr) (lambda (key . args) #t)))))))
|
||||
(cond ((%test-on-test-begin r)
|
||||
(let ((et etype))
|
||||
(test-result-set! r 'expected-error et)
|
||||
(%test-on-test-end r
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(test-result-set! r 'actual-value expr)
|
||||
#f)
|
||||
(lambda (key . args)
|
||||
;; TODO: decide how to specify expected
|
||||
;; error types for Guile.
|
||||
(test-result-set! r 'actual-error
|
||||
(cons key args))
|
||||
#t)))
|
||||
(%test-report-result))))))))
|
||||
(mzscheme
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
|
|
@ -791,23 +832,34 @@
|
|||
(kawa
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
((%test-error r #t expr)
|
||||
(cond ((%test-on-test-begin r)
|
||||
(test-result-set! r 'expected-error #t)
|
||||
(%test-on-test-end r
|
||||
(try-catch
|
||||
(let ()
|
||||
(test-result-set! r 'actual-value expr)
|
||||
#f)
|
||||
(ex <java.lang.Throwable>
|
||||
(test-result-set! r 'actual-error ex)
|
||||
#t)))
|
||||
(%test-report-result))))
|
||||
((%test-error r etype expr)
|
||||
(let ()
|
||||
(if (%test-on-test-begin r)
|
||||
(let ((et etype))
|
||||
(test-result-set! r 'expected-error et)
|
||||
(%test-on-test-end r
|
||||
(try-catch
|
||||
(let ()
|
||||
(test-result-set! r 'actual-value expr)
|
||||
#f)
|
||||
(ex <java.lang.Throwable>
|
||||
(test-result-set! r 'actual-error ex)
|
||||
(cond ((and (instance? et <gnu.bytecode.ClassType>)
|
||||
(gnu.bytecode.ClassType:isSubclass et <java.lang.Throwable>))
|
||||
(instance? ex et))
|
||||
(else #t)))))
|
||||
(%test-report-result))))))))
|
||||
(if (%test-on-test-begin r)
|
||||
(let ((et etype))
|
||||
(test-result-set! r 'expected-error et)
|
||||
(%test-on-test-end r
|
||||
(try-catch
|
||||
(let ()
|
||||
(test-result-set! r 'actual-value expr)
|
||||
#f)
|
||||
(ex <java.lang.Throwable>
|
||||
(test-result-set! r 'actual-error ex)
|
||||
(cond ((and (instance? et <gnu.bytecode.ClassType>)
|
||||
(gnu.bytecode.ClassType:isSubclass et <java.lang.Throwable>))
|
||||
(instance? ex et))
|
||||
(else #t)))))
|
||||
(%test-report-result)))))))
|
||||
((and srfi-34 srfi-35)
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
|
|
@ -816,15 +868,15 @@
|
|||
(and (condition? ex) (condition-has-type? ex etype)))
|
||||
((procedure? etype)
|
||||
(etype ex))
|
||||
((equal? type #t)
|
||||
((equal? etype #t)
|
||||
#t)
|
||||
(else #t))
|
||||
expr))))))
|
||||
expr #f))))))
|
||||
(srfi-34
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
((%test-error r etype expr)
|
||||
(%test-comp1body r (guard (ex (else #t)) expr))))))
|
||||
(%test-comp1body r (guard (ex (else #t)) expr #f))))))
|
||||
(else
|
||||
(define-syntax %test-error
|
||||
(syntax-rules ()
|
||||
|
|
@ -835,11 +887,11 @@
|
|||
(%test-report-result)))))))
|
||||
|
||||
(cond-expand
|
||||
((or kawa mzscheme)
|
||||
((or kawa mzscheme guile-2)
|
||||
|
||||
(define-syntax test-error
|
||||
(lambda (x)
|
||||
(syntax-case (list x (list 'quote (%test-source-line2 x))) ()
|
||||
(syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
|
||||
(((mac tname etype expr) line)
|
||||
(syntax
|
||||
(let* ((r (test-runner-get))
|
||||
|
|
@ -860,11 +912,17 @@
|
|||
(define-syntax test-error
|
||||
(syntax-rules ()
|
||||
((test-error name etype expr)
|
||||
(test-assert name (%test-error etype expr)))
|
||||
(let ((r (test-runner-get)))
|
||||
(test-result-alist! r `((test-name . ,name)))
|
||||
(%test-error r etype expr)))
|
||||
((test-error etype expr)
|
||||
(test-assert (%test-error etype expr)))
|
||||
(let ((r (test-runner-get)))
|
||||
(test-result-alist! r '())
|
||||
(%test-error r etype expr)))
|
||||
((test-error expr)
|
||||
(test-assert (%test-error #t expr)))))))
|
||||
(let ((r (test-runner-get)))
|
||||
(test-result-alist! r '())
|
||||
(%test-error r #t expr)))))))
|
||||
|
||||
(define (test-apply first . rest)
|
||||
(if (test-runner? first)
|
||||
|
|
@ -873,7 +931,7 @@
|
|||
(if r
|
||||
(let ((run-list (%test-runner-run-list r)))
|
||||
(cond ((null? rest)
|
||||
(%test-runner-run-list! r (reverse! run-list))
|
||||
(%test-runner-run-list! r (reverse run-list))
|
||||
(first)) ;; actually apply procedure thunk
|
||||
(else
|
||||
(%test-runner-run-list!
|
||||
|
|
@ -973,7 +1031,9 @@
|
|||
(let* ((port (open-input-string string))
|
||||
(form (read port)))
|
||||
(if (eof-object? (read-char port))
|
||||
(eval form)
|
||||
(cond-expand
|
||||
(guile (eval form (current-module)))
|
||||
(else (eval form)))
|
||||
(cond-expand
|
||||
(srfi-23 (error "(not at eof)"))
|
||||
(else "error")))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue