From 9ebc9ca070a21ba0aeb3f61202a8071bb250ccc8 Mon Sep 17 00:00:00 2001 From: Attila Lendvai Date: Tue, 21 Dec 2021 22:56:10 +0100 Subject: tests: Move keys into ./tests/keys/ and add a third ed25519 key. The third key will be used in an upcoming commit. Rename public keys to .pub. * guix/tests/gnupg.scm (%ed25519-3-public-key-file): New variable. (%ed25519-3-secret-key-file): New variable. (%ed25519-2-public-key-file): Renamed from %ed25519bis-public-key-file. (%ed25519-2-secret-key-file): Renamed from %ed25519bis-secret-key-file. * tests/keys/ed25519-3.key: New file. * tests/keys/ed25519-3.sec: New file. Signed-off-by: Mathieu Othacehe --- Makefile.am | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index c4ccee65f1..d39052521b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -653,16 +653,18 @@ EXTRA_DIST += \ build-aux/update-guix-package.scm \ build-aux/update-NEWS.scm \ tests/test.drv \ - tests/signing-key.pub \ - tests/signing-key.sec \ tests/cve-sample.json \ - tests/civodul.key \ - tests/rsa.key \ - tests/dsa.key \ - tests/ed25519.key \ - tests/ed25519.sec \ - tests/ed25519bis.key \ - tests/ed25519bis.sec \ + tests/keys/signing-key.pub \ + tests/keys/signing-key.sec \ + tests/keys/civodul.pub \ + tests/keys/rsa.pub \ + tests/keys/dsa.pub \ + tests/keys/ed25519.pub \ + tests/keys/ed25519.sec \ + tests/keys/ed25519-2.pub \ + tests/keys/ed25519-2.sec \ + tests/keys/ed25519-3.pub \ + tests/keys/ed25519-3.sec \ build-aux/config.rpath \ bootstrap \ doc/build.scm \ -- cgit v1.2.3 From ccd9d07de083a1b232a8b939959e27d4acac45bf Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Tue, 28 Dec 2021 23:26:09 -0500 Subject: build: Fix typo in Makefile. * Makefile.am (release): Fix tense of "produce" --- Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index d39052521b..8c5682a1c6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -963,7 +963,7 @@ release: dist-with-updated-version all --system=$$system --fallback \ gnu/system/install.scm` ; \ if [ ! -f "$$image" ] ; then \ - echo "failed to produced Guix installation image for $$system" >&2 ; \ + echo "failed to produce Guix installation image for $$system" >&2 ; \ exit 1 ; \ fi ; \ cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" ; \ @@ -978,7 +978,7 @@ release: dist-with-updated-version all --system=$$system --fallback \ gnu/system/examples/vm-image.tmpl` ; \ if [ ! -f "$$image" ] ; then \ - echo "failed to produced Guix VM image for $$system" >&2 ; \ + echo "failed to produce Guix VM image for $$system" >&2 ; \ exit 1 ; \ fi ; \ cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.qcow2"; \ -- cgit v1.2.3 From a644f88d28ff9914cd3147ea085804f230acf499 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 3 Dec 2021 22:20:25 +0100 Subject: Add (guix cpu). * guix/cpu.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/cpu.scm | 143 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+) create mode 100644 guix/cpu.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 8c5682a1c6..3f06ef8991 100644 --- a/Makefile.am +++ b/Makefile.am @@ -81,6 +81,7 @@ MODULES = \ guix/base64.scm \ guix/ci.scm \ guix/cpio.scm \ + guix/cpu.scm \ guix/deprecation.scm \ guix/docker.scm \ guix/records.scm \ diff --git a/guix/cpu.scm b/guix/cpu.scm new file mode 100644 index 0000000000..e1911f52a8 --- /dev/null +++ b/guix/cpu.scm @@ -0,0 +1,143 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 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 (guix cpu) + #:use-module (guix sets) + #:use-module (guix memoization) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:export (current-cpu + cpu? + cpu-architecture + cpu-family + cpu-model + cpu-flags + + cpu->gcc-architecture)) + +;;; Commentary: +;;; +;;; This module provides tools to determine the micro-architecture supported +;;; by the CPU and to map it to a name known to GCC's '-march'. +;;; +;;; Code: + +;; CPU description. +(define-record-type + (cpu architecture family model flags) + cpu? + (architecture cpu-architecture) ;string, from 'uname' + (family cpu-family) ;integer + (model cpu-model) ;integer + (flags cpu-flags)) ;set of strings + +(define current-cpu + (mlambda () + "Return a record representing the host CPU." + (define (prefix? prefix) + (lambda (str) + (string-prefix? prefix str))) + + (call-with-input-file "/proc/cpuinfo" + (lambda (port) + (let loop ((family #f) + (model #f)) + (match (read-line port) + ((? eof-object?) + #f) + ((? (prefix? "cpu family") str) + (match (string-tokenize str) + (("cpu" "family" ":" family) + (loop (string->number family) model)))) + ((? (prefix? "model") str) + (match (string-tokenize str) + (("model" ":" model) + (loop family (string->number model))) + (_ + (loop family model)))) + ((? (prefix? "flags") str) + (match (string-tokenize str) + (("flags" ":" flags ...) + (cpu (utsname:machine (uname)) + family model (list->set flags))))) + (_ + (loop family model)))))))) + +(define (cpu->gcc-architecture cpu) + "Return the architecture name, suitable for GCC's '-march' flag, that +corresponds to CPU, a record as returned by 'current-cpu'." + (match (cpu-architecture cpu) + ("x86_64" + ;; Transcribed from GCC's 'host_detect_local_cpu' in driver-i386.c. + (or (and (= 6 (cpu-family cpu)) ;the "Pentium Pro" family + (letrec-syntax ((model (syntax-rules (=>) + ((_) #f) + ((_ (candidate => integers ...) rest + ...) + (or (and (= (cpu-model cpu) integers) + candidate) + ... + (model rest ...)))))) + (model ("bonnel" => #x1c #x26) + ("silvermont" => #x37 #x4a #x4d #x5a #x5d) + ("core2" => #x0f #x17 #x1d) + ("nehalem" => #x1a #x1e #x1f #x2e) + ("westmere" => #x25 #x2c #x2f) + ("sandybridge" => #x2a #x2d) + ("ivybridge" => #x3a #x3e) + ("haswell" => #x3c #x3f #x45 #x46) + ("broadwell" => #x3d #x47 #x4f #x56) + ("skylake" => #x4e #x5e #x8e #x9e) + ("skylake-avx512" => #x55) ;TODO: cascadelake + ("knl" => #x57) + ("cannonlake" => #x66) + ("knm" => #x85)))) + + ;; Fallback case for non-Intel processors or for Intel processors not + ;; recognized above. + (letrec-syntax ((if-flags (syntax-rules (=>) + ((_) + #f) + ((_ (flags ... => name) rest ...) + (if (every (lambda (flag) + (set-contains? (cpu-flags cpu) + flag)) + '(flags ...)) + name + (if-flags rest ...)))))) + (if-flags ("avx512" => "knl") + ("adx" => "broadwell") + ("avx2" => "haswell") + ;; TODO: tigerlake, cooperlake, etc. + ("avx" => "sandybridge") + ("sse4_2" "gfni" => "tremont") + ("sse4_2" "sgx" => "goldmont-plus") + ("sse4_2" "xsave" => "goldmont") + ("sse4_2" "movbe" => "silvermont") + ("sse4_2" => "nehalem") + ("ssse3" "movbe" => "bonnell") + ("ssse3" => "core2"))) + + ;; TODO: Recognize AMD models (bdver*, znver*, etc.)? + + "x86_64")) + (architecture + ;; TODO: AArch64. + architecture))) -- cgit v1.2.3 From 064c367716f88b7662b6b8e0d9dbd5eab941c25f Mon Sep 17 00:00:00 2001 From: Sarah Morgensen Date: Wed, 5 Jan 2022 14:07:47 +0000 Subject: guix hash: Extract file hashing procedures. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash): Extract hashing logic to... * guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this new file. Modified-by: Maxime Devos Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + guix/hash.scm | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/hash.scm | 22 +++------------- 3 files changed, 78 insertions(+), 18 deletions(-) create mode 100644 guix/hash.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 3f06ef8991..d6aabac261 100644 --- a/Makefile.am +++ b/Makefile.am @@ -100,6 +100,7 @@ MODULES = \ guix/extracting-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ + guix/hash.scm \ guix/swh.scm \ guix/monads.scm \ guix/monad-repl.scm \ diff --git a/guix/hash.scm b/guix/hash.scm new file mode 100644 index 0000000000..3cb68e5c44 --- /dev/null +++ b/guix/hash.scm @@ -0,0 +1,73 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Sarah Morgensen +;;; Copyright © 2022 Maxime Devos +;;; +;;; 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 (guix hash) + #:use-module (gcrypt hash) + #:use-module (guix serialization) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:export (vcs-file? + file-hash*)) + +(define (vcs-file? file stat) + "Returns true if FILE is a version control system file." + (case (stat:type stat) + ((directory) + (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + ((regular) + ;; Git sub-modules have a '.git' file that is a regular text file. + (string=? (basename file) ".git")) + (else + #f))) + +(define* (file-hash* file #:key + (algorithm (hash-algorithm sha256)) + (recursive? 'auto) + (select? (negate vcs-file?))) + "Compute the hash of FILE with ALGORITHM. + +Symbolic links are only dereferenced if RECURSIVE? is false. +Directories are only supported if RECURSIVE? is #true or 'auto'. +The executable bit is only recorded if RECURSIVE? is #true. +If FILE is a symbolic link, it is only followed if RECURSIVE? is false. + +For regular files, there are two different hashes when the executable +hash isn't recorded: the regular hash and the nar hash. In most situations, +the regular hash is desired and setting RECURSIVE? to 'auto' does the right +thing for both regular files and directories. + +This procedure must only be used under controlled circumstances; +the detection of symbolic links in FILE is racy. + +When FILE is a directory, the procedure SELECT? called as (SELECT? FILE STAT) +decides which files to include. By default, version control files are +excluded. To include everything, SELECT? can be set to (const #true)." + (if (or (eq? recursive? #true) + (and (eq? recursive? 'auto) + ;; Don't change this to (eq? 'directory ...), because otherwise + ;; if 'file' denotes a symbolic link, the 'file-hash' below + ;; would dereference it -- dereferencing symbolic links would + ;; open an avoidable can of potential worms. + (not (eq? 'regular (stat:type (lstat file)))))) + (let-values (((port get-hash) + (open-hash-port algorithm))) + (write-file file port #:select? select?) + (force-output port) + (get-hash)) + (file-hash algorithm file))) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index c44a4de9a4..9715dc7779 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2016 Jan Nieuwenhuizen ;;; Copyright © 2018 Tim Gesthuizen ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2021 Sarah Morgensen ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ (define-module (guix scripts hash) #:use-module (gcrypt hash) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix hash) #:use-module (guix scripts) #:use-module (guix base16) #:use-module (guix base32) @@ -46,20 +48,14 @@ (define-module (guix scripts hash) (define* (nar-hash file #:optional (algorithm (assoc-ref %default-options 'hash-algorithm)) select?) - (let-values (((port get-hash) - (open-hash-port algorithm))) - (write-file file port #:select? select?) - (force-output port) - (get-hash))) + (file-hash* file #:algorithm algorithm #:select? select? #:recursive? #true)) (define* (default-hash file #:optional (algorithm (assoc-ref %default-options 'hash-algorithm)) select?) (match file ("-" (port-hash algorithm (current-input-port))) - (_ - (call-with-input-file file - (cute port-hash algorithm <>))))) + (_ (file-hash* file #:algorithm algorithm #:recursive? #false)))) (define* (git-hash file #:optional (algorithm (assoc-ref %default-options 'hash-algorithm)) @@ -181,16 +177,6 @@ (define (parse-options) (parse-command-line args %options (list %default-options) #:build-options? #f)) - (define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) -- cgit v1.2.3 From 0f9e73841e5841224b8f1f63098baa649090df4e Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Fri, 17 Dec 2021 19:59:05 +0100 Subject: gnu: renpy: Move renpy command to aux-files. * gnu/packages/aux-files/renpy/renpy.in: New file. * gnu/packages/game-development.scm (renpy)[install]: Use renpy.in with substitute*. * Makefile.am (AUX_FILES): Add it here. --- Makefile.am | 1 + gnu/packages/aux-files/renpy/renpy.in | 48 +++++++++++++++++++++++++ gnu/packages/game-development.scm | 68 +++++------------------------------ 3 files changed, 57 insertions(+), 60 deletions(-) create mode 100644 gnu/packages/aux-files/renpy/renpy.in (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index d6aabac261..077586eda7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -405,6 +405,7 @@ AUX_FILES = \ gnu/packages/aux-files/pack-audit.c \ gnu/packages/aux-files/python/sanity-check.py \ gnu/packages/aux-files/python/sitecustomize.py \ + gnu/packages/aux-files/renpy/renpy.in \ gnu/packages/aux-files/run-in-namespace.c # Templates, examples. diff --git a/gnu/packages/aux-files/renpy/renpy.in b/gnu/packages/aux-files/renpy/renpy.in new file mode 100644 index 0000000000..914a735fa4 --- /dev/null +++ b/gnu/packages/aux-files/renpy/renpy.in @@ -0,0 +1,48 @@ +#! @PYTHON@ +# -*- mode: python -*- + +from __future__ import print_function + +import os +import sys +import warnings + +def path_to_common(renpy_base): + return renpy_base + "/common" + +def path_to_saves(gamedir, save_directory=None): + import renpy + + if save_directory is None: + save_directory = renpy.config.save_directory + save_directory = renpy.exports.fsencode(save_directory) + + if not save_directory: + return gamedir + "/saves" + + return os.path.join(os.path.expanduser("~/.renpy"), save_directory) + +def main(): + try: + import renpy.bootstrap + import renpy.arguments + except ImportError: + print("""Could not import renpy.bootstrap. +Please ensure you decompressed Ren'py correctly, preserving the directory +structure.""", file=sys.stderr) + raise + + args = renpy.arguments.bootstrap() + if not args.basedir: + print("""This Ren'py requires a basedir to launch. +The basedir is the directory, in which .rpy source files or compiled .rpyc files +live -- usually the 'game' subdirectory of a game packaged by Ren'py. + +If you want the Ren'py launcher, use \"renpy-launcher\" instead.""", + file=sys.stderr) + sys.exit() + + renpy.bootstrap.bootstrap("@RENPY_BASE@") + +if __name__ == "__main__": + main() diff --git a/gnu/packages/game-development.scm b/gnu/packages/game-development.scm index 43c604567d..5bd8615649 100644 --- a/gnu/packages/game-development.scm +++ b/gnu/packages/game-development.scm @@ -1448,70 +1448,17 @@ (define-public renpy ;; `-- Super Awesome Game.sh (let* ((out (assoc-ref outputs "out")) (bin/renpy (string-append out "/bin/renpy"))) - (mkdir-p (string-append out "/bin")) (copy-recursively "renpy/common" (string-append out "/share/renpy/common")) (copy-recursively "gui" (string-append out "/share/renpy/gui")) - (call-with-output-file bin/renpy - (lambda (port) - (format port "#!~a/bin/python2~%" - (assoc-ref inputs "python2")) - (format port " -from __future__ import print_function - -import os -import sys -import warnings - -def path_to_common(renpy_base): - return renpy_base + \"/common\" - -def path_to_saves(gamedir, save_directory=None): - import renpy # @UnresolvedImport - - if save_directory is None: - save_directory = renpy.config.save_directory - save_directory = renpy.exports.fsencode(save_directory) - - if not save_directory: - return gamedir + \"/saves\" - - return os.path.expanduser(\"~~/.renpy/\" + save_directory) - -def path_to_renpy_base(): - return \"~a\" - -def main(): - renpy_base = path_to_renpy_base() - try: - import renpy.bootstrap - import renpy.arguments - except ImportError: - print(\"\"\"Could not import renpy.bootstrap. -Please ensure you decompressed Ren'Py correctly, preserving the directory -structure.\"\"\", file=sys.stderr) - raise - - args = renpy.arguments.bootstrap() - if not args.basedir: - print(\"\"\"This Ren'py requires a basedir to launch. -The basedir is the directory, in which .rpy files live -- usually the 'game' -subdirectory of a game packaged by Ren'py. - -If you want the Ren'py launcher, use renpy-launcher instead.\"\"\", - file=sys.stderr) - sys.exit() - - renpy.bootstrap.bootstrap(renpy_base) - -if __name__ == \"__main__\": - main() -" - (string-append out "/share/renpy")))) - (chmod bin/renpy #o755) - #t))) + (mkdir-p (string-append out "/bin")) + (copy-file (assoc-ref inputs "renpy.in") bin/renpy) + (substitute* bin/renpy + (("@PYTHON@") (search-input-file inputs "bin/python2")) + (("@RENPY_BASE@") (string-append out "/share/renpy"))) + (chmod bin/renpy #o755)))) (add-after 'install 'install-games (lambda* (#:key outputs #:allow-other-keys) @@ -1565,7 +1512,8 @@ (define* (install-renpy-game #:key output game name (renpy renpy) inputs)))))))) #t)))))) (inputs - `(("python2-renpy" ,python2-renpy) + `(("renpy.in" ,(search-auxiliary-file "renpy/renpy.in")) + ("python2-renpy" ,python2-renpy) ("python2-tkinter" ,python-2 "tk") ("python2" ,python-2) ; for ‘fix-commands’ and ‘wrap’ ("xdg-utils" ,xdg-utils))) -- cgit v1.2.3 From 81f036bfd23fb6e0f381ced2de27762fa9d1bb65 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 6 Jan 2022 20:50:12 +0000 Subject: import/github: Test it. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Makefile.am (SCM_TESTS): Register new tests. * guix/import/github.scm (%github-api): New variable. (fetch-releases-or-tags): Use the new variable. * tests/import-github.scm: New file with tests. Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + guix/import/github.scm | 9 ++-- tests/import-github.scm | 139 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 146 insertions(+), 3 deletions(-) create mode 100644 tests/import-github.scm (limited to 'Makefile.am') diff --git a/Makefile.am b/Makefile.am index 077586eda7..a10aeb817b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -483,6 +483,7 @@ SCM_TESTS = \ tests/hackage.scm \ tests/home-import.scm \ tests/import-git.scm \ + tests/import-github.scm \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ diff --git a/guix/import/github.scm b/guix/import/github.scm index 1adfb8d281..8c1898c0c5 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -39,7 +39,10 @@ (define-module (guix import github) #:use-module (guix upstream) #:use-module (guix http-client) #:use-module (web uri) - #:export (%github-updater)) + #:export (%github-api %github-updater)) + +;; For tests. +(define %github-api (make-parameter "https://api.github.com")) (define (find-extension url) "Return the extension of the archive e.g. '.tar.gz' given a URL, or @@ -150,11 +153,11 @@ (define (fetch-releases-or-tags url) 'https://api.github.com/repos/aconchillo/guile-json/releases' returns the empty list." (define release-url - (string-append "https://api.github.com/repos/" + (string-append (%github-api) "/repos/" (github-user-slash-repository url) "/releases")) (define tag-url - (string-append "https://api.github.com/repos/" + (string-append (%github-api) "/repos/" (github-user-slash-repository url) "/tags")) diff --git a/tests/import-github.scm b/tests/import-github.scm new file mode 100644 index 0000000000..979a0fc12b --- /dev/null +++ b/tests/import-github.scm @@ -0,0 +1,139 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Maxime Devos +;;; +;;; 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-import-github) + #:use-module (json) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-64) + #:use-module (guix git-download) + #:use-module (guix http-client) + #:use-module (guix import github) + #:use-module (guix packages) + #:use-module (guix tests) + #:use-module (guix upstream) + #:use-module (ice-9 match)) + +(test-begin "github") + +(define (call-with-releases thunk tags releases) + (mock ((guix http-client) http-fetch + (lambda* (uri #:key headers) + (unless (string-prefix? "mock://" uri) + (error "the URI ~a should not be used" uri)) + (define components + (string-split (substring uri 8) #\/)) + (pk 'stuff components headers) + (define (scm->json-port scm) + (open-input-string (scm->json-string scm))) + (match components + (("repos" "foo" "foomatics" "releases") + (scm->json-port releases)) + (("repos" "foo" "foomatics" "tags") + (scm->json-port tags)) + (rest (error "TODO ~a" rest))))) + (parameterize ((%github-api "mock://")) + (thunk)))) + +;; Copied from tests/minetest.scm +(define (upstream-source->sexp upstream-source) + (define url (upstream-source-urls upstream-source)) + (unless (git-reference? url) + (error "a is expected")) + `(,(upstream-source-package upstream-source) + ,(upstream-source-version upstream-source) + ,(git-reference-url url) + ,(git-reference-commit url))) + +(define* (expected-sexp new-version new-commit) + `("foomatics" ,new-version "https://github.com/foo/foomatics" ,new-commit)) + +(define (example-package old-version old-commit) + (package + (name "foomatics") + (version old-version) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/foo/foomatics") + (commit old-commit))) + (sha256 #f) ; not important for following tests + (file-name (git-file-name name version)))) + (build-system #f) + (license #f) + (synopsis #f) + (description #f) + (home-page #f))) + +(define* (found-sexp old-version old-commit tags releases) + (and=> + (call-with-releases (lambda () + ((upstream-updater-latest %github-updater) + (example-package old-version old-commit))) + tags releases) + upstream-source->sexp)) + +(define-syntax-rule (test-release test-case old-version + old-commit new-version new-commit + tags releases) + (test-equal test-case + (expected-sexp new-version new-commit) + (found-sexp old-version old-commit tags releases))) + +(test-release "newest release is choosen" + "1.0.0" "v1.0.0" "1.9" "v1.9" + #() + ;; a mixture of current, older and newer versions + #((("tag_name" . "v0.0")) + (("tag_name" . "v1.0.1")) + (("tag_name" . "v1.9")) + (("tag_name" . "v1.0.0")) + (("tag_name" . "v1.0.2")))) + +(test-release "tags are used when there are no formal releases" + "1.0.0" "v1.0.0" "1.9" "v1.9" + ;; a mixture of current, older and newer versions + #((("name" . "v0.0")) + (("name" . "v1.0.1")) + (("name" . "v1.9")) + (("name" . "v1.0.0")) + (("name" . "v1.0.2"))) + #()) + +(test-release "\"version-\" prefixes are recognised" + "1.0.0" "v1.0.0" "1.9" "version-1.9" + #((("name" . "version-1.9"))) + #()) + +(test-release "prefixes are optional" + "1.0.0" "v1.0.0" "1.9" "1.9" + #((("name" . "1.9"))) + #()) + +(test-release "prefixing by package name is acceptable" + "1.0.0" "v1.0.0" "1.9" "foomatics-1.9" + #((("name" . "foomatics-1.9"))) + #()) + +(test-release "not all prefixes are acceptable" + "1.0.0" "v1.0.0" "1.0.0" "v1.0.0" + #((("name" . "v1.0.0")) + (("name" . "barstatics-1.9"))) + #()) + +(test-end "github") -- cgit v1.2.3