read the feature flags in sextest in the way sexc does
Some checks failed
Sex CI / build-linux (pull_request) Failing after 5m14s
Some checks failed
Sex CI / build-linux (pull_request) Failing after 5m14s
sextest resolves #+ and #- itself -- it reads the program and prints what survives to sexc -- so a flag spelling it does not recognise decides which branch gets compiled
This commit is contained in:
3
Makefile
3
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
|
||||
|
||||
24
tests/sex-programs/feature-flags.sex
Normal file
24
tests/sex-programs/feature-flags.sex
Normal file
@@ -0,0 +1,24 @@
|
||||
(compilation "-f alpha --features beta --features=gamma --no-platform-features")
|
||||
(input)
|
||||
(output "alpha" "beta" "gamma" "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")
|
||||
#-unix (puts "elsewhere")
|
||||
#+unix (puts "here")
|
||||
(return 0))
|
||||
@@ -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)
|
||||
(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 (platform-features) features)))
|
||||
(split-settings (read-raw-forms target-path))))))
|
||||
(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
|
||||
|
||||
Reference in New Issue
Block a user