;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès ;;; ;;; 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 . (define-module (test-packages) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix hash) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix build-system) #:use-module (guix build-system t
aboutsummaryrefslogtreecommitdiff
blob: 4258bf6fe509a2945e1fd5de814f1ed5e91cc23b (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 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 mysql)
  #:use-module (gnu packages)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages openssl)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages ncurses)
  #:use-module ((guix licenses) #:select (gpl2))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu))

(define-public mysql
  (package
    (name "mysql")
    (version "5.1.54")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "http://downloads.mysql.com/archives/mysql-5.1/mysql-"
                   version ".tar.gz"))
             (sha256
              (base32
               "07xbnwk7h1xya8s6dw34nrv7ampzag8l0l1szd2pc9zyqkzhydw4"))))
    (build-system gnu-build-system)
    (inputs
     `(("procps" ,procps)
       ("openssl" ,openssl)
       ("perl" ,perl)
       ("zlib" ,zlib)
       ("ncurses" ,ncurses)))
    (arguments
     '(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (ice-9 ftw))                    ; for "rm -rf"
       #:phases (alist-cons-after
                 'install 'clean-up
                 (lambda* (#:key outputs #:allow-other-keys)
                   ;; Remove the 112 MiB of tests that get installed.
                   (let ((out (assoc-ref outputs "out")))
                     (define (rm-rf dir)
                       (file-system-fold (const #t) ; enter?
                                         (lambda (file stat result) ; leaf
                                           (delete-file file))
                                         (const #t)               ; down
                                         (lambda (dir stat result) ; up
                                           (rmdir dir))
                                         (const #t)
                                         (lambda (file stat errno result)
                                           (format (current-error-port)
                                                   "error: ~a: ~a~%"
                                                   file (strerror errno)))
                                         #t
                                         (string-append out "/" dir)))
                     (rm-rf "mysql-test")
                     (rm-rf "sql-bench")

                     ;; Compress the 14 MiB Info file.
                     (zero?
                      (system* "gzip" "--best"
                               (string-append out "/share/info/mysql.info")))))
                 %standard-phases)))
    (home-page "http://www.mysql.com/")
    (synopsis "A fast, easy to use, and popular database")
    (description
     "MySQL is a fast, reliable, and easy to use relational database
management system that supports the standardized Structured Query
Language.")
    (license gpl2)))
(begin (mkdir %output) (call-with-output-file (string-append %output "/test") (lambda (p) (display '(hello guix) p)))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk 'drv d (derivation->output-path d)))) (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) (test-assert "trivial with local file as input" (let* ((i (search-path %load-path "ice-9/boot-9.scm")) (p (package (inherit (dummy-package "trivial-with-input-file")) (build-system trivial-build-system) (source #f) (arguments `(#:guile ,%bootstrap-guile #:builder (copy-file (assoc-ref %build-inputs "input") %output))) (inputs `(("input" ,i))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk 'drv d (derivation->output-path d)))) (equal? (call-with-input-file p get-bytevector-all) (call-with-input-file i get-bytevector-all)))))) (test-assert "trivial with source" (let* ((i (search-path %load-path "ice-9/boot-9.scm")) (p (package (inherit (dummy-package "trivial-with-source")) (build-system trivial-build-system) (source i) (arguments `(#:guile ,%bootstrap-guile #:builder (copy-file (assoc-ref %build-inputs "source") %output))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (derivation->output-path d))) (equal? (call-with-input-file p get-bytevector-all) (call-with-input-file i get-bytevector-all)))))) (test-assert "trivial with system-dependent input" (let* ((p (package (inherit (dummy-package "trivial-system-dependent-input")) (build-system trivial-build-system) (source #f) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out")) (bash (assoc-ref %build-inputs "bash"))) (zero? (system* bash "-c" (format #f "echo hello > ~a" out)))))) (inputs `(("bash" ,(search-bootstrap-binary "bash" (%current-system))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk 'drv d (derivation->output-path d)))) (eq? 'hello (call-with-input-file p read)))))) (test-assert "search paths" (let* ((p (make-prompt-tag "return-search-paths")) (s (build-system (name "raw") (description "Raw build system with direct store access") (build (lambda* (store name source inputs #:key outputs system search-paths) search-paths)))) (x (list (search-path-specification (variable "GUILE_LOAD_PATH") (directories '("share/guile/site/2.0"))) (search-path-specification (variable "GUILE_LOAD_COMPILED_PATH") (directories '("share/guile/site/2.0"))))) (a (package (inherit (dummy-package "guile")) (build-system s) (native-search-paths x))) (b (package (inherit (dummy-package "guile-foo")) (build-system s) (inputs `(("guile" ,a))))) (c (package (inherit (dummy-package "guile-bar")) (build-system s) (inputs `(("guile" ,a) ("guile-foo" ,b)))))) (let-syntax ((collect (syntax-rules () ((_ body ...) (call-with-prompt p (lambda () body ...) (lambda (k search-paths) search-paths)))))) (and (null? (collect (package-derivation %store a))) (equal? x (collect (package-derivation %store b))) (equal? x (collect (package-derivation %store c))))))) (test-assert "package-cross-derivation" (let ((drv (package-cross-derivation %store (dummy-package "p") "mips64el-linux-gnu"))) (and (derivation? drv) (file-exists? (derivation-file-name drv))))) (test-assert "package-cross-derivation, trivial-build-system" (let ((p (package (inherit (dummy-package "p")) (build-system trivial-build-system) (arguments '(#:builder (exit 1)))))) (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu"))) (derivation? drv)))) (test-assert "package-cross-derivation, no cross builder" (let* ((b (build-system (inherit trivial-build-system) (cross-build #f))) (p (package (inherit (dummy-package "p")) (build-system b)))) (guard (c ((package-cross-build-system-error? c) (eq? (package-error-package c) p))) (package-cross-derivation %store p "mips64el-linux-gnu") #f))) (unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) (test-skip 1)) (test-assert "GNU Make, bootstrap" ;; GNU Make is the first program built during bootstrap; we choose it ;; here so that the test doesn't last for too long. (let ((gnu-make (@@ (gnu packages base) gnu-make-boot0))) (and (package? gnu-make) (or (location? (package-location gnu-make)) (not (package-location gnu-make))) (let* ((drv (package-derivation %store gnu-make)) (out (derivation->output-path drv))) (and (build-derivations %store (list drv)) (file-exists? (string-append out "/bin/make"))))))) (test-eq "fold-packages" hello (fold-packages (lambda (p r) (if (string=? (package-name p) "hello") p r)) #f)) (test-assert "find-packages-by-name" (match (find-packages-by-name "hello") (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) (test-end "packages") (exit (= (test-runner-fail-count (test-runner-current)) 0)) ;;; Local Variables: ;;; eval: (put 'dummy-package 'scheme-indent-function 1) ;;; End: