;;; Codegen details that are easy to get subtly wrong, and that the
;;; walk-* unit tests cannot see: they check the intermediate form we
;;; hand to fmt-c, not the C that fmt-c renders from it.
;;;
;;; Both cases below were found by writing an OpenGL example, not by
;;; the existing suite, because both need an operand shape that no
;;; earlier test program happened to use.

(import (chicken condition)
        (chicken port)
        (chicken string)
        srfi-13
        fmt-c-writer
        reader
        semen
        utils)

(define (sex->c source)
  "Compile SOURCE, a string of Sex, and return the generated C."
  (let ((forms (with-input-from-string source
                 (lambda ()
                   (parameterize ((current-source-file "codegen.sex"))
                     (parse-all (current-input-port)))))))
    (with-output-to-string
      (lambda ()
        (parameterize ((sex-line-directives 'none))
          (emit-c (semen-process forms)))))))

(define (emits? source fragment)
  (and (string-contains (sex->c source) fragment) #t))

(define (error-message source)
  "Compile SOURCE and return the error text as the user sees it --
message plus arguments, the way CHICKEN prints it -- or #f if SOURCE
compiles."
  (handle-exceptions e
      (with-output-to-string
        (lambda ()
          (display ((condition-property-accessor 'exn 'message) e))
          (for-each (lambda (a) (display " ") (write a))
                    ((condition-property-accessor 'exn 'arguments) e))))
    (begin (sex->c source) #f)))

(define (reports? source fragment)
  (let ((m (error-message source)))
    (and m (string-contains m fragment) #t)))

(define (in-fn body)
  (string-append "(fn f ((a int) (b int)) void " body ")"))

(test-group "codegen"

  ;; c-switch handed its scrutinee straight to `cat', which only works
  ;; when it is an atom. Anything else was displayed as a raw
  ;; s-expression: `switch ((%. e type))'.
  (test-group "switch scrutinee"
    (test-assert "member access"
      (emits? "(struct s ((type int))) (fn f ((e (struct s))) void (switch (. e type) (case 1 (g))))"
              "switch (e.type)"))
    (test-assert "call"
      (emits? (in-fn "(switch (g a) (case 1 (h)))")
              "switch (g(a))"))
    (test-assert "arithmetic"
      (emits? (in-fn "(switch (+ a b) (case 1 (h)))")
              "switch (a + b)")))

  ;; A cast binds tighter than every binary operator, so an operand
  ;; that is itself a binary expression has to be parenthesised --
  ;; otherwise the cast silently applies to the first operand only.
  (test-group "cast precedence"
    (test-assert "binary operand is parenthesised"
      (emits? (in-fn "(var p (* void) (cast (* 2 (sizeof int)) (* void)))")
              "(void *)(2 * sizeof(int))"))
    (test-assert "subtraction operand is parenthesised"
      (emits? (in-fn "(var f float (cast (- a b) float))")
              "(float)(a - b)"))
    ;; ...but exactly once. The operand used to parenthesise itself
    ;; again inside the parens the cast had just added.
    (test-assert "and not parenthesised twice"
      (not (emits? (in-fn "(var f float (cast (- a b) float))")
                   "(float)((a - b))")))
    ;; Unary operands are already unary-expressions and must be left
    ;; alone, or every existing cast in the tree gains noise.
    (test-assert "identifier is left bare"
      (emits? (in-fn "(var f float (cast a float))")
              "(float)a"))
    (test-assert "address-of is left bare"
      (emits? (in-fn "(var p (* int) (cast (& a) (* int)))")
              "(int *)&a"))
    (test-assert "sizeof is left bare"
      (emits? (in-fn "(var n int (cast (sizeof int) int))")
              "(int)sizeof(int)")))

  ;; A comment among a call's arguments used to become an argument,
  ;; and c-apply put a comma on each side of it -- which does not
  ;; compile. It is dropped, as in any other expression context.
  (test-group "comments among arguments"
    (test-assert "no stray comma"
      (not (emits? (in-fn "(g 1 ;; c\n 2)") "*/,")))
    (test-assert "the arguments survive"
      (emits? (in-fn "(g 1 ;; c\n 2)") "g(1, 2)")))

  ;; The reader leaves the `;'s that introduced each line, and a run of
  ;; comment lines arrives as one form per line.
  (test-group "comment rendering"
    (test-assert "the markers are stripped"
      (emits? "(fn f () void ;;; Foo\n (g))" "/* Foo */"))
    (test-assert "so none survive into the C"
      (not (emits? "(fn f () void ;;; Foo\n (g))" ";;")))
    (test-assert "consecutive lines are packed into one comment"
      (emits? "(fn f () void\n ;; first\n ;; second\n (g))"
              "/* first\n second */"))
    ;; Packing compares locations rather than just looking for adjacent
    ;; comment forms, so a blank line still separates them.
    (test-assert "a blank line keeps them apart"
      (emits? "(fn f () void\n ;; first\n\n ;; second\n (g))" "/* first */")))

  ;; A `;' comment is a form, so one written inside a construct with
  ;; positional slots used to land in a slot and shift everything after
  ;; it -- silently. In an `if' the comment became the then-arm and the
  ;; then-arm became an `else if' condition, and it still compiled.
  ;; Comments are now taken out of the slots and emitted just before the
  ;; statement; comments in a body stay where they were written.
  (test-group "comments in positional slots"
    (test-assert "an if arm is not shifted"
      (not (emits? (in-fn "(if 1 ;; c\n (g 1) (g 2))") "else if")))
    (test-assert "and both arms survive"
      (emits? (in-fn "(if 1 ;; c\n (g 1) (g 2))") "g(1)"))
    (test-assert "the comment survives too"
      (emits? (in-fn "(if 1 ;; kept here\n (g 1) (g 2))") "kept here"))
    (test-assert "a for header is not shifted"
      (emits? (in-fn "(for ;; c\n (var i int 0) (< i 2) (++ i) (g i))")
              "for (int i = 0; i < 2; ++i)"))
    (test-assert "a while condition is not shifted"
      (emits? (in-fn "(while ;; c\n (< a b) (g 1))") "while (a < b)"))
    (test-assert "a var is not shifted"
      (emits? (in-fn "(var ;; c\n x int 5)") "int x = 5"))
    (test-assert "a cast is not shifted"
      (emits? (in-fn "(var y int (cast ;; c\n a int))") "(int)a"))
    ;; Bodies are a statement sequence, so comments there stay put.
    (test-assert "a comment in a body stays in the body"
      (emits? (in-fn "(while (< a b) ;; inside\n (g 1))")
              "while (a < b) {")))

  (test-group "pub enum"
    (test-assert "is emitted"
      (emits? "(pub enum color (red green blue))" "enum color"))
    (test-assert "with its values"
      (emits? "(pub enum color (red green blue))" "red"))
    (test-assert "and a non-pub enum still is too"
      (emits? "(enum color (red green blue))" "enum color"))
    ;; Naming an enum as a type, rather than defining it, had no
    ;; walk-enum clause and died with `(match) no matching pattern'
    (test-assert "and it can then be used as a type"
      (emits? "(enum color (red green blue)) (fn f () void (var m (enum color) red))"
              "enum color m = red"))
    (test-assert "a malformed enum is rejected with its location"
      (reports? "(enum)" "codegen.sex:1:"))
    ;; c-type handed the declarator's name to c-enum as the enum tag,
    ;; so this emitted `enum m { up, down }' with no variable at all
    (test-assert "an anonymous enum keeps the variable"
      (emits? "(fn f () void (var e (enum (up down)) up))" "} e = up"))
    (test-assert "and a named definition keeps both"
      (emits? "(fn f () void (var n (enum named (a b)) a))" "enum named{")))

  ;; `|', `||' and `|=' read as ordinary symbols -- our own reader has
  ;; no |symbol| syntax for them to collide with -- but fmt-c cannot
  ;; dispatch on a symbol whose name it cannot write in Scheme source,
  ;; so they used to fall through to the function-call path and emit
  ;; `|\||(a, b)'. The writer renames them to heads fmt-c spells with
  ;; a string.
  (test-group "bitwise and logical operators"
    (test-assert "bit-or"
      (emits? (in-fn "(var x int (| a b))") "int x = a | b"))
    (test-assert "logical or"
      (emits? (in-fn "(var x int (|| a b))") "int x = a || b"))
    (test-assert "or-assign"
      (emits? (in-fn "(|= a b)") "a |= b"))
    (test-assert "bit-and"
      (emits? (in-fn "(var x int (& a b))") "int x = a & b"))
    (test-assert "logical and"
      (emits? (in-fn "(var x int (&& a b))") "int x = a && b"))

    ;; Precedence too: the operator reaches fmt-c as a string it looks
    ;; up, not as a symbol in its table
    (test-assert "parenthesised where C needs it"
      (emits? (in-fn "(var x int (& (| a b) a))") "(a | b) & a"))
    (test-assert "and left alone where it does not"
      (emits? (in-fn "(var x int (| a (& a b)))") "int x = a | a & b"))

    ;; The spelling from before they could be written directly
    (test-assert "c-or is still accepted"
      (emits? (in-fn "(var x int (c-or a b))") "a || b"))
    (test-assert "c-bit-or is still accepted"
      (emits? (in-fn "(var x int (c-bit-or a b))") "a | b")))

  ;; A `;' comment is a form. In a macro body `comment' is a no-op
  ;; that swallows the comment itself. Inside a quasiquoted payload
  ;; the same form is data, never evaluated, and reaches the writer
  ;; intact
  (test-group "comments in macros"
    (test-assert "a comment in the payload reaches the C"
      (emits? "(defmacro (m-kept) `(fn f () void\n ;; this survives\n (g)))\n(m-kept)"
              "this survives"))
    (test-assert "a comment about the macro does not"
      (not (emits? "(defmacro (m-dropped)\n ;; this vanishes\n `(fn f () void (g)))\n(m-dropped)"
                   "this vanishes")))
    (test-assert "and the macro still expands"
      (emits? "(defmacro (m-both)\n ;; about the macro\n `(fn f () void (g)))\n(m-both)"
              "void f (void)")))

  ;; Diagnostics name also the place. Every form carries a (file
  ;; . line), so an error can cite it
  (test-group "errors cite the source location"
    (test-assert "unknown toplevel form"
      (reports? "(include stdio.h)\n(wat 1 2)" "codegen.sex:2: unknown top level form"))
    (test-assert "the offending form is shown too"
      (reports? "(include stdio.h)\n(wat 1 2)" "(wat 1 2)"))
    (test-assert "pub with nothing to define"
      (reports? "(pub 1)" "codegen.sex:1:")))

  ;; A nested pointer chain used to silently lose a level:
  ;; (var p (* (* char))) emitted `char *p'
  (test-group "malformed types are rejected"
    (test-assert "nested pointer chain"
      (reports? (in-fn "(var p (* (* char)))") "pointer chains are written flat"))
    (test-assert "and names the line"
      (reports? "(pub fn f () void\n  (var p (* (* char))))" "codegen.sex:2:"))
    ;; A sublist that only groups has no `*' in it and must still work.
    (test-assert "grouping sublist still accepted"
      (emits? (in-fn "(var s (* (const struct suc)) 0)") "const struct suc * s"))
    (test-assert "flat chain still accepted"
      (emits? (in-fn "(var q (* * const char) 0)") "const char * * q")))

  ;; A string as the first body form (or after the name of a struct,
  ;; union or enum) is a docstring: it becomes a comment immediately
  ;; before the declaration, not a statement inside it.
  (test-group "docstrings"
    (test-assert "appears before the function"
      (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))"
              "/* Greet NAME. */"))
    (test-assert "and not inside the body as a statement"
      (not (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))"
                   "\"Greet NAME.\"")))
    (test-assert "multiline keeps its paragraphs"
      (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))"
              "Entry point."))
    (test-assert "and the second paragraph too"
      (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))"
              "ARGC and ARGV."))
    (test-assert "a prototype with only a docstring stays a prototype"
      (emits? "(fn helper ((a int)) int \"Forward.\")"
              "helper (int a);"))
    (test-assert "a string after the first statement is left alone"
      (emits? "(fn f () void (g) \"not a docstring\")"
              "\"not a docstring\""))
    (test-assert "a struct docstring sits above the struct"
      (emits? "(struct point \"A 2D point.\" ((x int) (y int)))"
              "/* A 2D point. */"))
    (test-assert "and an enum docstring too"
      (emits? "(enum color \"RGB.\" (red green blue))"
              "/* RGB. */")))

  ;; `static-assert' is the keyword rather than the <assert.h> macro, so
  ;; a static assertion costs no include. Mapped in `atom-to-fmt-c'
  ;; because `unkebabify' alone would spell it `static_assert'.
  (test-group "static-assert"
    (test-assert "emits the C11 keyword"
      (emits? (in-fn "(static-assert (== (sizeof int) 4) \"int is four bytes\")")
              "_Static_assert(sizeof(int) == 4, \"int is four bytes\")"))
    (test-assert "and not the header macro"
      (not (emits? (in-fn "(static-assert (== (sizeof int) 4) \"x\")")
                   "static_assert("))))

  ;; A closure is a code pointer beside its captures. The struct is
  ;; named from the signature, so separate translation units agree on
  ;; it, and calling one goes through `code' with `env' passed first.
  ;;
  ;; A closure struct, and the helper its calls go through, are each
  ;; emitted once per signature; the registries deciding that are
  ;; compile-time state like the type databases, and outlive a single
  ;; `sex->c' here. So every case below that looks for a *definition*
  ;; uses a signature of its own -- cases looking at a call site can
  ;; share one.
  (test-group "closures"
    (test-assert "the type becomes a struct named for its signature"
      (emits? "(fn f ((c (closure ((int)) int))) int (return (c 1)))"
              "struct ƛint_int"))
    ;; The environment is one shared union, declared in the prelude --
    ;; its layout is part of the ABI two units agree on, so it cannot
    ;; depend on what either file contains. `sex->c' has no prelude, so
    ;; what is visible here is the member
    (test-assert "whose environment is the shared union"
      (emits? "(fn f ((c (closure ((float)) int))) int (return (c 1.0)))"
              "union ƛenv env;"))
    ;; The receiver goes through a helper rather than being written
    ;; out twice, so that `[table (++ i)]' evaluates its index once,
    ;; exactly as it would for an array of function pointers
    (test-assert "a call passes the receiver to a helper"
      (emits? "(fn f ((c (closure ((int)) int))) int (return (c 1)))"
              "ƛint_int_call(c, 1)"))
    (test-assert "and the helper is what dereferences it"
      (emits? "(fn f ((c (closure ((long)) int))) int (return (c 1)))"
              "ƛc.code(&ƛc.env, ƛa0)"))
    (test-assert "a subscript receiver is evaluated once"
      (emits? "(fn f ((t (¤ (closure ((int)) int) 4)) (i int)) int (return ((¤ t (++ i)) 1)))"
              "ƛint_int_call(t[++i], 1)"))
    (test-assert "so is a member receiver"
      (emits? "(struct h ((cb (closure ((int)) int))))
               (fn f ((s (struct h))) int (return ((. s cb) 1)))"
              "ƛint_int_call(s.cb, 1)"))
    (test-assert "a captured name is rebound in the lifted body"
      (emits? "(fn f ((n int)) (closure ((char)) int) (return (closure ((x char)) int (n) (return n))))"
              "int n = ƛcaptures->n;"))
    (test-assert "captures are checked against the environment"
      (emits? "(fn f ((n int)) (closure ((short)) int) (return (closure ((x short)) int (n) (return n))))"
              "_Static_assert(sizeof(struct"))
    ;; A closure over nothing has no record to point at, and C has no
    ;; empty struct to declare for it
    (test-assert "no captures means no capture record"
      (not (emits? "(fn f () (closure () int) (return (closure () int () (return 7))))"
                   "_captures {")))
    ;; `(name expr)' names a capture and gives what it holds, so the
    ;; expression is evaluated once, where the closure is written
    (test-assert "a named capture takes its type from the expression"
      (emits? "(struct p ((x int) (y int)))
               (fn f ((s (struct p))) (closure () int)
                 (return (closure () int ((sum (+ (. s x) (. s y)))) (return sum))))"
              "int sum;"))
    (test-assert "and the constructor is handed the expression"
      (emits? "(struct p ((x int) (y int)))
               (fn f ((s (struct p))) (closure () int)
                 (return (closure () int ((sum (+ (. s x) (. s y)))) (return sum))))"
              "_make(s.x + s.y)"))
    (test-assert "capturing a pointer is how by-reference is spelled"
      (emits? "(struct p ((x int)))
               (fn f ((s (* (struct p)))) (closure () int)
                 (return (closure () int ((q s)) (return (-> q x)))))"
              "struct p* q;"))
    ;; A bare function is a closure that captures nothing, so it
    ;; converts wherever one is expected -- the pointer goes in the
    ;; environment and one thunk per signature reads it back out
    (test-assert "a named function in a var initializer"
      (emits? "(fn g ((n int)) int (return n))
               (fn f () void (var c (closure ((int)) int) g))"
              "ƛint_int_fromfn(g)"))
    (test-assert "a lambda, which is a bare function too"
      (emits? "(fn f () void (var c (closure ((int)) int)
                               (lambda ((n int)) int (return n))))"
              "ƛint_int_fromfn(λ0_f)"))
    (test-assert "an argument, against the parameter that signature wrote"
      (emits? "(fn g ((n int)) int (return n))
               (fn h ((c (closure ((int)) int))) int (return (c 1)))
               (fn f () int (return (h g)))"
              "h(ƛint_int_fromfn(g))"))
    (test-assert "a return, against the declared return type"
      (emits? "(fn g ((n int)) int (return n))
               (fn f () (closure ((int)) int) (return g))"
              "return ƛint_int_fromfn(g)"))
    (test-assert "the thunk reads the pointer out of the environment"
      (emits? "(fn g ((n float)) int (return 1))
               (fn f () void (var c (closure ((float)) int) g))"
              "return ƛcaptures->f(ƛa0)"))
    ;; a signature that does not match is left alone, and C rejects it
    (test-assert "a function of the wrong signature does not convert"
      (not (emits? "(fn g ((n float)) int (return 1))
                    (fn f () void (var c (closure ((int)) int) g))"
                   "_fromfn(g)")))
    ;; a closure is lifted into the function it was written in, so
    ;; there has to be one
    (test-assert "a closure at toplevel is refused"
      (reports? "(var c (closure () int) (closure () int () (return 1)))"
                "only be written inside a function"))
    (test-assert "and so is one in a struct field"
      (reports? "(struct s ((f (closure () int) (closure () int () (return 1)))))"
                "only be written inside a function"))
    ;; A block opens a scope, so what it declares ends with it
    (test-assert "a name shadowed in a block does not escape it"
      (emits? "(fn mk () (closure () int) (return (closure () int () (return 1))))
               (fn f () int (var c (closure () int) (mk))
                            (do (var c int 9) (g c))
                            (return (c)))"
              "ƛvoid_int_call(c)"))
    (test-assert "and the shadowing declaration is what the block sees"
      (emits? "(fn mk () (closure () int) (return (closure () int () (return 1))))
               (fn f () int (var c (closure () int) (mk))
                            (do (var c int 9) (g c))
                            (return (c)))"
              "g(c)"))
    ;; The receiver is written twice, so a name used as an argument
    ;; must not be mistaken for a call of its own
    (test-assert "a closure passed as an argument stays a value"
      (emits? "(fn g ((c (closure ((int)) int))) int (return 0))
               (fn f ((c (closure ((int)) int))) int (return (g c)))"
              "g(c)")))

  ;; a macro body reads types as lists, so the srfi-1 accessors are in
  ;; scope beside the type database
  (test-group "macro list accessors"
    (test-assert "third reads an array's length"
      (emits? "(defmacro (len t) (third t))
               (fn f () int (return (len (¤ int 7))))"
              "return 7;"))
    (test-assert "second reads a tag"
      (emits? "(defmacro (tag t) (symbol->string (second t)))
               (fn f () void (g (tag (struct point))))"
              "g(\"point\")")))

  ;; `type-of' hands a macro the type of an *expression*, where
  ;; `get-name-type' only answers for a name. The macro is expanded
  ;; during the walk rather than before it, so the scope is still live.
  (test-group "type-of"
    (test-assert "a local, from its declaration"
      (emits? "(defmacro (t x) (type-match (type-of x) (int 1) (else 0)))
               (fn f () int (var n int 0) (return (t n)))"
              "return 1;"))
    (test-assert "an expression, not just a name"
      (emits? "(defmacro (t x) (type-match (type-of x) (double 1) (else 0)))
               (fn f () int (var d double 0.0) (return (t (+ d 1))))"
              "return 1;"))
    (test-assert "a call, through the callee's signature"
      (emits? "(fn g () float (return 1.0))
               (defmacro (t x) (type-match (type-of x) (float 1) (else 0)))
               (fn f () int (return (t (g))))"
              "return 1;"))
    ;; a macro is shown the written spelling, not the generated struct
    (test-assert "a closure, spelled the way it was written"
      (emits? "(fn mk () (closure ((int)) int)
                 (return (closure ((b int)) int () (return b))))
               (defmacro (t x) (type-match (type-of x) ((closure _ _) 1) (else 0)))
               (fn f () int (var c _ (mk)) (return (t c)))"
              "return 1;"))
    (test-assert "and calling one has the closure's return type"
      (emits? "(fn mk () (closure ((int)) int)
                 (return (closure ((b int)) int () (return b))))
               (defmacro (t x) (type-match (type-of x) (int 1) (else 0)))
               (fn f () int (var c _ (mk)) (return (t (c 1))))"
              "return 1;"))
    ;; outside an expansion there is no scope to ask about
    (test-assert "a name the walk has not reached is unknown"
      (emits? "(defmacro (t x) (type-match (type-of x) (int 1) (else 0)))
               (fn f () int (return (t nope)))"
              "return 0;")))

  ;; `_' as a type is written out from what the initializer says. The
  ;; answer comes from declarations and from the signature a call names,
  ;; never from unification -- a partial type would need one.
  (test-group "wildcard types"
    (test-assert "an integer literal"
      (emits? (in-fn "(var x _ 42)") "int x = 42"))
    (test-assert "a float literal"
      (emits? (in-fn "(var x _ 3.5)") "double x = 3.5"))
    (test-assert "a string literal"
      (emits? (in-fn "(var x _ \"hi\")") "const char * x"))
    (test-assert "a call, through the name table"
      (emits? "(fn g ((a int)) float (return 1.0))
               (fn f () void (var x _ (g 1)))"
              "float x = g(1)"))
    (test-assert "a struct member"
      (emits? "(struct p ((a int) (b float)))
               (fn f ((s (struct p))) void (var x _ (. s b)))"
              "float x = s.b"))
    (test-assert "an address, which composes"
      (emits? "(struct p ((a int)))
               (fn f ((s (struct p))) void (var x _ (& s)))"
              "struct p* x = &s"))
    (test-assert "a comparison is a bool"
      (emits? (in-fn "(var x _ (< a b))") "bool x = a < b"))
    ;; a wildcard inside a spelling is solved in place, leaving the rest
    ;; of the written type alone -- this is what needs the unifier
    (test-assert "a wildcard inside a pointer"
      (emits? "(struct p ((a int)))
               (fn f ((s (struct p))) void (var x (* _) (& s)))"
              "struct p* x = &s"))
    (test-assert "a wildcard inside an array"
      (emits? (in-fn "(var t (¤ _ 3) #((¤ int 3) : 1 2 3))") "int t[3]"))
    ;; a compound literal carries its own type, where a brace
    ;; initializer has none and takes one from its context
    (test-assert "a compound literal answers a bare wildcard"
      (emits? "(struct p ((a int) (b int)))
               (fn f () void (var x _ #((struct p) : 1 2)))"
              "struct p x = (struct p){1, 2}"))
    (test-assert "a brace initializer cannot"
      (reports? (in-fn "(var x _ #(1 2))") "cannot infer the type"))
    ;; ...but its elements still solve the hole in an array type
    (test-assert "elements solve an array's element type"
      (emits? (in-fn "(var t (¤ _ 4) #(0 1 4 9))") "int t[4] = {0, 1, 4, 9}"))
    (test-assert "including when there are fewer than the length"
      (emits? (in-fn "(var t (¤ _ 10) #(1 2))") "int t[10] = {1, 2}"))
    (test-assert "and they have to agree with each other"
      (reports? (in-fn "(var t (¤ _ 2) #(1 \"s\"))") "type mismatch"))
    ;; a closure type reaches the solver as the struct that stands for
    ;; it, which is the spelling `parse-type' knows
    (test-assert "a closure, from the signature that produced it"
      (emits? "(fn mk () (closure ((int)) int)
                 (return (closure ((b int)) int () (return b))))
               (fn f () void (var c _ (mk)))"
              "struct ƛint_int c = mk()"))
    (test-assert "and it is callable once inferred"
      (emits? "(fn mk () (closure ((int)) int)
                 (return (closure ((b int)) int () (return b))))
               (fn f () int (var c _ (mk)) (return (c 1)))"
              "ƛint_int_call(c, 1)"))
    ;; C's usual arithmetic conversions, far enough to answer `_'
    (test-assert "floating beats integral"
      (emits? (in-fn "(var d double 1.0) (var x _ (+ a d))") "double x = a + d"))
    (test-assert "the wider integer wins"
      (emits? (in-fn "(var l long 1) (var x _ (+ a l))") "long x = a + l"))
    (test-assert "double beats float"
      (emits? (in-fn "(var g float 1.0) (var d double 1.0) (var x _ (+ g d))")
              "double x = g + d"))
    (test-assert "and same-width operands stay put"
      (emits? (in-fn "(var g float 1.0) (var x _ (+ g g))") "float x = g + g"))
    (test-assert "a pointer operand makes it pointer arithmetic"
      (emits? "(struct p ((a int)))
               (fn f ((s (struct p))) void (var x _ (+ (& s) 1)))"
              "struct p* x = &s + 1"))
    ;; a written type that cannot match what the initializer gives
    (test-assert "a mismatch is reported, not papered over"
      (reports? (in-fn "(var p (* _) 42)") "type mismatch"))
    ;; a wildcard that cannot be answered is an error, not a guess
    (test-assert "with no initializer there is nothing to infer from"
      (reports? (in-fn "(var x _)") "cannot infer the type"))
    (test-assert "nor from a name the compiler never saw declared"
      (reports? (in-fn "(var x _ (never-declared))") "cannot infer the type")))

  ;; `(car res)' on the expansion assumed it was a pair, so a macro
  ;; computing a value rather than building a form crashed the compiler.
  (test-group "macro expanding to an atom"
    (test-assert "a number"
      (emits? "(defmacro (two) 2) (fn f () int (return (two)))"
              "return 2;"))
    (test-assert "a string"
      (emits? "(defmacro (who) \"sex\") (fn f () void (g (who)))"
              "g(\"sex\")"))
    ;; a symbol expansion can stand where a type does, which is what
    ;; makes a macro able to compute one
    (test-assert "a symbol, used as a type"
      (emits? "(defmacro (ty) 'int) (fn f () void (var x (ty) 0))"
              "int x = 0"))
    ;; ...and nothing at all, for a macro that only registers something
    (test-assert "nothing, at toplevel"
      (emits? "(defmacro (quiet) (list)) (quiet) (fn f () int (return 1))"
              "return 1;"))
    (test-assert "nothing, in a body"
      (emits? "(defmacro (quiet) (list)) (fn f () int (quiet) (return 1))"
              "return 1;"))
    ;; several forms need `$', which is what tells a splice from a call
    (test-assert "$ splices"
      (emits? "(defmacro (pair) (list '$ '(fn a () int (return 1))
                                         '(fn b () int (return 2))))
               (pair)"
              "b (void)"))
    (test-assert "and ($) is nothing at all"
      (emits? "(defmacro (quiet) (list '$)) (quiet) (fn f () int (return 1))"
              "return 1;"))
    ;; without `$' a list is one form, so a head that is itself a form
    ;; stays a call rather than becoming two statements
    (test-assert "a computed callee stays one form"
      (emits? "(fn mk () (closure ((int)) int)
                 (return (closure ((b int)) int () (return b))))
               (defmacro (apply-it x) `((mk) ,x))
               (fn f () int (return (apply-it 5)))"
              "ƛint_int_call(mk(), 5)"))
    ;; spliced, it would have become two forms in the `return' -- the
    ;; comma operator, and the wrong answer
    (test-assert "rather than two forms in its context"
      (not (emits? "(fn mk () (closure ((int)) int)
                      (return (closure ((b int)) int () (return b))))
                    (defmacro (apply-it x) `((mk) ,x))
                    (fn f () int (return (apply-it 5)))"
                   "return mk(), 5"))))

  ;; A unary expression parenthesised its operand rather than itself, so
  ;; the parens landed inside: `*(p).x', which C reads as `*(p.x)'.
  (test-group "unary operand precedence"
    (test-assert "member access through a dereference"
      (emits? "(struct pt ((x int))) (fn f ((p (* (struct pt)))) int (return (. (* p) x)))"
              "(*p).x"))
    (test-assert "and not with the parens inside"
      (not (emits? "(struct pt ((x int))) (fn f ((p (* (struct pt)))) int (return (. (* p) x)))"
                   "*(p).x")))
    (test-assert "member access through a cast"
      (emits? (in-fn "(var n int (. (* (cast a (* (struct s)))) f))")
              "(*(struct s*)a).f"))
    ;; ...without gaining parens where none are due
    (test-assert "a bare dereference is left alone"
      (emits? (in-fn "(var p (* int) 0) (= a (* p))") "a = *p"))
    (test-assert "so is address-of in an argument"
      (emits? (in-fn "(g (& a))") "g(&a)"))
    (test-assert "and negation beside a binary operator"
      (emits? (in-fn "(var n int (+ (- a) b))") "-a + b")))

  ;; An array bound was taken only when it was an integer literal, so a
  ;; symbolic one fell into the type: `(¤ int N)' came out `int N a[]'.
  (test-group "array bounds"
    (test-assert "a symbolic bound"
      (emits? "(define N 4) (struct s ((a (¤ int N))))" "int a[N]"))
    (test-assert "an expression bound"
      (emits? "(define N 4) (struct s ((a (¤ char (* 2 N)))))" "char a[2 * N]"))
    (test-assert "an integer bound still works"
      (emits? "(struct s ((a (¤ int 4))))" "int a[4]"))
    ;; a multi-word type is keywords all the way down, so a trailing
    ;; keyword belongs to the type and leaves the array unsized
    (test-assert "a multi-word type is not a bound"
      (emits? "(struct s ((a (¤ unsigned int))))" "unsigned int a[]"))
    ;; ...and a tag always follows its keyword
    (test-assert "nor is an aggregate tag"
      (emits? "(struct t ((z int))) (struct s ((a (¤ struct t))))" "struct t a[]"))
    (test-assert "nor one behind a pointer"
      (emits? "(struct t ((z int))) (struct s ((a (¤ * struct t))))" "struct t* a[]"))))