diff --git a/Makefile.am b/Makefile.am index 6786bd7327..5370b104af 100644 --- a/Makefile.am +++ b/Makefile.am @@ -253,6 +253,7 @@ dist_patch_DATA = \ gnu/packages/patches/procps-make-3.82.patch \ gnu/packages/patches/qemu-multiple-smb-shares.patch \ gnu/packages/patches/readline-link-ncurses.patch \ + gnu/packages/patches/scheme48-tests.patch \ gnu/packages/patches/tar-gets-undeclared.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/teckit-cstdio.patch \ diff --git a/gnu/packages/patches/scheme48-tests.patch b/gnu/packages/patches/scheme48-tests.patch new file mode 100644 index 0000000000..7ee228f3aa --- /dev/null +++ b/gnu/packages/patches/scheme48-tests.patch @@ -0,0 +1,36 @@ +The test case below relies on /etc/groups and similar info that is +not available in chroot builds, so skip it. + +--- scheme48-1.9/scheme/posix/check.scm 2013-05-11 21:55:36.000000000 +0200 ++++ scheme48-1.9/scheme/posix/check.scm 2013-05-11 21:55:40.000000000 +0200 +@@ -229,29 +229,7 @@ + + ; This assumes that we are not running as root and that / is owned by root. + +-(define-test-case users&groups posix-core-tests +- (let ((my-info (get-file-info directory-name)) +- (root-info (get-file-info "/"))) +- (let ((my-user (user-id->user-info (file-info-owner my-info))) +- (root-user (user-id->user-info (file-info-owner root-info))) +- (my-group (group-id->group-info (file-info-group my-info))) +- (root-group (group-id->group-info (file-info-group root-info)))) +- (let ((my-other-user (name->user-info (user-info-name my-user))) +- (my-other-group (name->group-info (group-info-name my-group)))) +- (check-that (file-info-owner my-info) +- (is user-id=? (user-info-id my-user))) +- (check-that (file-info-owner root-info) +- (opposite (is user-id=? (user-info-id my-user)))) +- (check-that (file-info-group my-info) +- (is group-id=? (group-info-id my-group))) +- ;; doesn't work reliably +- ;; (specifically, if the user is member of wheel) +- ;; (check (not (group-id=? (file-info-group root-info) +- ;; (group-info-id my-group)))) +- (check-that (os-string->string (user-info-name root-user)) +- (member-of '("root" +- "bin" ; AIX +- ))))))) ++ + + (define-test-case environment posix-core-tests + (let ((env (reverse (environment-alist)))) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 13f1002090..c79a709ecd 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -295,3 +295,27 @@ mashups, office (web agendas, mail clients, ...), etc.") produces portable and efficient C, supports almost all of the R5RS Scheme language standard, and includes many enhancements and extensions.") (license bsd-3))) + +(define-public scheme48 + (package + (name "scheme48") + (version "1.9") + (source (origin + (method url-fetch) + (uri (string-append "http://s48.org/" version + "/scheme48-" version ".tgz")) + (sha256 + (base32 + "0rw2lz5xgld0klvld292ds6hvfk5l12vskzgf1hhwjdpa38r3fnw")))) + (build-system gnu-build-system) + (arguments `(#:patches (list (assoc-ref %build-inputs "patch/tests")))) + (inputs `(("patch/tests" ,(search-patch "scheme48-tests.patch")))) + (home-page "http://s48.org/") + (synopsis "Scheme implementation using a bytecode interpreter") + (description + "Scheme 48 is an implementation of Scheme based on a byte-code +interpreter and is designed to be used as a testbed for experiments in +implementation techniques and as an expository tool.") + + ;; Most files are BSD-3; see COPYING for the few exceptions. + (license bsd-3)))