~ruther/guix-local

f7ce90e7b94bc06aae8a28d493242969fbe7737c — Ludovic Courtès 13 years ago 35ff176
gnu: Add Scheme48.

* gnu/packages/scheme.scm (scheme48): New variable.
* gnu/packages/patches/scheme48-tests.patch: New file.
* Makefile.am (dist_patch_DATA): Add it.
3 files changed, 61 insertions(+), 0 deletions(-)

M Makefile.am
A gnu/packages/patches/scheme48-tests.patch
M gnu/packages/scheme.scm
M Makefile.am => Makefile.am +1 -0
@@ 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			\

A gnu/packages/patches/scheme48-tests.patch => gnu/packages/patches/scheme48-tests.patch +36 -0
@@ 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))))

M gnu/packages/scheme.scm => gnu/packages/scheme.scm +24 -0
@@ 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)))