From 6e4cb80424dfaa48fa085c82510d5faef260d3a0 Mon Sep 17 00:00:00 2001
From: alex-eg <alexey.e.egorov@gmail.com>
Date: Wed, 16 Sep 2026 17:41:31 +0300
Subject: [PATCH] make sextest's (compilation ...) form work

1. Look for `compilation', not `compile' among the source
2. Read the file with provided --features from the (compilation ...)
form, then handle resulting file to sexc
---
 .gitignore                      |  2 ++
 tools/sextest/reader.module.scm |  5 ++-
 tools/sextest/sextest.scm       | 61 ++++++++++++++++++++++++---------
 3 files changed, 50 insertions(+), 18 deletions(-)

diff --git a/.gitignore b/.gitignore
index dbdf980..e50abab 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,5 @@
 *.link
 sexc
 sex-tests
+sextest
+tools/sextest/sextest
diff --git a/tools/sextest/reader.module.scm b/tools/sextest/reader.module.scm
index 2037c32..d3358e7 100644
--- a/tools/sextest/reader.module.scm
+++ b/tools/sextest/reader.module.scm
@@ -1,3 +1,6 @@
 (module reader (read-from-file
-                read-raw-forms)
+                read-raw-forms
+
+                current-features
+                platform-features)
   "../../reader.scm")
diff --git a/tools/sextest/sextest.scm b/tools/sextest/sextest.scm
index 1ee4c75..decb2e5 100644
--- a/tools/sextest/sextest.scm
+++ b/tools/sextest/sextest.scm
@@ -7,36 +7,63 @@
         (chicken port)
         (chicken process)
         (chicken process-context)
+        (chicken string)                ; string-split
         fmt
         getopt-long
         reader                          ; read-raw-forms, shared with sexc
-        srfi-1)
+        srfi-1
+        srfi-13)                        ; string-prefix?
 
 (define (print-help)
   (fmt #t "Usage: sextest [options] filename" nl
        "Options:" nl
        (usage opts-grammar) nl))
 
-(define (process-file target-path)
-  (let ((contents (read-raw-forms target-path)))
-    (foldl (lambda (acc elt)
-             (case (car elt)
-               ((compilation input output return)
-                (cons
-                 (append (car acc) (list elt))
-                 (cdr acc)))
-               (else
-                (cons
-                 (car acc)
-                 (append (cdr acc) (list elt))))))
-           (cons (list) (list))
-           contents)))
+(define (split-settings contents)
+  (foldl (lambda (acc elt)
+           (case (car elt)
+             ((compilation input output return)
+              (cons
+               (append (car acc) (list elt))
+               (cdr acc)))
+             (else
+              (cons
+               (car acc)
+               (append (cdr acc) (list elt))))))
+         (cons (list) (list))
+         contents))
 
-(define (compile src flags sexc)
+;;; --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
+(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) ","))
+                          (list)))
+                    (string-split (cadr compilation)))
+        (list))))
+
+(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))))))
+
+(define (compile src compilation sexc)
   (let ((compiler (or
                    (and sexc (cdr sexc))
                    (get-environment-variable "SEXC")
                    "sexc"))
+        ;; (compilation "--features=x -- -O2") -- one string
+        (flags (if compilation
+                   (string-split (cadr compilation))
+                   (list)))
         (compiled-file (create-temporary-file)))
     ;; `process' returns one record; `process-input-port' is named from
     ;; the child's side, so it is the port we write to.
@@ -110,7 +137,7 @@
   (let* ((settings-and-src (process-file path))
          (settings (car settings-and-src))
          (src (cdr settings-and-src))
-         (compiled-file (compile src (assoc 'compile settings) sexc)))
+         (compiled-file (compile src (assoc 'compilation settings) sexc)))
     (if (not compiled-file)
         (begin (fmt #t "Failed to compile " path nl)
                #f)