~ 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