boot2

042-ccscm-stdarg-gate.scm (2119B)

---

 ;; tests/cc-pp/42-ccscm-stdarg-gate.scm
 ;;
 ;; cc.scm pre-defines CCSCM as an empty object macro so test fixtures
 ;; can wrap their stdarg.h include in `#ifndef CCSCM ... #else ... #endif`
 ;; and route around #include (which cc.scm rejects). This test pins
 ;; that contract: with CCSCM in the initial-defines table, the #include
 ;; in the then-branch is never processed, the else branch's typedef
 ;; emits its tokens, and the else branch's function-like macro is
 ;; registered and expanded at the call site.
 
 (define src
   "#ifndef CCSCM\n#include <stdarg.h>\n#else\ntypedef char *va_list;\n#define va_start(ap, n) __builtin_va_start(ap, n)\n#endif\nva_list ap;\nvoid f(int n) { va_start(ap, n); }\n")
 
 (define ccscm (cons "CCSCM" (%macro 'obj '() '())))
 (define toks (lex-tokenize src "src.c"))
 (define out  (pp-expand toks (list ccscm)))
 
 ;; Helper: fail with a status-encoded reason if `cond` is false.
 (define (must cond status)
   (if cond #t (sys-exit status)))
 
 ;; #include must NOT have been processed (it would have raised die from
 ;; %pp-do-include and aborted with status 1 before getting here).
 
 ;; Walk `out` and assert: the typedef line is present, ap (va_list ident)
 ;; is present, and the va_start expansion landed on __builtin_va_start.
 (define (find-ident name toks)
   (cond
     ((null? toks) #f)
     ((and (eq? (tok-kind (car toks)) 'IDENT)
           (bv= (tok-value (car toks)) name))
      toks)
     (else (find-ident name (cdr toks)))))
 
 (must (find-ident "va_list" out)            11)
 (must (find-ident "ap" out)                 12)
 (must (find-ident "f" out)                  13)
 (must (find-ident "__builtin_va_start" out) 14)
 
 ;; Negative: __builtin_va_start should appear (from the macro body), but
 ;; the literal `va_start` identifier should NOT survive expansion at the
 ;; call site.
 (define (count-ident name toks)
   (let loop ((ts toks) (n 0))
     (cond
       ((null? ts) n)
       ((and (eq? (tok-kind (car ts)) 'IDENT)
             (bv= (tok-value (car ts)) name))
        (loop (cdr ts) (+ n 1)))
       (else (loop (cdr ts) n)))))
 
 (must (= (count-ident "va_start" out) 0) 15)
 
 (sys-exit 0)