summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2022-04-30 15:38:44 +0200
committerLars-Dominik Braun <lars@6xq.net>2022-06-06 13:26:09 +0200
commit2c5d18e421e6c06f4a969f98585ec41aae8eb2e4 (patch)
tree22e1473e0e73f5a4df5c184ac0ce71ecd4c93f8b
parent0c6123f8aa6236dcce1320cd190865324f3a5f94 (diff)
import: cabal: Support elif statement.
Fixes <https://issues.guix.gnu.org/54752>. * guix/import/cabal.scm (make-cabal-parser): Replace if-then-else grammar case with elif-else, modify if-then accordingly. (is-elif): New procedure. (lex-elif): Likewise. (is-id): Add elif keyword. (lex-word): Add test for elif. * tests/hackage.scm (test-cabal-if): New variale. (test-cabal-else): Likewise. (test-cabal-elif): Likewise. (test-cabal-elif-brackets): Likewise. (match-ghc-elif): Likewise. ("hackage->guix-package test lonely if statement", "hackage->guix-package test else statement", "hackage->guix-package test elif statement", "hackage->guix-package test elif statement with brackets"): New tests.
-rw-r--r--guix/import/cabal.scm63
-rw-r--r--tests/hackage.scm102
2 files changed, 136 insertions, 29 deletions
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 98d7234098..e1a082a31a 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -149,7 +149,7 @@ to the stack."
(right: IF FLAG EXEC TEST-SUITE CUSTOM-SETUP SOURCE-REPO BENCHMARK LIB COMMON OCURLY)
(left: OR)
(left: PROPERTY AND)
- (right: ELSE NOT))
+ (right: ELIF ELSE NOT))
;; --- rules
(body (properties sections) : (append $1 $2))
(sections (sections flags) : (append $1 $2)
@@ -193,32 +193,32 @@ to the stack."
(LIB open exprs close) : `(section library ,$3))
(exprs (exprs PROPERTY) : (append $1 (list $2))
(PROPERTY) : (list $1)
- (exprs if-then-else) : (append $1 (list $2))
- (if-then-else) : (list $1)
- (exprs if-then) : (append $1 (list $2))
- (if-then) : (list $1))
- (if-then-else (IF tests OCURLY exprs CCURLY ELSE OCURLY exprs CCURLY)
- : `(if ,$2 ,$4 ,$8)
- (IF tests open exprs close ELSE OCURLY exprs CCURLY)
- : `(if ,$2 ,$4 ,$8)
- ;; The 'open' token after 'tests' is shifted after an 'exprs'
- ;; is found. This is because, instead of 'exprs' a 'OCURLY'
- ;; token is a valid alternative. For this reason, 'open'
- ;; pushes a <parse-context> with a line indentation equal to
- ;; the indentation of 'exprs'.
- ;;
- ;; Differently from this, without the rule above this
- ;; comment, when an 'ELSE' token is found, the 'open' token
- ;; following the 'ELSE' would be shifted immediately, before
- ;; the 'exprs' is found (because there are no other valid
- ;; tokens). The 'open' would therefore create a
- ;; <parse-context> with the indentation of 'ELSE' and not
- ;; 'exprs', creating an inconsistency. We therefore allow
- ;; mixed style conditionals.
- (IF tests open exprs close ELSE open exprs close)
- : `(if ,$2 ,$4 ,$8))
- (if-then (IF tests OCURLY exprs CCURLY) : `(if ,$2 ,$4 ())
- (IF tests open exprs close) : `(if ,$2 ,$4 ()))
+ (exprs elif-else) : (append $1 (list ($2 '(()))))
+ (elif-else) : (list ($1 '(()))))
+ ;; LALR(1) parsers prefer to be left-recursive, which make if-statements slightly involved.
+ ;; XXX: This technically allows multiple else statements.
+ (elif-else (elif-else ELIF tests OCURLY exprs CCURLY) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
+ (elif-else ELIF tests open exprs close) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
+ (elif-else ELSE OCURLY exprs CCURLY) : (lambda (y) ($1 (list $4)))
+ ;; The 'open' token after 'tests' is shifted after an 'exprs'
+ ;; is found. This is because, instead of 'exprs' a 'OCURLY'
+ ;; token is a valid alternative. For this reason, 'open'
+ ;; pushes a <parse-context> with a line indentation equal to
+ ;; the indentation of 'exprs'.
+ ;;
+ ;; Differently from this, without the rule above this
+ ;; comment, when an 'ELSE' token is found, the 'open' token
+ ;; following the 'ELSE' would be shifted immediately, before
+ ;; the 'exprs' is found (because there are no other valid
+ ;; tokens). The 'open' would therefore create a
+ ;; <parse-context> with the indentation of 'ELSE' and not
+ ;; 'exprs', creating an inconsistency. We therefore allow
+ ;; mixed style conditionals.
+ (elif-else ELSE open exprs close) : (lambda (y) ($1 (list $4)))
+ ;; Terminating rule.
+ (if-then) : (lambda (y) (append $1 y)))
+ (if-then (IF tests OCURLY exprs CCURLY) : (list 'if $2 $4)
+ (IF tests open exprs close) : (list 'if $2 $4))
(tests (TEST OPAREN ID CPAREN) : `(,$1 ,$3)
(TRUE) : 'true
(FALSE) : 'false
@@ -386,6 +386,8 @@ matching a string against the created regexp."
(define is-else (make-rx-matcher "^else" regexp/icase))
+(define (is-elif s) (string-ci=? s "elif"))
+
(define (is-if s) (string-ci=? s "if"))
(define (is-true s) (string-ci=? s "true"))
@@ -402,8 +404,8 @@ matching a string against the created regexp."
(define (is-id s port loc)
(let ((cabal-reserved-words
- '("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
- "source-repository" "benchmark" "common"))
+ '("if" "else" "elif" "library" "flag" "executable" "test-suite"
+ "custom-setup" "source-repository" "benchmark" "common"))
(spaces (read-while (cut char-set-contains? char-set:blank <>) port))
(c (peek-char port)))
(unread-string spaces port)
@@ -494,6 +496,8 @@ string with the read characters."
(define (lex-else loc) (make-lexical-token 'ELSE loc #f))
+(define (lex-elif loc) (make-lexical-token 'ELIF loc #f))
+
(define (lex-if loc) (make-lexical-token 'IF loc #f))
(define (lex-true loc) (make-lexical-token 'TRUE loc #t))
@@ -568,6 +572,7 @@ location."
LOC is the current port location."
(let* ((w (read-delimited " <>=()\t\n" port 'peek)))
(cond ((is-if w) (lex-if loc))
+ ((is-elif w) (lex-elif loc))
((is-test w port) (lex-test w loc))
((is-true w) (lex-true loc))
((is-false w) (lex-false loc))
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 189b9af173..38f75b268e 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -309,6 +309,108 @@ executable cabal
(test-assert "hackage->guix-package test flag executable"
(eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
+;; Check if-elif-else statements
+(define test-cabal-if
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-c
+")
+
+(define test-cabal-else
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-a
+ else
+ Build-depends: ghc-c
+")
+
+(define test-cabal-elif
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first)
+ Build-depends: ghc-a
+ elif os(second)
+ Build-depends: ghc-b
+ elif os(guix)
+ Build-depends: ghc-c
+ elif os(third)
+ Build-depends: ghc-d
+ else
+ Build-depends: ghc-e
+")
+
+;; Try the same with different bracket styles
+(define test-cabal-elif-brackets
+ "name: foo
+version: 1.0.0
+homepage: http://test.org
+synopsis: synopsis
+description: description
+license: BSD3
+library
+ if os(first) {
+ Build-depends: ghc-a
+ }
+ elif os(second)
+ Build-depends: ghc-b
+ elif os(guix) { Build-depends: ghc-c }
+ elif os(third) {
+ Build-depends: ghc-d }
+ else
+ Build-depends: ghc-e
+")
+
+(define-package-matcher match-ghc-elif
+ ('package
+ ('name "ghc-foo")
+ ('version "1.0.0")
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('hackage-uri "foo" 'version))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'haskell-build-system)
+ ('inputs ('list 'ghc-c))
+ ('home-page "http://test.org")
+ ('synopsis (? string?))
+ ('description (? string?))
+ ('license 'license:bsd-3)))
+
+(test-assert "hackage->guix-package test lonely if statement"
+ (eval-test-with-cabal test-cabal-else match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test else statement"
+ (eval-test-with-cabal test-cabal-else match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test elif statement"
+ (eval-test-with-cabal test-cabal-elif match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
+(test-assert "hackage->guix-package test elif statement with brackets"
+ (eval-test-with-cabal test-cabal-elif-brackets match-ghc-elif
+ #:cabal-environment '(("os" . "guix"))))
+
;; Check Hackage Cabal revisions.
(define test-cabal-revision
"name: foo