~ chicken-core (chicken-5) cc4f64bc510789e44daabffb45985c37882e493f
commit cc4f64bc510789e44daabffb45985c37882e493f
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Aug 12 20:17:31 2018 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Aug 12 21:34:11 2018 +0200
Fix behaviour of complex (platform) clauses in .egg files
Something like (platform (and unix)) would always fail even on UNIX,
as would (platform (or haiku unix)), and (platform (or (unix haiku)))
would succeed on UNIX but fail on Haiku.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/chicken-install.scm b/chicken-install.scm
index 14e07262..80048dfa 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -716,22 +716,21 @@
(else #f)))
(define (check-platform name info)
- (define (fail)
- (error "extension is not targeted for this system" name))
(unless cross-chicken
(and-let* ((platform (get-egg-property info 'platform)))
- (let loop ((p platform))
- (cond ((symbol? p)
- (or (feature? p) (fail)))
- ((not (list? p))
- (error "invalid `platform' property" name platform))
- ((and (eq? 'not (car p)) (pair? (cdr p)))
- (and (not (loop (cadr p))) (fail)))
- ((eq? 'and (car p))
- (and (every loop (cdr p)) (fail)))
- ((eq? 'or (car p))
- (and (not (any loop (cdr p))) (fail)))
- (else (error "invalid `platform' property" name platform)))))))
+ (or (let loop ((p platform))
+ (cond ((symbol? p)
+ (feature? p))
+ ((not (list? p))
+ (error "invalid `platform' property" name platform))
+ ((and (eq? 'not (car p)) (pair? (cdr p)))
+ (not (loop (cadr p))))
+ ((eq? 'and (car p))
+ (every loop (cdr p)))
+ ((eq? 'or (car p))
+ (any loop (cdr p)))
+ (else (error "invalid `platform' property" name platform))))
+ (error "extension is not targeted for this system" name)))))
(define (replace-extension-question e+d+v upgrade)
(print (string-intersperse
Trap