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

From: T460s laptop <[email-masked]>
Date: Fri, 29 Mar 2019 22:12:38 -0400

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.

From 37e499d5d5d5f690aa0a065c730e13f6a31dd30d Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <[email-masked]>
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 <[email-masked]>
 ;;; Copyright © 2017 Mathieu Othacehe <[email-masked]>
 ;;; Copyright © 2018 Ricardo Wurmus <[email-masked]>
+;;; Copyright © 2019 Maxim Cournoyer <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2016 Ricardo Wurmus <[email-masked]>
+;;; Copyright © 2019 Maxim Cournoyer <[email-masked]>
 ;;;
 ;;; 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