~ chicken-core (chicken-5) fe20c6aed8340c897eb70c3d4665db5fc073444e
commit fe20c6aed8340c897eb70c3d4665db5fc073444e
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Sep 24 18:13:36 2016 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Nov 13 11:39:37 2016 +0100
egg-compilation: fix info-validation, new egg prop access impl, pass C-compiler include path option when compiling
diff --git a/egg-compile.scm b/egg-compile.scm
index 4e06df9e..c37460a1 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -288,7 +288,7 @@
(out (quotearg (target-file (conc sname (object-extension platform)) mode)))
(src (quotearg (or ssname (conc sname ".scm")))))
(print "\n" (slashify default-builder platform) " " out " " cmd
- " -I " srcdir " -I" srcdir (arglist options)
+ " -I " srcdir " -C -I" srcdir (arglist options)
" " src " -o " out " : "
src (arglist dependencies))))
@@ -302,7 +302,7 @@
(out (quotearg (target-file (conc sname ".so") mode)))
(src (quotearg (or ssname (conc sname ".scm")))))
(print "\n" (slashify default-builder platform) " " out " " cmd
- " -I " srcdir " -I" srcdir (arglist options)
+ " -I " srcdir " -C -I" srcdir (arglist options)
(arglist link-options) " " src " -o " out " : "
src (arglist dependencies))))
@@ -315,7 +315,7 @@
(out (quotearg (target-file (conc sname ".import.so") mode)))
(src (quotearg (or source (conc sname ".import.scm")))))
(print "\n" (slashify default-builder platform) " " out " " cmd
- " -I " srcdir " -I" srcdir (arglist options)
+ " -I " srcdir " -C -I" srcdir (arglist options)
(arglist link-options) " " src " -o " out " : "
src (arglist dependencies))))
@@ -330,7 +330,7 @@
mode)))
(src (quotearg (or ssname (conc sname ".scm")))))
(print "\n" (slashify default-builder platform) " " out " " cmd
- " -I " srcdir " -I" srcdir (arglist options)
+ " -I " srcdir " -C -I" srcdir (arglist options)
(arglist link-options) " " src " -o " out " : "
src (arglist dependencies))))
@@ -345,7 +345,7 @@
mode)))
(src (quotearg (or ssname (conc sname ".scm")))))
(print "\n" (slashify default-builder platform) " " out " " cmd
- " -I " srcdir " -I" srcdir (arglist options)
+ " -I " srcdir " -C -I" srcdir (arglist options)
(arglist link-options) " " src " -o " out " : "
src (arglist dependencies))))
diff --git a/egg-information.scm b/egg-information.scm
index 4480a880..98c1ce53 100644
--- a/egg-information.scm
+++ b/egg-information.scm
@@ -2,9 +2,9 @@
(define toplevel-items
- '(synopsis authors category license version dependencies
+ '(synopsis authors category license version dependencies synopsis
test-dependencies build-dependencies components foreign-dependencies
- platform doc-from-wiki))
+ platform doc-from-wiki installed-files))
(define valid-items
(append toplevel-items
@@ -29,22 +29,24 @@
(define (toplevel-item? item)
(and (valid-item? item) (memq (car item) toplevel-items)))
(unless (list? info)
- (error "egg-information has invalid structure"))
+ (error "egg-information has invalid structure" info))
(unless (every toplevel-item? info)
- (error "egg-information is invalid toplevel structure"))
- (for-each
- (lambda (item)
- (unless (valid-item? item)
- (error "egg-information item has invalid structure" item))
- (when (and (memq (car item) named-items) (not (symbol? (cadr item))))
- (error "missing name for item" item))
- (if (memq (car item) nested-items)
- (validate-egg-info (if (memq (car item) named-items)
- (cddr item)
- (cdr item)))
- (unless (memq (car item) valid-items)
- (error "invalid item" item))))
- info)
+ (error "egg-information has invalid toplevel structure" info))
+ (define (validate info)
+ (for-each
+ (lambda (item)
+ (unless (valid-item? item)
+ (error "egg-information item has invalid structure" item))
+ (when (and (memq (car item) named-items) (not (symbol? (cadr item))))
+ (error "missing name for item" item))
+ (if (memq (car item) nested-items)
+ (validate (if (memq (car item) named-items)
+ (cddr item)
+ (cdr item)))
+ (unless (memq (car item) valid-items)
+ (error "invalid item" item))))
+ info))
+ (validate info)
info)
@@ -64,3 +66,7 @@
(define (get-egg-property info prop #!optional default)
(let ((p (assq prop info)))
(or (and p (cadr p)) default)))
+
+(define (get-egg-property* info prop #!optional (default '()))
+ (let ((p (assq prop info)))
+ (or (and p (cdr p)) default)))
Trap