Merge branch 'master' into core-updates

4 files changed, 181 insertions, 4 deletions

diff --git a/tests/discovery.scm b/tests/discovery.scm
index b838731e16..04de83f085 100644
--- a/tests/discovery.scm
+++ b/tests/discovery.scm
@@ -32,6 +32,10 @@
     ((('guix 'import _ ...) ..1)
      #t)))
 
+(test-equal "scheme-modules, non-existent directory"
+  '()
+  (scheme-modules "/does/not/exist"))
+
 (test-assert "all-modules"
   (match (map module-name
               (all-modules `((,%top-srcdir . "guix/build-system"))))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 28cc115a9d..74f13e9662 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -131,8 +131,7 @@ baz > 13.37")
                      ('version "1.0.0")
                      ('source ('origin
                                 ('method 'url-fetch)
-                                ('uri (string-append "https://example.com/foo-"
-                                                     version ".tar.gz"))
+                                ('uri ('pypi-uri "foo" 'version))
                                 ('sha256
                                  ('base32
                                   (? string? hash)))))
@@ -194,8 +193,7 @@ baz > 13.37")
                    ('version "1.0.0")
                    ('source ('origin
                               ('method 'url-fetch)
-                              ('uri (string-append "https://example.com/foo-"
-                                                   version ".tar.gz"))
+                              ('uri ('pypi-uri "foo" 'version))
                               ('sha256
                                ('base32
                                 (? string? hash)))))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index e20f0600bc..8c048e6109 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -24,6 +24,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
+  #:use-module (system foreign)
+  #:use-module ((ice-9 ftw) #:select (scandir))
   #:use-module (ice-9 match))
 
 ;; Test the (guix build syscalls) module, although there's not much that can
@@ -184,6 +186,64 @@
                          (status:exit-val status))))
                (eq? #t result))))))))
 
+(test-equal "scandir*, ENOENT"
+  ENOENT
+  (catch 'system-error
+    (lambda ()
+      (scandir* "/does/not/exist"))
+    (lambda args
+      (system-error-errno args))))
+
+(test-equal "scandir*, ASCII file names"
+  (scandir (dirname (search-path %load-path "guix/base32.scm"))
+           (const #t) string<?)
+  (match (scandir* (dirname (search-path %load-path "guix/base32.scm")))
+    (((names . properties) ...)
+     names)))
+
+(test-equal "scandir*, UTF-8 file names"
+  '("." ".." "α" "λ")
+  (call-with-temporary-directory
+   (lambda (directory)
+     ;; Wrap 'creat' to make sure that we really pass a UTF-8-encoded file
+     ;; name to the system call.
+     (let ((creat (pointer->procedure int
+                                      (dynamic-func "creat" (dynamic-link))
+                                      (list '* int))))
+       (creat (string->pointer (string-append directory "/α")
+                               "UTF-8")
+              #o644)
+       (creat (string->pointer (string-append directory "/λ")
+                               "UTF-8")
+              #o644)
+       (let ((locale (setlocale LC_ALL)))
+         (dynamic-wind
+           (lambda ()
+             ;; Make sure that even in a C locale we get the right result.
+             (setlocale LC_ALL "C"))
+           (lambda ()
+             (match (scandir* directory)
+               (((names . properties) ...)
+                names)))
+           (lambda ()
+             (setlocale LC_ALL locale))))))))
+
+(test-assert "scandir*, properties"
+  (let ((directory (dirname (search-path %load-path "guix/base32.scm"))))
+    (every (lambda (entry name)
+             (match entry
+               ((name2 . properties)
+                (and (string=? name2 name)
+                     (let* ((full  (string-append directory "/" name))
+                            (stat  (lstat full))
+                            (inode (assoc-ref properties 'inode))
+                            (type  (assoc-ref properties 'type)))
+                       (and (= inode (stat:ino stat))
+                            (or (eq? type 'unknown)
+                                (eq? type (stat:type stat)))))))))
+           (scandir* directory)
+           (scandir directory (const #t) string<?))))
+
 (false-if-exception (delete-file temp-file))
 (test-equal "fcntl-flock wait"
   42                                              ; the child's exit status
diff --git a/tests/texlive.scm b/tests/texlive.scm
new file mode 100644
index 0000000000..e28eda175c
--- /dev/null
+++ b/tests/texlive.scm
@@ -0,0 +1,115 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.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-texlive)
+  #:use-module (gnu packages tex)
+  #:use-module (guix import texlive)
+  #:use-module (guix tests)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match))
+
+(test-begin "texlive")
+
+(define xml
+  "\
+<entry id=\"foo\">
+   <name>foo</name>
+   <caption>Foomatic frobnication in LuaLaTeX</caption>
+   <authorref id=\"rekado\"/>
+   <license type=\"lppl1.3\"/>
+   <version number=\"2.6a\"/>
+   <description>
+     <p>
+          Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals
+          in a foomatic way with the LuaTeX engine.
+     </p>
+     <p>
+          The package requires the bar and golly
+          bundles for extremely special specialties.
+     </p>
+   </description>
+   <ctan path=\"/macros/latex/contrib/foo\" file=\"true\"/>
+   <texlive location=\"foo\"/>
+   <keyval key=\"topic\" value=\"tests\"/>
+  null
+</entry>")
+
+(define sxml
+  '(*TOP* (entry (@ (id "foo"))
+                 (name "foo")
+                 (caption "Foomatic frobnication in LuaLaTeX")
+                 (authorref (@ (id "rekado")))
+                 (license (@ (type "lppl1.3")))
+                 (version (@ (number "2.6a")))
+                 (description
+                  (p "\n          Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals\n          in a foomatic way with the LuaTeX engine.\n     ")
+                  (p "\n          The package requires the bar and golly\n          bundles for extremely special specialties.\n     "))
+                 (ctan (@ (path "/macros/latex/contrib/foo") (file "true")))
+                 (texlive (@ (location "foo")))
+                 (keyval (@ (value "tests") (key "topic")))
+                 "\n  null\n")))
+
+(test-equal "fetch-sxml: returns SXML for valid XML"
+  sxml
+  (mock ((guix http-client) http-fetch
+         (lambda (url)
+           xml))
+        ((@@ (guix import texlive) fetch-sxml) "foo")))
+
+;; TODO:
+(test-assert "sxml->package"
+  ;; Replace network resources with sample data.
+  (mock ((guix build svn) svn-fetch
+         (lambda* (url revision directory
+                       #:key (svn-command "svn")
+                       (user-name #f)
+                       (password #f))
+           (mkdir-p directory)
+           (with-output-to-file (string-append directory "/foo")
+             (lambda ()
+               (display "source")))))
+        (let ((result ((@@ (guix import texlive) sxml->package) sxml)))
+          (match result
+            (('package
+               ('name "texlive-latex-foo")
+               ('version "2.6a")
+               ('source ('origin
+                          ('method 'svn-fetch)
+                          ('uri ('texlive-ref "latex" "foo"))
+                          ('sha256
+                           ('base32
+                            (? string? hash)))))
+               ('build-system 'texlive-build-system)
+               ('arguments ('quote (#:tex-directory "latex/foo")))
+               ('home-page "http://www.ctan.org/pkg/foo")
+               ('synopsis "Foomatic frobnication in LuaLaTeX")
+               ('description
+                "Foo is a package for LuaLaTeX.  It provides an interface to \
+frobnicate gimbals in a foomatic way with the LuaTeX engine.  The package \
+requires the bar and golly bundles for extremely special specialties.")
+               ('license 'lppl1.3+))
+             #t)
+            (_
+             (begin
+               (format #t "~s\n" result)
+               (pk 'fail result #f)))))))
+
+(test-end "texlive")