~ 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