bug#24450: [PATCHv2] bug#24450: pypi importer outputs strange character series in optional dependency case.

[T460s laptop <maxim.cournoyer@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 177 bytes --]


The previous 0007 patch had broken the recursive importer.  This
reworked version fixes this.  The rest of the patches stack sent in the
previous message is still good as is.


[-- Attachment #1.2: 0007-import-pypi-Include-optional-test-inputs-as-native-i.patch --]
[-- Type: text/x-patch, Size: 23891 bytes --]

From 37e499d5d5d5f690aa0a065c730e13f6a31dd30d Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Thu, 28 Mar 2019 23:12:26 -0400
Subject: [PATCH] import: pypi: Include optional test inputs as native-inputs.

* guix/import/pypi.scm (maybe-inputs): Add INPUT-TYPE argument, and use it.
(test-section?): New predicate.
(parse-requires.txt): Collect the optional test inputs, and return them as the
second element of the returned list.
(parse-wheel-metadata): Likewise.
(guess-requirements): Adapt, and hide unzip output.
(make-pypi-sexp): Likewise, and include the test inputs requirements as native
inputs in the returned package expression.

* tests/pypi.scm (test-requires.txt): Include a test section in the
test-requires.txt data.
(test-requires.txt-beaker): New variable.
("parse-requires.txt"): Adapt.
("parse-requires.txt - Beaker"): New test.
("parse-wheel-metadata, with extras"): Adapt.
("parse-wheel-metadata, with extras - Jedi"): Adapt.
("pypi->guix-package, no wheel"): Re-indent, and add the expected
native-inputs.
("pypi->guix-package, wheels"): Likewise.
("pypi->guix-package, no usable requirement file."): New test.
---
 guix/import/pypi.scm | 195 ++++++++++++++++++++++++++++---------------
 tests/pypi.scm       | 123 ++++++++++++++++++++-------
 2 files changed, 222 insertions(+), 96 deletions(-)

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index c520213b6a..099768f0c8 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (ice-9 receive)
   #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -106,14 +108,15 @@ package on PyPI."
     ((name version _ ...)
      (string-append name "-" version ".dist-info"))))
 
-(define (maybe-inputs package-inputs)
+(define (maybe-inputs package-inputs input-type)
   "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a
-package definition."
+package definition.  INPUT-TYPE, a symbol, is used to populate the name of
+the input field."
   (match package-inputs
     (()
      '())
     ((package-inputs ...)
-     `((propagated-inputs (,'quasiquote ,package-inputs))))))
+     `((,input-type (,'quasiquote ,package-inputs))))))
 
 (define %requirement-name-regexp
   ;; Regexp to match the requirement name in a requirement specification.
@@ -147,11 +150,21 @@ package definition."
    (or (regexp-exec %requirement-name-regexp spec)
        (error (G_ "Could not extract requirement name in spec:") spec))))
 
+(define (test-section? name)
+  "Return #t if the section name contains 'test' or 'dev'."
+  (any (cut string-contains-ci name <>)
+       '("test" "dev")))
+
 (define (parse-requires.txt requires.txt)
-  "Given REQUIRES.TXT, a Setuptools requires.txt file, return a list of
-requirement names."
-  ;; This is a very incomplete parser, which job is to select the non-optional
-  ;; dependencies and strip them out of any version information.
+  "Given REQUIRES.TXT, a Setuptools requires.txt file, return a pair of requirements.
+
+The first element of the pair contains the required dependencies while the
+second the optional test dependencies.  Note that currently, optional,
+non-test dependencies are omitted since these can be difficult or expensive to
+satisfy."
+
+  ;; This is a very incomplete parser, which job is to read in the requirement
+  ;; specification lines, and strip them out of any version information.
   ;; Alternatively, we could implement a PEG parser with the (ice-9 peg)
   ;; library and the requirements grammar defined by PEP-0508
   ;; (https://www.python.org/dev/peps/pep-0508/).
@@ -168,57 +181,89 @@ requirement names."
 
   (call-with-input-file requires.txt
     (lambda (port)
-      (let loop ((result '()))
+      (let loop ((required-deps '())
+                 (test-deps '())
+                 (inside-test-section? #f)
+                 (optional? #f))
         (let ((line (read-line port)))
-          ;; Stop when a section is encountered, as sections contains optional
-          ;; (extra) requirements.  Non-optional requirements must appear
-          ;; before any section is defined.
-          (if (or (eof-object? line) (section-header? line))
+          (if (eof-object? line)
               ;; Duplicates can occur, since the same requirement can be
               ;; listed multiple times with different conditional markers, e.g.
               ;; pytest >= 3 ; python_version >= "3.3"
               ;; pytest < 3 ; python_version < "3.3"
-              (reverse (delete-duplicates result))
+              (map (compose reverse delete-duplicates)
+                   (list required-deps test-deps))
               (cond
                ((or (string-null? line) (comment? line))
-                (loop result))
-               (else
+                (loop required-deps test-deps inside-test-section? optional?))
+               ((section-header? line)
+                ;; Encountering a section means that all the requirements
+                ;; listed below are optional. Since we want to pick only the
+                ;; test dependencies from the optional dependencies, we must
+                ;; track those separately.
+                (loop required-deps test-deps (test-section? line) #t))
+               (inside-test-section?
+                (loop required-deps
+                      (cons (specification->requirement-name line)
+                            test-deps)
+                      inside-test-section? optional?))
+               ((not optional?)
                 (loop (cons (specification->requirement-name line)
-                            result))))))))))
+                            required-deps)
+                      test-deps inside-test-section? optional?))
+               (optional?
+                ;; Skip optional items.
+                (loop required-deps test-deps inside-test-section? optional?))
+               (else
+                (warning (G_ "parse-requires.txt reached an unexpected \
+condition on line ~a~%") line)))))))))
 
 (define (parse-wheel-metadata metadata)
-  "Given METADATA, a Wheel metadata file, return a list of requirement names."
+  "Given METADATA, a Wheel metadata file, return a pair of requirements.
+
+The first element of the pair contains the required dependencies while the second the optional
+test dependencies.  Note that currently, optional, non-test dependencies are
+omitted since these can be difficult or expensive to satisfy."
   ;; METADATA is a RFC-2822-like, header based file.
 
   (define (requires-dist-header? line)
     ;; Return #t if the given LINE is a Requires-Dist header.
-    (regexp-match? (string-match "^Requires-Dist: " line)))
+    (string-match "^Requires-Dist: " line))
 
   (define (requires-dist-value line)
     (string-drop line (string-length "Requires-Dist: ")))
 
   (define (extra? line)
     ;; Return #t if the given LINE is an "extra" requirement.
-    (regexp-match? (string-match "extra == " line)))
+    (string-match "extra == '(.*)'" line))
+
+  (define (test-requirement? line)
+    (let ((extra-label (match:substring (extra? line) 1)))
+      (and extra-label (test-section? extra-label))))
 
   (call-with-input-file metadata
     (lambda (port)
-      (let loop ((requirements '()))
+      (let loop ((required-deps '())
+                 (test-deps '()))
         (let ((line (read-line port)))
-          ;; Stop at the first 'Provides-Extra' section: the non-optional
-          ;; requirements appear before the optional ones.
           (if (eof-object? line)
-              (reverse (delete-duplicates requirements))
+              (map (compose reverse delete-duplicates)
+                   (list required-deps test-deps))
               (cond
                ((and (requires-dist-header? line) (not (extra? line)))
                 (loop (cons (specification->requirement-name
                              (requires-dist-value line))
-                            requirements)))
+                            required-deps)
+                      test-deps))
+               ((and (requires-dist-header? line) (test-requirement? line))
+                (loop required-deps
+                      (cons (specification->requirement-name (requires-dist-value line))
+                            test-deps)))
                (else
-                (loop requirements)))))))))
+                (loop required-deps test-deps))))))))) ;skip line
 
 (define (guess-requirements source-url wheel-url archive)
-  "Given SOURCE-URL, WHEEL-URL and a ARCHIVE of the package, return a list
+  "Given SOURCE-URL, WHEEL-URL and an ARCHIVE of the package, return a list
 of the required packages specified in the requirements.txt file.  ARCHIVE will
 be extracted in a temporary directory."
 
@@ -244,7 +289,10 @@ cannot determine package dependencies") (file-extension url))
            (metadata (string-append dirname "/METADATA")))
       (call-with-temporary-directory
        (lambda (dir)
-         (if (zero? (system* "unzip" "-q" wheel-archive "-d" dir metadata))
+         (if (zero?
+              (parameterize ((current-error-port (%make-void-port "rw+"))
+                             (current-output-port (%make-void-port "rw+")))
+                (system* "unzip" wheel-archive "-d" dir metadata)))
              (parse-wheel-metadata (string-append dir "/" metadata))
              (begin
                (warning
@@ -283,32 +331,41 @@ cannot determine package dependencies") (file-extension url))
                      (warning
                       (G_ "Failed to extract file: ~a from source.~%")
                       requires.txt)
-                     '())))))
-          '())))
+                     (list '() '()))))))
+          (list '() '()))))
 
   ;; First, try to compute the requirements using the wheel, else, fallback to
   ;; reading the "requires.txt" from the egg-info directory from the source
-  ;; tarball.
+  ;; archive.
   (or (guess-requirements-from-wheel)
       (guess-requirements-from-source)))
 
 (define (compute-inputs source-url wheel-url archive)
-  "Given the SOURCE-URL of an already downloaded ARCHIVE, return a list of
-name/variable pairs describing the required inputs of this package.  Also
+  "Given the SOURCE-URL and WHEEL-URL of an already downloaded ARCHIVE, return
+a pair of lists, each consisting of a list of name/variable pairs, for the
+propagated inputs and the native inputs, respectively.  Also
 return the unaltered list of upstream dependency names."
-  (let ((dependencies
-         (remove (cut string=? "argparse" <>)
-                 (guess-requirements source-url wheel-url archive))))
-    (values (sort
-             (map (lambda (input)
-                    (let ((guix-name (python->package-name input)))
-                      (list guix-name (list 'unquote (string->symbol guix-name)))))
-                  dependencies)
-             (lambda args
-               (match args
-                 (((a _ ...) (b _ ...))
-                  (string-ci<? a b)))))
-            dependencies)))
+
+  (define (strip-argparse deps)
+    (remove (cut string=? "argparse" <>) deps))
+
+  (define (requirement->package-name/sort deps)
+    (sort
+     (map (lambda (input)
+            (let ((guix-name (python->package-name input)))
+              (list guix-name (list 'unquote (string->symbol guix-name)))))
+          deps)
+     (lambda args
+       (match args
+         (((a _ ...) (b _ ...))
+          (string-ci<? a b))))))
+
+  (define process-requirements
+    (compose requirement->package-name/sort strip-argparse))
+
+  (let ((dependencies (guess-requirements source-url wheel-url archive)))
+    (values (map process-requirements dependencies)
+            (concatenate dependencies))))
 
 (define (make-pypi-sexp name version source-url wheel-url home-page synopsis
                         description license)
@@ -317,29 +374,33 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
   (call-with-temporary-output-file
    (lambda (temp port)
      (and (url-fetch source-url temp)
-          (receive (input-package-names upstream-dependency-names)
+          (receive (guix-dependencies upstream-dependencies)
               (compute-inputs source-url wheel-url temp)
-            (values
-             `(package
-                (name ,(python->package-name name))
-                (version ,version)
-                (source (origin
-                          (method url-fetch)
-
-                          ;; Sometimes 'pypi-uri' doesn't quite work due to mixed
-                          ;; cases in NAME, for instance, as is the case with
-                          ;; "uwsgi".  In that case, fall back to a full URL.
-                          (uri (pypi-uri ,(string-downcase name) version))
-                          (sha256
-                           (base32
-                            ,(guix-hash-url temp)))))
-                (build-system python-build-system)
-                ,@(maybe-inputs input-package-names)
-                (home-page ,home-page)
-                (synopsis ,synopsis)
-                (description ,description)
-                (license ,(license->symbol license)))
-             upstream-dependency-names))))))
+            (match guix-dependencies
+              ((required-inputs test-inputs)
+               (values
+                `(package
+                   (name ,(python->package-name name))
+                   (version ,version)
+                   (source (origin
+                             (method url-fetch)
+                             ;; Sometimes 'pypi-uri' doesn't quite work due to mixed
+                             ;; cases in NAME, for instance, as is the case with
+                             ;; "uwsgi".  In that case, fall back to a full URL.
+                             (uri (pypi-uri ,(string-downcase name) version))
+                             (sha256
+                              (base32
+                               ,(guix-hash-url temp)))))
+                   (build-system python-build-system)
+                   ,@(maybe-inputs required-inputs 'propagated-inputs)
+                   ,@(maybe-inputs test-inputs 'native-inputs)
+                   (home-page ,home-page)
+                   (synopsis ,synopsis)
+                   (description ,description)
+                   (license ,(license->symbol license)))
+                ;; Flatten the nested lists and return the upstream
+                ;; dependencies.
+                upstream-dependencies))))))))
 
 (define pypi->guix-package
   (memoize
diff --git a/tests/pypi.scm b/tests/pypi.scm
index ca8cb5f6de..aa08e2cb54 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -65,11 +66,6 @@
 sha1=da9234ee9982d4bbb3c72346a6de940a148ea686"))
 
 (define test-requires.txt "\
-bar
-baz > 13.37
-")
-
-(define test-requires-with-sections "\
 # A comment
 foo ~= 3
 bar != 2
@@ -78,12 +74,25 @@ bar != 2
 pytest (>=2.5.0)
 ")
 
+;; Beaker contains only optional dependencies.
+(define test-requires.txt-beaker "\
+[crypto]
+pycryptopp>=0.5.12
+
+[cryptography]
+cryptography
+
+[testsuite]
+Mock
+coverage
+")
+
 (define test-metadata "\
 Classifier: Programming Language :: Python :: 3.7
 Requires-Dist: baz ~= 3
 Requires-Dist: bar != 2
 Provides-Extra: test
-pytest (>=2.5.0)
+Requires-Dist: pytest (>=2.5.0) ; extra == 'test'
 ")
 
 (define test-metadata-with-extras "
@@ -137,25 +146,31 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
   '("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip")
   (map specification->requirement-name test-specifications))
 
-(test-equal "parse-requires.txt, with sections"
-  '("foo" "bar")
+(test-equal "parse-requires.txt"
+  (list '("foo" "bar") '("pytest"))
   (mock ((ice-9 ports) call-with-input-file
          call-with-input-string)
-        (parse-requires.txt test-requires-with-sections)))
+        (parse-requires.txt test-requires.txt)))
+
+(test-equal "parse-requires.txt - Beaker"
+  (list '() '("Mock" "coverage"))
+  (mock ((ice-9 ports) call-with-input-file
+         call-with-input-string)
+        (parse-requires.txt test-requires.txt-beaker)))
 
 (test-equal "parse-wheel-metadata, with extras"
-  '("wrapt" "bar")
+  (list '("wrapt" "bar") '("tox" "bumpversion"))
   (mock ((ice-9 ports) call-with-input-file
          call-with-input-string)
         (parse-wheel-metadata test-metadata-with-extras)))
 
 (test-equal "parse-wheel-metadata, with extras - Jedi"
-  '("parso")
+  (list '("parso") '("pytest"))
   (mock ((ice-9 ports) call-with-input-file
          call-with-input-string)
         (parse-wheel-metadata test-metadata-with-extras-jedi)))
 
-(test-assert "pypi->guix-package"
+(test-assert "pypi->guix-package, no wheel"
   ;; Replace network resources with sample data.
     (mock ((guix import utils) url-fetch
            (lambda (url file-name)
@@ -195,7 +210,10 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
                      ('propagated-inputs
                       ('quasiquote
                        (("python-bar" ('unquote 'python-bar))
-                        ("python-baz" ('unquote 'python-baz)))))
+                        ("python-foo" ('unquote 'python-foo)))))
+                     ('native-inputs
+                      ('quasiquote
+                       (("python-pytest" ('unquote 'python-pytest)))))
                      ('home-page "http://example.com")
                      ('synopsis "summary")
                      ('description "summary")
@@ -216,25 +234,25 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
               (begin
                 (mkdir-p "foo-1.0.0/foo.egg-info/")
                 (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt"
-                   (lambda ()
-                     (display "wrong data to make sure we're testing wheels ")))
+                  (lambda ()
+                    (display "wrong data to make sure we're testing wheels ")))
                 (parameterize ((current-output-port (%make-void-port "rw+")))
                   (system* "tar" "czvf" file-name "foo-1.0.0/"))
-                 (delete-file-recursively "foo-1.0.0")
-                 (set! test-source-hash
-                       (call-with-input-file file-name port-sha256))))
+                (delete-file-recursively "foo-1.0.0")
+                (set! test-source-hash
+                  (call-with-input-file file-name port-sha256))))
              ("https://example.com/foo-1.0.0-py2.py3-none-any.whl"
-               (begin
-                 (mkdir "foo-1.0.0.dist-info")
-                 (with-output-to-file "foo-1.0.0.dist-info/METADATA"
-                   (lambda ()
-                     (display test-metadata)))
-                 (let ((zip-file (string-append file-name ".zip")))
-                   ;; zip always adds a "zip" extension to the file it creates,
-                   ;; so we need to rename it.
-                   (system* "zip" zip-file "foo-1.0.0.dist-info/METADATA")
-                   (rename-file zip-file file-name))
-                 (delete-file-recursively "foo-1.0.0.dist-info")))
+              (begin
+                (mkdir "foo-1.0.0.dist-info")
+                (with-output-to-file "foo-1.0.0.dist-info/METADATA"
+                  (lambda ()
+                    (display test-metadata)))
+                (let ((zip-file (string-append file-name ".zip")))
+                  ;; zip always adds a "zip" extension to the file it creates,
+                  ;; so we need to rename it.
+                  (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA")
+                  (rename-file zip-file file-name))
+                (delete-file-recursively "foo-1.0.0.dist-info")))
              (_ (error "Unexpected URL: " url)))))
         (mock ((guix http-client) http-fetch
                (lambda (url . rest)
@@ -262,6 +280,9 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
                     ('quasiquote
                      (("python-bar" ('unquote 'python-bar))
                       ("python-baz" ('unquote 'python-baz)))))
+                   ('native-inputs
+                    ('quasiquote
+                     (("python-pytest" ('unquote 'python-pytest)))))
                    ('home-page "http://example.com")
                    ('synopsis "summary")
                    ('description "summary")
@@ -272,4 +293,48 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
                 (x
                  (pk 'fail x #f))))))
 
+(test-assert "pypi->guix-package, no usable requirement file."
+  ;; Replace network resources with sample data.
+  (mock ((guix import utils) url-fetch
+         (lambda (url file-name)
+           (match url
+             ("https://example.com/foo-1.0.0.tar.gz"
+              (set! test-source-hash
+                (call-with-input-file file-name port-sha256))
+              #t)
+             ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #t)
+             (_ (error "Unexpected URL: " url)))))
+        (mock ((guix http-client) http-fetch
+               (lambda (url . rest)
+                 (match url
+                   ("https://pypi.org/pypi/foo/json"
+                    (values (open-input-string test-json)
+                            (string-length test-json)))
+                   ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
+                   (_ (error "Unexpected URL: " url)))))
+              ;; Not clearing the memoization cache here would mean returning the value
+              ;; computed in the previous test.
+              (invalidate-memoization! pypi->guix-package)
+              (match (pypi->guix-package "foo")
+                (('package
+                   ('name "python-foo")
+                   ('version "1.0.0")
+                   ('source ('origin
+                              ('method 'url-fetch)
+                              ('uri ('pypi-uri "foo" 'version))
+                              ('sha256
+                               ('base32
+                                (? string? hash)))))
+                   ('build-system 'python-build-system)
+                   ('home-page "http://example.com")
+                   ('synopsis "summary")
+                   ('description "summary")
+                   ('license 'license:lgpl2.0))
+                 (string=? (bytevector->nix-base32-string
+                            test-source-hash)
+                           hash))
+                (x
+                 (pk 'fail x #f)))
+              )))
+
 (test-end "pypi")
-- 
2.20.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]