mdw@git.distorted.org.uk Git - sod/blob - src/c-types-test.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Test handling of C types
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensble Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod-test)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Here we go.
  30
  31 (defclass c-types-test (test-case) ())
  32 (add-test *sod-test-suite* (get-suite c-types-test))
  33
  34 ;;;--------------------------------------------------------------------------
  35 ;;; Utilities.
  36
  37 (defun assert-cteqp (a b)
  38   (unless (c-type-equal-p a b)
  39     (failure "Assert equal C types: ~A ~_and ~A" a b)))
  40
  41 (defun assert-not-cteqp (a b)
  42   (when (c-type-equal-p a b)
  43     (failure "Assert unequal C types: ~A ~_and ~A" a b)))
  44
  45 (defun assert-pp-ctype (type kernel string)
  46   (let* ((*print-right-margin* 77)
  47          (print (with-output-to-string (out)
  48                   (pprint-c-type type out kernel))))
  49     (assert-equal print string
  50                   (format nil "Type ~S with kernel ~S ~_prints as `~A' ~_~
  51                                rather than `~A'."
  52                           type kernel print string))))
  53
  54 ;;;--------------------------------------------------------------------------
  55 ;;; Simple types.
  56
  57 (def-test-method intern-trivial-simple-type ((test c-types-test) :run nil)
  58   (assert-eql (c-type "foo") (make-simple-type "foo")))
  59
  60 (def-test-method intern-qualified-simple-type ((test c-types-test) :run nil)
  61   (assert-eql (c-type ("foo" :const :volatile))
  62               (make-simple-type "foo" '(:volatile :const :volatile))))
  63
  64 (def-test-method mismatch-simple-type ((test c-types-test) :run nil)
  65   (assert-not-cteqp (c-type ("foo" :const)) (make-simple-type "foo")))
  66
  67 (def-test-method print-simple-type ((test c-types-test) :run nil)
  68   (assert-pp-ctype (c-type "foo") "f" "foo f"))
  69
  70 (def-test-method print-simple-type-abs ((test c-types-test) :run nil)
  71   (assert-pp-ctype (c-type "foo") nil "foo"))
  72
  73 ;;;--------------------------------------------------------------------------
  74 ;;; Tagged types.
  75
  76 (def-test-method intern-trivial-tagged-type ((test c-types-test) :run nil)
  77   (assert-eql (c-type (struct "foo")) (make-struct-type "foo")))
  78
  79 (def-test-method intern-trivial-tagged-type ((test c-types-test) :run nil)
  80   (assert-eql (c-type (enum "foo" :const :volatile))
  81               (make-enum-type "foo" '(:volatile :const :volatile))))
  82
  83 (def-test-method mismatch-tagged-type ((test c-types-test) :run nil)
  84   (assert-not-cteqp (c-type (enum "foo" :restrict))
  85                     (make-union-type "foo" '(:restrict))))
  86
  87 (def-test-method print-struct-type ((test c-types-test) :run nil)
  88   (assert-pp-ctype (c-type (struct "foo")) "f" "struct foo f"))
  89
  90 (def-test-method print-union-type-abs ((test c-types-test) :run nil)
  91   (assert-pp-ctype (c-type (union "foo")) nil "union foo"))
  92
  93 ;;;--------------------------------------------------------------------------
  94 ;;; Pointer types.
  95
  96 (def-test-method intern-trivial-pointer ((test c-types-test) :run nil)
  97   (assert-eql (c-type (* "foo"))
  98               (make-pointer-type (make-simple-type "foo"))))
  99
 100 (def-test-method intern-qualified-pointer ((test c-types-test) :run nil)
 101   (assert-eql (c-type (* "foo" :const :volatile))
 102               (make-pointer-type (make-simple-type "foo")
 103                                  '(:volatile :const))))
 104
 105 (def-test-method intern-double-indirection ((test c-types-test) :run nil)
 106   (assert-eql (c-type (* (* "foo")))
 107               (make-pointer-type
 108                (make-pointer-type (make-simple-type "foo")))))
 109
 110 (def-test-method non-intern-complex-pointer ((test c-types-test) :run nil)
 111   ;; The protocol doesn't specify what we do here; but we want to avoid
 112   ;; interning pointers to non-interned types in order to prevent the intern
 113   ;; table filling up with cruft.  So test anyway.
 114   (let ((a (c-type (* ([] "foo" 16))))
 115         (b (make-pointer-type
 116             (make-array-type (make-simple-type "foo") '(16)))))
 117     (assert-not-eql a b)
 118     (assert-cteqp a b)))
 119
 120 (def-test-method print-pointer ((test c-types-test) :run nil)
 121   (assert-pp-ctype (c-type (* char)) "p" "char *p"))
 122
 123 (def-test-method print-qualified-pointer ((test c-types-test) :run nil)
 124   (assert-pp-ctype (c-type (* char :restrict)) "p" "char *restrict p"))
 125
 126 (def-test-method print-pointer-abs ((test c-types-test) :run nil)
 127   (assert-pp-ctype (c-type (* char)) nil "char *"))
 128
 129 (def-test-method print-qualified-pointer-abs ((test c-types-test) :run nil)
 130   (assert-pp-ctype (c-type (* char :const)) nil "char *const"))
 131
 132 ;;;--------------------------------------------------------------------------
 133 ;;; Array types.
 134
 135 (def-test-method compare-simple-arrays ((test c-types-test) :run nil)
 136   (assert-cteqp (c-type ([] int 10))
 137                 (make-array-type (make-simple-type "int") (list 10))))
 138
 139 (def-test-method compare-multiarray-to-v-of-v ((test c-types-test) :run nil)
 140   (assert-cteqp (c-type ([] int 10 4))
 141                 (c-type ([] ([] int 4) 10))))
 142
 143 (def-test-method compare-multiarrays ((test c-types-test) :run nil)
 144   (assert-cteqp (c-type ([] ([] int 7 6) 10 9 8))
 145                 (c-type ([] ([] ([] int 6) 9 8 7) 10))))
 146
 147 (def-test-method bad-compare-multiarrays ((test c-types-test) :run nil)
 148   (assert-not-cteqp (c-type ([] ([] int 7 6) 10 9 8))
 149                     (c-type ([] ([] ([] int 6) 9 8 5) 10))))
 150
 151 (def-test-method compare-misshaped ((test c-types-test) :run nil)
 152   (assert-not-cteqp (c-type ([] ([] int 7) 10 9 8))
 153                     (c-type ([] ([] ([] int 6) 9 8 7) 10))))
 154
 155 (def-test-method print-array ((test c-types-test) :run nil)
 156   (assert-pp-ctype (c-type ([] ([] int 7 6) 10 9 8)) "foo"
 157                    "int foo[10][9][8][7][6]"))
 158
 159 (def-test-method print-array-abs ((test c-types-test) :run nil)
 160   (assert-pp-ctype (c-type ([] ([] int 7 6) 10 9 8)) nil
 161                    "int[10][9][8][7][6]"))
 162
 163 (def-test-method print-array-of-pointers ((test c-types-test) :run nil)
 164   (assert-pp-ctype (c-type ([] (* char))) nil "char *[]"))
 165
 166 (def-test-method print-pointer-to-array ((test c-types-test) :run nil)
 167   (assert-pp-ctype (c-type (* ([] char))) nil "char (*)[]"))
 168
 169 ;;;--------------------------------------------------------------------------
 170 ;;; Function types.
 171
 172 (def-test-method compare-simple-functions ((test c-types-test) :run nil)
 173   ;; Argument names don't matter.
 174   (assert-cteqp (c-type (fun int ("a" int) ("b" double)))
 175                 (make-function-type (make-simple-type "int")
 176                                     (list
 177                                      (make-argument "foo"
 178                                                     (make-simple-type "int"))
 179                                      (make-argument "bar"
 180                                                     (c-type double))))))
 181
 182 (def-test-method build-argument-tail ((test c-types-test) :run nil)
 183   (assert-cteqp (c-type (fun int ("a" int) ("b" double)))
 184                 (c-type (fun int ("foo" int)
 185                              . (list (make-argument "bar"
 186                                                     (c-type double)))))))
 187
 188 (def-test-method bad-compare-ellipsis ((test c-types-test) :run nil)
 189   (assert-not-cteqp (c-type (fun int ("x" int) :ellipsis))
 190                     (c-type (fun int ("y" int) ("z" double)))))
 191
 192 (def-test-method bad-compare-ellipsis ((test c-types-test) :run nil)
 193   (assert-not-cteqp (c-type (fun int ("x" int) :ellipsis))
 194                     (c-type (fun int ("y" int) ("z" double)))))
 195
 196 (def-test-method print-signal ((test c-types-test) :run nil)
 197   (assert-pp-ctype (c-type (fun (* (fun int (nil int)))
 198                                 ("signo" int)
 199                                 ("handler" (* (fun int (nil int))))))
 200                   "signal"
 201                   "int (*signal(int signo, int (*handler)(int)))(int)"))
 202
 203 (def-test-method print-commentify ((test c-types-test) :run nil)
 204   (assert-pp-ctype (commentify-function-type
 205                     (c-type (fun int
 206                                  ("n" size-t)
 207                                  (nil string)
 208                                  ("format" const-string)
 209                                  :ellipsis)))
 210                    "snprintf"
 211                    (concatenate 'string
 212                                 "int snprintf(size_t /*n*/, char *, "
 213                                              "const char */*format*/, "
 214                                              "...)")))
 215
 216 (def-test-method commentify-non-recursive ((test c-types-test) :run nil)
 217   ;; Also checks pretty-printing.
 218   (assert-pp-ctype (commentify-function-type
 219                     (c-type (fun int
 220                                  ("dirpath" const-string)
 221                                  ("fn" (* (fun int
 222                                                ("fpath" const-string)
 223                                                ("sb" (* (struct "stat"
 224                                                                 :const)))
 225                                                ("typeflag" int))))
 226                                  ("nopenfd" int))))
 227                    "ftw"
 228                    (format nil "~
 229 int ftw(const char */*dirpath*/,
 230         int (*/*fn*/)(const char *fpath,
 231                       const struct stat *sb,
 232                       int typeflag),
 233         int /*nopenfd*/)")))
 234
 235 ;;;----- That's all, folks --------------------------------------------------