nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: hackage: Imporve parsing of tests. 

* guix/import/cabal.scm (lex-word): Add support for tests with no spaces.
  (impl): Rewrite.
This commit is contained in:
Federico Beffa 2015-11-11 11:22:42 +01:00
parent 7716f55c83
commit 9be54eb1b1
1 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
guix/import/cabal.scm
View File

@ -30,6 +30,7 @@
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (system base lalr) #:use-module (system base lalr)
#:use-module (rnrs enums) #:use-module (rnrs enums)
#:use-module (guix utils)
#:export (read-cabal #:export (read-cabal
eval-cabal eval-cabal
@ -496,7 +497,7 @@ location."
(define (lex-word port loc) (define (lex-word port loc)
"Process tokens which can be recognized by reading the next word form PORT. "Process tokens which can be recognized by reading the next word form PORT.
LOC is the current port location." 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)) (cond ((is-if w) (lex-if loc))
((is-test w port) (lex-test w loc)) ((is-test w port) (lex-test w loc))
((is-true w) (lex-true loc)) ((is-true w) (lex-true loc))
@ -696,11 +697,18 @@ the ordering operation and the version."
((spec-name spec-op spec-ver) ((spec-name spec-op spec-ver)
(comp-spec-name+op+version haskell))) (comp-spec-name+op+version haskell)))
(if (and spec-ver comp-ver) (if (and spec-ver comp-ver)
(eval-string (cond
(string-append "(string" spec-op " \"" comp-name "\"" ((not (string= spec-name comp-name)) #f)
" \"" spec-name "-" spec-ver "\")")) ((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)))) (string-match spec-name comp-name))))
(define (cabal-flags) (define (cabal-flags)
(make-cabal-section cabal-sexp 'flag)) (make-cabal-section cabal-sexp 'flag))