sex/tests/fmt-c-writer.scm

;;; Types
(test-group "fmt-writer"

  (test
   '(const int)
   (walk-type '(const int)))

  (test
   '(%array (const char) 512)
   (walk-type '(¤ const char 512)))

  (test
   '(%array (float) 512)
   (walk-type '(¤ (float) 512)))

  (test
   '(%array (const char) 512)
   (walk-type '(¤ (const char) 512)))

  (test
   '(%array (const char))
   (walk-type '(¤ const char)))

  (test
   '(%array (const char))
   (walk-type '(¤ (const char))))

  (test
   '(%array float 8)
   (walk-type '(¤ float 8)))

  (test
   "Pointer to const char"
   '(const char *)
   (walk-type '(* const char)))

  (test
   "Const pointer to const char"
   '(const char * const)
   (walk-type '(const * const char)))

  (test
   '(%fun void ((int) (float) (%array (struct what * const))))
   (walk-type '(fn ((int) (float) (¤ (const * struct what))) void)))

  (test
   '(%fun void ((int) (%array float) (%array (struct what * const))))
   (walk-type '(fn ((int) (¤ float) (¤ (const * struct what))) void)))

  (test
   '(%array (%fun void ((int) (%array float) (%array (struct what * const)))))
   (walk-type '(¤ (fn ((int) (¤ float) (¤ (const * struct what))) void))))

  ;; Type convert to C
  (test
   '(int)
   (type-convert-to-c '(int)))

  (test
   '(* int)
   (type-convert-to-c '(int *)))

  (test
   '(* const int)
   (type-convert-to-c '(const int *)))

  (test
   '(const * const char)
   (type-convert-to-c '(const char * const)))

;;; Variable defs
  (test
   '(%var (%array float 8) a)
   (walk-var '(var a (¤ float 8))))

  (test
   '(%var (int *) a (& n))
   (walk-var '(var a (* int) (& n))))

  (test
   '(%var (const int *) a (& n))
   (walk-var '(var a (* const int) (& n))))

  (test
   '(%var (struct suc) s)
   (walk-var '(var s (struct suc))))

  (test
   '(%var (const struct suc *) s s1)
   (walk-var '(var s (* const struct suc) s1)))

  (test
   '(%var (const struct suc *) s s1)
   (walk-var '(var s (* (const struct suc)) s1)))

  (test
   '(%var (struct suc) s (hoge piyo))
   (walk-var '(var s (struct suc) (hoge piyo))))

  (test
   '(%var (struct suc *) s (hoge piyo))
   (walk-var '(var s (* struct suc) (hoge piyo))))

;;; Initializers and compound literals
  (test "a bare initializer is unchanged"
   '#(1 2)
   (walk-expr '#(1 2)))

  (test "`:' ends the type and makes it a compound literal"
   '(%compound (struct point) 3 4)
   (walk-expr '#(struct point : 3 4)))

  (test "the type is bare words, as everywhere else"
   '(%compound (const char *) 65)
   (walk-expr '#(* const char : 65)))

  (test "and may be an array type"
   '(%compound (%array int 3) 10 20 30)
   (walk-expr '#(¤ int 3 : 10 20 30)))

  (test "a grouped type is unwrapped the way a declaration's is"
   '(%compound (%array int 3) 10)
   (walk-expr '#((¤ int 3) : 10)))

  (test "`.field value' is a designated initializer, kebab and all"
   '(%compound (struct named) (%designate n 7) (%designate first_name "zoe"))
   (walk-expr '#(struct named : .n 7 .first-name "zoe")))

  (test "positional and designated may be mixed"
   '(%compound (struct point) 1 (%designate y 5))
   (walk-expr '#(struct point : 1 .y 5)))

  (test "designators work in an untyped initializer too"
   '#((%designate y 5))
   (walk-expr '#(.y 5)))

;;; Fn defs
  (test
   '(%fun void puk ((int) (%array float 8)))
   (walk-fn-def '(fn puk ((int) (¤ float 8)) void)))

  (test
   '(%fun int main ((int argc) ((%array (const char)) argv))
          (return 0))
   (walk-fn-def
    '(fn main ((argc int) (argv (¤ const char))) int
         (return 0))))
  (test
   '(%fun int quxu (((struct piq *) bar))
          (return 0))
   (walk-fn-def
    '(fn quxu ((bar (* struct piq))) int
         (return 0))))

  (test
   '(%fun int quxu (((struct piq *) bar) ((%array (struct tt *)) ploop))
          (return 0))
   (walk-fn-def
    '(fn quxu ((bar (* struct piq)) (ploop (¤ * struct tt))) int
         (return 0))))

  ;; Structs
  (test
   '(struct no_kebab ((int a) (float f)))
   (walk-struct '(struct no-kebab ((a int) (f float)))))

  (test
   '(struct settings ((u32 x y w h)
                      ((%array (struct ((float r g b a))) 4) colors)))
   (walk-struct
    '(struct settings
             ((x y w h u32)
              (colors [¤ struct ((r g b a float)) 4])))))

  (test
   '(struct settings ((u32 x y w h)
                      ((%array (struct color ((float r g b a))) 4) colors)))
   (walk-struct
    '(struct settings
             ((x y w h u32)
              (colors [¤ struct color ((r g b a float)) 4])))))

  (test
   '(struct mega_kebab ((int a)
                        ((struct ((int year) (int month) (int day))) dob)
                        ((%fun bool ((int) (%array int))) min)))
   (walk-struct '(struct mega-kebab
                         ((a int)
                          (dob (struct ((year int)
                                        (month int)
                                        (day int))))
                          (min (fn ((int) (¤ int)) bool)))))))