;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Fredrik Salomonsson <plattfot@posteo.net>
;;;
;;; 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 (test build-emacs-utils)
  #:use-module (guix tests)
  #:use-module (guix build emacs-utils)
  #:use-module (guix build utils)
  #:use-module ((guix utils)
                #:select (call-with-temporary-directory))
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-64))

(test-begin "build-emacs-utils")
;; Only run the following tests if emacs is present.
(test-skip (if (which "emacs") 0 5))

(test-equal "emacs-batch-script: print foo from emacs"
  "foo"
  (emacs-batch-script '(princ "foo")))

(test-assert "emacs-batch-script: raise &emacs-batch-error on failure"
  (guard (c ((emacs-batch-error? c)
             ;; The error message format changed between Emacs 27 and Emacs
             ;; 28.
             (string-match "[Ww]rong.*argument.*numberp.*\"three\""
                           (emacs-batch-error-message c))))
    (emacs-batch-script '(mapcar 'number-to-string (list 1 2 "three")))))

(call-with-temporary-directory
 (lambda (directory)
   (let ((mock-elisp-file (string-append directory "/foo.el")))
     (call-with-output-file mock-elisp-file
       (lambda (port)
         (display ";;; foo --- mock emacs package -*- lexical-binding: t -*-

;; Created: 4 Jun 2022
;; Keywords: lisp test
;; Version: 1.0.0
;;; Commentary:
;;; Code:
;;; foo.el ends here
"
                  port)))
     (test-equal "emacs-header-parse: fetch version"
       "1.0.0"
       (emacs-header-parse "version" mock-elisp-file))
     (test-equal "emacs-header-parse: fetch keywords"
       "lisp test"
       (emacs-header-parse "keywords" mock-elisp-file))
     (test-equal "emacs-header-parse: fetch nonexistent author"
       "nil"
       (emacs-header-parse "author" mock-elisp-file)))))

(test-end "build-emacs-utils")
(out (url-fetch* %store (string-append "file://" (canonicalize-path file)) 'sha256 hash))) (and (file-exists? out) (valid-path? %store out)))) (test-equal "git-fetch, file URI" '("." ".." "a.txt" "b.scm") (let ((nonce (random-text))) (with-temporary-git-repository directory `((add "a.txt" ,nonce) (add "b.scm" "#t") (commit "Commit.") (tag "v1.0.0" "The tag.")) (run-with-store %store (mlet* %store-monad ((hash -> (file-hash* directory #:algorithm (hash-algorithm sha256) #:recursive? #t)) (drv (git-fetch (git-reference (url (string-append "file://" directory)) (commit "v1.0.0")) 'sha256 hash "git-fetch-test"))) (mbegin %store-monad (built-derivations (list drv)) (return (scandir (derivation->output-path drv))))))))) (test-assert "gnu-build-system" (build-system? gnu-build-system)) (define unpack (assoc-ref %standard-phases 'unpack)) (define compressors '(("gzip" . "gz") ("xz" . "xz") ("bzip2" . "bz2") (#f . #f))) (for-each (match-lambda ((comp . ext) (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries (test-equal (string-append "gnu-build-system unpack phase, " "single file (compression: " (if comp comp "None") ")") "expected text" (let*-values (((name) "test") ((compressed-name) (if ext (string-append name "." ext) name)) ((file hash) (test-file %store compressed-name "expected text"))) (call-with-temporary-directory (lambda (dir) (with-directory-excursion dir (unpack #:source file) (call-with-input-file name get-string-all)))))))) compressors) ;;; ;;; Test the sanity-check phase of the Python build system. ;;; (define* (make-python-dummy name #:key (setup-py-extra "") (init-py "") (use-setuptools? #t)) (dummy-package (string-append "python-dummy-" name) (version "0.1") (build-system python-build-system) (arguments `(#:tests? #f #:use-setuptools? ,use-setuptools? #:phases (modify-phases %standard-phases (replace 'unpack (lambda _ (mkdir-p "dummy") (with-output-to-file "dummy/__init__.py" (lambda _ (display ,init-py))) (with-output-to-file "setup.py" (lambda _ (format #t "\ ~a setup( name='dummy-~a', version='0.1', packages=['dummy'], ~a )" (if ,use-setuptools? "from setuptools import setup" "from distutils.core import setup") ,name ,setup-py-extra)))))))))) (define python-dummy-ok (make-python-dummy "ok")) ;; distutil won't install any metadata, so make sure our script does not fail ;; on a otherwise fine package. (define python-dummy-no-setuptools (make-python-dummy "no-setuptools" #:use-setuptools? #f)) (define python-dummy-fail-requirements (make-python-dummy "fail-requirements" #:setup-py-extra "install_requires=['nonexistent'],")) (define python-dummy-fail-import (make-python-dummy "fail-import" #:init-py "import nonexistent")) (define python-dummy-fail-console-script (make-python-dummy "fail-console-script" #:setup-py-extra (string-append "entry_points={'console_scripts': " "['broken = dummy:nonexistent']},"))) (define (check-build-success store p) (unless store (test-skip 1)) (test-assert (string-append "python-build-system: " (package-name p)) (let* ((drv (package-derivation store p))) (build-derivations store (list drv))))) (define (check-build-failure store p) (unless store (test-skip 1)) (test-assert (string-append "python-build-system: " (package-name p)) (let ((drv (package-derivation store p))) (guard (c ((store-protocol-error? c) (pk 'failure c #t))) ;good! (build-derivations store (list drv)) #f)))) ;bad: it should have failed (with-external-store store (for-each (lambda (p) (check-build-success store p)) (list python-dummy-ok python-dummy-no-setuptools)) (for-each (lambda (p) (check-build-failure store p)) (list python-dummy-fail-requirements python-dummy-fail-import python-dummy-fail-console-script))) (test-end "builders")