_run-parse.scm (1540B)
1 ;; tests/cc-parse/_run-parse.scm — driver for cc-parse .c fixtures. 2 ;; 3 ;; argv[0] = scheme1 binary path 4 ;; argv[1] = combined source (assembled by the test runner via catm) 5 ;; argv[2] = .c fixture path 6 ;; 7 ;; Runs the full lex+pp+parse+cg pipeline against the fixture and 8 ;; writes the emitted P1pp text to stdout. Same plumbing as cc-main, 9 ;; minus the -D/-o flag handling. 10 11 (define (%basename path) 12 (let* ((n (bytevector-length path))) 13 (let loop ((i (- n 1))) 14 (cond 15 ((< i 0) path) 16 ((= (bytevector-u8-ref path i) 47) 17 (bv-slice path (+ i 1) n)) 18 (else (loop (- i 1))))))) 19 20 (define (%run-parse path) 21 (let ((op (open-input path))) 22 (if (not (car op)) 23 (begin 24 (write-bv-fd 2 "run-parse: cannot open ") 25 (write-bv-fd 2 path) 26 (write-bv-fd 2 NL-BV) 27 (sys-exit 2)) 28 (let* ((src (slurp-fd (port-fd (cdr op)))) 29 (file (%basename path)) 30 (toks (lex-tokenize src file)) 31 (expanded (pp-expand toks '())) 32 (cg (cg-init)) 33 (ps (make-pstate expanded cg))) 34 (sys-close (port-fd (cdr op))) 35 (parse-translation-unit ps) 36 (write-bv-fd 1 (cg-finish cg)) 37 (sys-exit 0))))) 38 39 (let ((args (argv))) 40 (cond 41 ((null? args) (sys-exit 2)) 42 ((null? (cdr args)) (sys-exit 2)) 43 ((null? (cdr (cdr args))) 44 (write-bv-fd 2 "run-parse: missing fixture path\n") 45 (sys-exit 2)) 46 (else (%run-parse (car (cdr (cdr args)))))))