Makefile

@@ -90,7 +90,8 @@ sextest: $(EGGS_STAMP)
 	$(MAKE) -C ./tools/sextest sextest
 	cp ./tools/sextest/sextest .
 
-SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features
+SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \
+                    feature-flags
 
 # Multi-module linking is checked end to end; see tests/modules/Makefile.
 check-modules: sexc

tests/sex-programs/feature-flags.sex

@@ -0,0 +1,25 @@
+(compilation "-f alpha -f beta,gamma --features=delta --no-platform-features")
+(input)
+(output "alpha" "beta" "gamma" "delta" "elsewhere")
+(return 0)
+
+;;; The flags naming the features, in every spelling sexc takes. This
+;;; is not pedantry about the command line: sextest reads the program
+;;; itself and prints the surviving forms to sexc, so a spelling it
+;;; does not recognise leaves the guards below resolved against the
+;;; wrong set -- quietly, since the test then checks the output of a
+;;; program it did not mean to compile.
+;;;
+;;; --no-platform-features is what makes `#-unix' true wherever this is
+;;; compiled, and it has to be honoured on both sides for that to hold.
+
+(include stdio.h)
+
+(pub fn main () int
+  #+alpha (puts "alpha")
+  #+beta (puts "beta")
+  #+gamma (puts "gamma")
+  #+delta (puts "delta")
+  #-unix (puts "elsewhere")
+  #+unix (puts "here")
+  (return 0))

tools/sextest/sextest.scm

@@ -1,4 +1,5 @@
 (import scheme
+        (scheme base)                   ; let-values
         brev-separate
         (chicken base)
         (chicken file)
@@ -33,27 +34,45 @@
          (cons (list) (list))
          contents))
 
-;;; --features from the (compilation ...) form, which we have to honour
-;;; ourselves: the program is read here and printed back out for sexc,
-;;; so #+ and #- are resolved on this side
+;;; The feature flags of the (compilation ...) form, which we have to
+;;; honour ourselves: the program is read here and printed back out for
+;;; sexc, so #+ and #- are resolved on this side.
+;;;
+;;; Returns the named features and whether the host's own are in play
 (define (compilation-features settings)
   (let ((compilation (assoc 'compilation settings)))
-    (if compilation
-        (append-map (lambda (flag)
-                      (if (string-prefix? "--features=" flag)
-                          (map string->symbol
-                               (string-split (substring flag 11) ","))
+    (let loop ((flags (if compilation
+                          (string-split (cadr compilation))
                           (list)))
-                    (string-split (cadr compilation)))
-        (list))))
+               (features (list))
+               (platform #t))
+      (define (add names rest)
+        (loop rest
+              (append features (map string->symbol (string-split names ",")))
+              platform))
+      (cond
+       ((null? flags) (values features platform))
+       ;; past `--' the flags are the C compiler's
+       ((string=? (car flags) "--") (values features platform))
+       ((string=? (car flags) "--no-platform-features")
+        (loop (cdr flags) features #f))
+       ((and (member (car flags) '("-f" "--features")) (pair? (cdr flags)))
+        (add (cadr flags) (cddr flags)))
+       ((string-prefix? "--features=" (car flags))
+        (add (substring (car flags) 11) (cdr flags)))
+       ((string-prefix? "-f" (car flags))
+        (add (substring (car flags) 2) (cdr flags)))
+       (else (loop (cdr flags) features platform))))))
 
 (define (process-file target-path)
-  (let* ((first-pass (split-settings (read-raw-forms target-path)))
-         (features (compilation-features (car first-pass))))
-    (if (null? features)
-        first-pass
-        (parameterize ((current-features (append (platform-features) features)))
-          (split-settings (read-raw-forms target-path))))))
+  (let ((first-pass (split-settings (read-raw-forms target-path))))
+    (let-values (((features platform?) (compilation-features (car first-pass))))
+      (if (and (null? features) platform?)
+          first-pass
+          (parameterize ((current-features
+                          (append (if platform? (platform-features) (list))
+                                  features)))
+            (split-settings (read-raw-forms target-path)))))))
 
 (define (compile src compilation sexc)
   (let ((compiler (or