On Sun, Nov 15, 2015 at 9:59 PM, Ludovic Courtès <l...@gnu.org> wrote:
> Federico Beffa <be...@ieee.org> skribis:
>> * guix/import/cabal.scm (lex-word): Add support for tests with no spaces.
>> (impl): Fix handling of operator "==".
>
> LGTM, but I think it’d be great to add a test that illustrates the case
> that this fixes (and to make sure it doesn’t come back later.)
I've rewritten 'impl' and the new test that I've added covers this and more.
>> From f796d814821289a98e401a3e3df13334a2e8689b Mon Sep 17 00:00:00 2001
>> From: Federico Beffa <be...@fbengineering.ch>
>> Date: Wed, 11 Nov 2015 15:31:46 +0100
>> Subject: [PATCH 3/6] import: hackage: Make it resilient to missing final
>> newline.
>>
>> * guix/import/cabal.scm (peek-next-line-indent): Check for missing final
>> newline.
>
> [...]
>
>> + (if (eof-object? (peek-char port))
>> + ;; If the file is missing the #\newline on the last line, add it and
>> act
>> + ;; as if it were there. This is needed for propoer operation of
> ^^^^
> Typo.
>
>> + ;; indentation based block recognition.
>> + (begin (unread-char #\newline port) (read-char port) 0)
>
> Isn’t this equivalent to: 0 ?
No. This is because at the start of a new line we check if and how
many indentation blocks have ended. If the last line doesn't terminate
this check is no done.
>
> Could you add a test for this one?
I've removed the final newline from the test 'test-read-cabal-1".
>
>> From 225164d2355afd6f9455251d87cbd34b08f68cdb Mon Sep 17 00:00:00 2001
>> From: Federico Beffa <be...@fbengineering.ch>
>> Date: Wed, 11 Nov 2015 16:20:45 +0100
>> Subject: [PATCH 4/6] import: hackage: Make parsing of tests and fields more
>> flexible.
>>
>> * guix/import/cabal.scm (is-test): Allow spaces between keyword and
>> parentheses.
>> (is-id): Add argument 'port'. Allow spaces between keyword and column.
>> (lex-word): Adjust call to 'is-id'.
>
> LGTM, and would be perfect with a test. ;-)
These are now exercised in "test-read-cabal-1".
> [...]
>
>> +(test-equal "canonical-newline-port"
>> + "This is a journey"
>> + (let ((port (open-string-input-port
>> + "This is a journey\r\n")))
>> + (get-line (canonical-newline-port port))))
>
> I would rather use ‘get-string-all’ and make sure the result is exactly:
>
> "This is a journey\n"
>
> (Because ‘get-line’ could have been doing its own thing regardless of
> the EOL style.)
>
> A test with several lines, including lines with just \n would be nice.
OK. I've updated it and the test.
>
>> From c57be8cae9b3642beff1462acd32a0aee54ad7c6 Mon Sep 17 00:00:00 2001
>> From: Federico Beffa <be...@fbengineering.ch>
>> Date: Sat, 14 Nov 2015 15:15:00 +0100
>> Subject: [PATCH 6/6] import: hackage: Handle CRLF end of line style.
>>
>> * guix/import/hackage.scm (hackage-fetch, hackage->guix-package): Do it.
>
> Rather “Use ‘canonical-newline-port’.” instead of “Do it.”
OK.
I've made 1 more change. The importer now peeks at the 'ghc' package
version and uses that as default implementation. Before, without using
the '-e' option, it was assuming "ghc", but no specific version.
Regards,
Fede
From d13f06383d07e0ad4096ff7eb715264463738b0c Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 11 Nov 2015 10:39:38 +0100
Subject: [PATCH 1/8] import: hackage: Add recognition of 'true' and 'false'
symbols.
* guix/import/cabal.scm (is-true, is-false, lex-true, lex-false): New procedures.
(lex-word): Use them.
(make-cabal-parser): Add TRUE and FALSE tokens.
(eval): Add entries for 'true and 'false symbols.
---
guix/import/cabal.scm | 16 +++++++++++++++-
1 file changed, 15 insertions(+), 1 deletion(-)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 45d644a..8d84e09 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -138,7 +138,7 @@ to the stack."
"Generate a parser for Cabal files."
(lalr-parser
;; --- token definitions
- (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION
+ (CCURLY VCCURLY OPAREN CPAREN TEST ID VERSION RELATION TRUE FALSE
(right: IF FLAG EXEC TEST-SUITE SOURCE-REPO BENCHMARK LIB OCURLY)
(left: OR)
(left: PROPERTY AND)
@@ -206,6 +206,8 @@ to the stack."
(if-then (IF tests OCURLY exprs CCURLY) : `(if ,$2 ,$4 ())
(IF tests open exprs close) : `(if ,$2 ,$4 ()))
(tests (TEST OPAREN ID CPAREN) : `(,$1 ,$3)
+ (TRUE) : 'true
+ (FALSE) : 'false
(TEST OPAREN ID RELATION VERSION CPAREN)
: `(,$1 ,(string-append $3 " " $4 " " $5))
(TEST OPAREN ID RELATION VERSION AND RELATION VERSION CPAREN)
@@ -350,6 +352,10 @@ matching a string against the created regexp."
(define (is-if s) (string-ci=? s "if"))
+(define (is-true s) (string-ci=? s "true"))
+
+(define (is-false s) (string-ci=? s "false"))
+
(define (is-and s) (string=? s "&&"))
(define (is-or s) (string=? s "||"))
@@ -424,6 +430,10 @@ string with the read characters."
(define (lex-if loc) (make-lexical-token 'IF loc #f))
+(define (lex-true loc) (make-lexical-token 'TRUE loc #t))
+
+(define (lex-false loc) (make-lexical-token 'FALSE loc #f))
+
(define (lex-and loc) (make-lexical-token 'AND loc #f))
(define (lex-or loc) (make-lexical-token 'OR loc #f))
@@ -489,6 +499,8 @@ LOC is the current port location."
(let* ((w (read-delimited " ()\t\n" port 'peek)))
(cond ((is-if w) (lex-if loc))
((is-test w port) (lex-test w loc))
+ ((is-true w) (lex-true loc))
+ ((is-false w) (lex-false loc))
((is-and w) (lex-and loc))
((is-or w) (lex-or loc))
((is-id w) (lex-id w loc))
@@ -714,6 +726,8 @@ the ordering operation and the version."
(('os name) (os name))
(('arch name) (arch name))
(('impl name) (impl name))
+ ('true #t)
+ ('false #f)
(('not name) (not (eval name)))
;; 'and' and 'or' aren't functions, thus we can't use apply
(('and args ...) (fold (lambda (e s) (and e s)) #t (eval args)))
--
2.4.3
From d96a655a232ba77d7d71a5227c6d3c8bc8b983cc Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 11 Nov 2015 11:22:42 +0100
Subject: [PATCH 2/8] import: hackage: Imporve parsing of tests.
* guix/import/cabal.scm (lex-word): Add support for tests with no spaces.
(impl): Rewrite.
---
guix/import/cabal.scm | 18 +++++++++++++-----
1 file changed, 13 insertions(+), 5 deletions(-)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 8d84e09..ed6394e 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -30,6 +30,7 @@
#:use-module (srfi srfi-9 gnu)
#:use-module (system base lalr)
#:use-module (rnrs enums)
+ #:use-module (guix utils)
#:export (read-cabal
eval-cabal
@@ -496,7 +497,7 @@ location."
(define (lex-word port loc)
"Process tokens which can be recognized by reading the next word form PORT.
LOC is the current port location."
- (let* ((w (read-delimited " ()\t\n" port 'peek)))
+ (let* ((w (read-delimited " <>=()\t\n" port 'peek)))
(cond ((is-if w) (lex-if loc))
((is-test w port) (lex-test w loc))
((is-true w) (lex-true loc))
@@ -696,11 +697,18 @@ the ordering operation and the version."
((spec-name spec-op spec-ver)
(comp-spec-name+op+version haskell)))
(if (and spec-ver comp-ver)
- (eval-string
- (string-append "(string" spec-op " \"" comp-name "\""
- " \"" spec-name "-" spec-ver "\")"))
+ (cond
+ ((not (string= spec-name comp-name)) #f)
+ ((string= spec-op "==") (string= spec-ver comp-ver))
+ ((string= spec-op ">=") (version>=? comp-ver spec-ver))
+ ((string= spec-op ">") (version>? comp-ver spec-ver))
+ ((string= spec-op "<=") (not (version>? comp-ver spec-ver)))
+ ((string= spec-op "<") (not (version>=? comp-ver spec-ver)))
+ (else
+ (raise (condition
+ (&message (message "Failed to evaluate 'impl' test."))))))
(string-match spec-name comp-name))))
-
+
(define (cabal-flags)
(make-cabal-section cabal-sexp 'flag))
--
2.4.3
From 614f9a9b685bcefa4e355b8c259225b0f098bc72 Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 11 Nov 2015 15:31:46 +0100
Subject: [PATCH 3/8] import: hackage: Make it resilient to missing final
newline.
* guix/import/cabal.scm (peek-next-line-indent): Check for missing final
newline.
---
guix/import/cabal.scm | 31 ++++++++++++++++++-------------
1 file changed, 18 insertions(+), 13 deletions(-)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index ed6394e..0c26e40 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -227,19 +227,24 @@ to the stack."
"This function can be called when the next character on PORT is #\newline
and returns the indentation of the line starting after the #\newline
character. Discard (and consume) empty and comment lines."
- (let ((initial-newline (string (read-char port))))
- (let loop ((char (peek-char port))
- (word ""))
- (cond ((eqv? char #\newline) (read-char port)
- (loop (peek-char port) ""))
- ((or (eqv? char #\space) (eqv? char #\tab))
- (let ((c (read-char port)))
- (loop (peek-char port) (string-append word (string c)))))
- ((comment-line port char) (loop (peek-char port) ""))
- (else
- (let ((len (string-length word)))
- (unread-string (string-append initial-newline word) port)
- len))))))
+ (if (eof-object? (peek-char port))
+ ;; If the file is missing the #\newline on the last line, add it and act
+ ;; as if it were there. This is needed for proper operation of
+ ;; indentation based block recognition.
+ (begin (unread-char #\newline port) (read-char port) 0)
+ (let ((initial-newline (string (read-char port))))
+ (let loop ((char (peek-char port))
+ (word ""))
+ (cond ((eqv? char #\newline) (read-char port)
+ (loop (peek-char port) ""))
+ ((or (eqv? char #\space) (eqv? char #\tab))
+ (let ((c (read-char port)))
+ (loop (peek-char port) (string-append word (string c)))))
+ ((comment-line port char) (loop (peek-char port) ""))
+ (else
+ (let ((len (string-length word)))
+ (unread-string (string-append initial-newline word) port)
+ len)))))))
(define* (read-value port value min-indent #:optional (separator " "))
"The next character on PORT must be #\newline. Append to VALUE the
--
2.4.3
From 81e55b496195cc9e9aa41a2cf57117326cf93245 Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 11 Nov 2015 16:20:45 +0100
Subject: [PATCH 4/8] import: hackage: Make parsing of tests and fields more
flexible.
* guix/import/cabal.scm (is-test): Allow spaces between keyword and
parentheses.
(is-id): Add argument 'port'. Allow spaces between keyword and column.
(lex-word): Adjust call to 'is-id'.
---
guix/import/cabal.scm | 19 +++++++++++++------
1 file changed, 13 insertions(+), 6 deletions(-)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 0c26e40..7755e3c 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -333,7 +333,7 @@ matching a string against the created regexp."
(make-regexp pat))))
(cut regexp-exec rx <>)))
-(define is-property (make-rx-matcher "([a-z0-9-]+):[ \t]*(\\w?.*)$"
+(define is-property (make-rx-matcher "([a-z0-9-]+)[ \t]*:[ \t]*(\\w?.*)$"
regexp/icase))
(define is-flag (make-rx-matcher "^flag +([a-z0-9_-]+)"
@@ -366,17 +366,24 @@ matching a string against the created regexp."
(define (is-or s) (string=? s "||"))
-(define (is-id s)
+(define (is-id s port)
(let ((cabal-reserved-words
'("if" "else" "library" "flag" "executable" "test-suite"
- "source-repository" "benchmark")))
+ "source-repository" "benchmark"))
+ (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
+ (c (peek-char port)))
+ (unread-string spaces port)
(and (every (cut string-ci<> s <>) cabal-reserved-words)
- (not (char=? (last (string->list s)) #\:)))))
+ (and (not (char=? (last (string->list s)) #\:))
+ (not (char=? #\: c))))))
(define (is-test s port)
(let ((tests-rx (make-regexp "os|arch|flag|impl"))
+ (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
- (and (regexp-exec tests-rx s) (char=? #\( c))))
+ (if (and (regexp-exec tests-rx s) (char=? #\( c))
+ #t
+ (begin (unread-string spaces port) #f))))
;; Lexers for individual tokens.
@@ -509,7 +516,7 @@ LOC is the current port location."
((is-false w) (lex-false loc))
((is-and w) (lex-and loc))
((is-or w) (lex-or loc))
- ((is-id w) (lex-id w loc))
+ ((is-id w port) (lex-id w loc))
(else (unread-string w port) #f))))
(define (lex-line port loc)
--
2.4.3
From bdd4aa18e3f3a686ceae9040c8b7404984886ace Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Sat, 14 Nov 2015 15:00:36 +0100
Subject: [PATCH 5/8] utils: Add 'canonical-newline-port'.
* guix/utils.scm (canonical-newline-port): New procedure.
* tests/utils.scm ("canonical-newline-port"): New test.
---
guix/utils.scm | 34 ++++++++++++++++++++++++++++++++--
tests/utils.scm | 6 ++++++
2 files changed, 38 insertions(+), 2 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 1542e86..7b589e6 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -29,7 +29,8 @@
#:use-module (srfi srfi-39)
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
- #:use-module ((rnrs io ports) #:select (put-bytevector))
+ #:use-module (rnrs io ports)
+ #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module ((guix build utils)
#:select (dump-port package-name->name+version))
#:use-module ((guix build syscalls) #:select (errno mkdtemp!))
@@ -90,7 +91,8 @@
decompressed-port
call-with-decompressed-port
compressed-output-port
- call-with-compressed-output-port))
+ call-with-compressed-output-port
+ canonical-newline-port))
;;;
@@ -746,6 +748,34 @@ elements after E."
(if success?
(loop (absolute target) (+ depth 1))
file))))))
+
+(define (canonical-newline-port port)
+ "Return an input port that wraps PORT such that all newlines consist
+ of a single carriage return."
+ (define (get-position)
+ (if (port-has-port-position? port) (port-position port) #f))
+ (define (set-position! position)
+ (if (port-has-set-port-position!? port)
+ (set-port-position! position port)
+ #f))
+ (define (close) (close-port port))
+ (define (read! bv start n)
+ (let loop ((count 0)
+ (byte (get-u8 port)))
+ (cond ((eof-object? byte) count)
+ ((= count (- n 1))
+ (bytevector-u8-set! bv (+ start count) byte)
+ n)
+ ;; XXX: consume all LFs even if not followed by CR.
+ ((eqv? byte (char->integer #\return)) (loop count (get-u8 port)))
+ (else
+ (bytevector-u8-set! bv (+ start count) byte)
+ (loop (+ count 1) (get-u8 port))))))
+ (make-custom-binary-input-port "canonical-newline-port"
+ read!
+ get-position
+ set-position!
+ close))
;;;
;;; Source location.
diff --git a/tests/utils.scm b/tests/utils.scm
index b65d6d2..04a859f 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -318,6 +318,12 @@
(string-append (%store-prefix)
"/qvs2rj2ia5vci3wsdb7qvydrmacig4pg-bash-4.2-p24")))
+(test-equal "canonical-newline-port"
+ "This is a journey\nInto the sound\nA journey ...\n"
+ (let ((port (open-string-input-port
+ "This is a journey\r\nInto the sound\r\nA journey ...\n")))
+ (get-string-all (canonical-newline-port port))))
+
(test-end)
(false-if-exception (delete-file temp-file))
--
2.4.3
From 32b848e0506d6deac0bd1130234e02fb645613ee Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Sat, 14 Nov 2015 15:15:00 +0100
Subject: [PATCH 6/8] import: hackage: Handle CRLF end of line style.
* guix/import/hackage.scm (hackage-fetch, hackage->guix-package): Use
'canonical-newline-port'.
---
guix/import/hackage.scm | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 3baa514..8725ffa 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -22,7 +22,8 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-1)
#:use-module ((guix download) #:select (download-to-store))
- #:use-module ((guix utils) #:select (package-name->name+version))
+ #:use-module ((guix utils) #:select (package-name->name+version
+ canonical-newline-port))
#:use-module (guix import utils)
#:use-module (guix import cabal)
#:use-module (guix store)
@@ -84,7 +85,8 @@ version."
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch url temp)
- (call-with-input-file temp read-cabal))))))
+ (call-with-input-file temp
+ (compose read-cabal canonical-newline-port)))))))
(define string->license
;; List of valid values from
@@ -216,7 +218,7 @@ to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively."
(let ((cabal-meta (if port
- (read-cabal port)
+ (read-cabal (canonical-newline-port port))
(hackage-fetch package-name))))
(and=> cabal-meta (compose (cut hackage-module->sexp <>
#:include-test-dependencies?
--
2.4.3
From 507404c508774e5edb1cda1027fee12dae263592 Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 25 Nov 2015 14:47:16 +0100
Subject: [PATCH 8/8] import: hackage: Assume current 'ghc' package version.
* guix/scripts/import/hackage.scm (%default-options): Do it.
(ghc-default-version): New variable.
---
guix/scripts/import/hackage.scm | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 97d042b..4e84278 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -19,6 +19,7 @@
(define-module (guix scripts import hackage)
#:use-module (guix ui)
#:use-module (guix utils)
+ #:use-module (guix packages)
#:use-module (guix scripts)
#:use-module (guix import hackage)
#:use-module (guix scripts import)
@@ -34,10 +35,13 @@
;;; Command-line options.
;;;
+(define ghc-default-version
+ (string-append "ghc-" (package-version (@ (gnu packages haskell) ghc))))
+
(define %default-options
- '((include-test-dependencies? . #t)
+ `((include-test-dependencies? . #t)
(read-from-stdin? . #f)
- ('cabal-environment . '())))
+ (cabal-environment . ,`(("impl" . ,ghc-default-version)))))
(define (show-help)
(display (_ "Usage: guix import hackage PACKAGE-NAME
--
2.4.3
From bf0bc66ace3b2617178c28d9635dbb4bc3a89ce9 Mon Sep 17 00:00:00 2001
From: Federico Beffa <be...@fbengineering.ch>
Date: Wed, 25 Nov 2015 13:58:06 +0100
Subject: [PATCH 7/8] import: hackage: Add new tests.
* tests/hackage.scm (eval-test-with-cabal): Add optional argument.
(test-cabal-3): New variable and test.
(test-read-cabal-1): Exercise more parsing variants.
---
tests/hackage.scm | 37 ++++++++++++++++++++++++++++++-------
1 file changed, 30 insertions(+), 7 deletions(-)
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 229bee3..b608ccd 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -50,8 +50,28 @@ build-depends:
}
")
+;; Check compiler implementation test with and without spaces.
+(define test-cabal-3
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if impl(ghc >= 7.2 && < 7.6)
+ Build-depends: ghc-a
+ if impl(ghc>=7.2&&<7.6)
+ Build-depends: ghc-b
+ if impl(ghc == 7.8)
+ Build-depends:
+ HTTP >= 4000.2.5 && < 4000.3,
+ mtl >= 2.0 && < 3
+")
+
;; A fragment of a real Cabal file with minor modification to check precedence
-;; of 'and' over 'or'.
+;; of 'and' over 'or', missing final newline, spaces between keywords and
+;; parentheses and between key and column.
(define test-read-cabal-1
"name: test-me
library
@@ -66,24 +86,23 @@ library
Build-depends: base >= 3 && < 4
else
Build-depends: base < 3
- if flag(base4point8) || flag(base4) && flag(base3)
+ if flag(base4point8) || flag (base4) && flag(base3)
Build-depends: random
- Build-depends: containers
+ Build-depends : containers
-- Modules that are always built.
Exposed-Modules:
- Test.QuickCheck.Exception
-")
+ Test.QuickCheck.Exception")
(test-begin "hackage")
-(define (eval-test-with-cabal test-cabal)
+(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '()))
(mock
((guix import hackage) hackage-fetch
(lambda (name-version)
(call-with-input-string test-cabal
read-cabal)))
- (match (hackage->guix-package "foo")
+ (match (hackage->guix-package "foo" #:cabal-environment cabal-environment)
(('package
('name "ghc-foo")
('version "1.0.0")
@@ -116,6 +135,10 @@ library
(test-assert "hackage->guix-package test 2"
(eval-test-with-cabal test-cabal-2))
+(test-assert "hackage->guix-package test 3"
+ (eval-test-with-cabal test-cabal-3
+ #:cabal-environment '(("impl" . "ghc-7.8"))))
+
(test-assert "read-cabal test 1"
(match (call-with-input-string test-read-cabal-1 read-cabal)
((("name" ("test-me"))
--
2.4.3
