;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
(when (c-type-equal-p a b)
(failure "Assert unequal C types: ~A ~_and ~A" a b)))
+(defun expand-tabs (string)
+ (with-output-to-string (out)
+ (do ((i 0 (1+ i))
+ (char (char string 0) (char string i))
+ (pos 0))
+ ((>= i (length string)))
+ (case char
+ (#\newline (write-char char out)
+ (setf pos 0))
+ (#\tab (write-string " " out :end (- 8 (mod pos 8)))
+ (setf pos (logandc2 (+ pos 8) 7)))
+ (t (write-char char out)
+ (incf pos))))))
+
(defun assert-pp-ctype (type kernel string)
(let* ((*print-right-margin* 77)
+ (*print-pretty* t)
(print (with-output-to-string (out)
(pprint-c-type type out kernel))))
- (assert-equal print string
+ (assert-equal (expand-tabs print) (expand-tabs string)
(format nil "Type ~S with kernel ~S ~_prints as `~A' ~_~
rather than `~A'."
type kernel print string))))
("nopenfd" int))))
"ftw"
(format nil "~
-int ftw(const char */*dirpath*/,
- int (*/*fn*/)(const char *fpath,
- const struct stat *sb,
- int typeflag),
- int /*nopenfd*/)")))
+int ftw
+ (const char */*dirpath*/,
+ int (*/*fn*/)
+ (const char *fpath, const struct stat *sb, int typeflag),
+ int /*nopenfd*/)")))
+
+;;;--------------------------------------------------------------------------
+;;; Parsing.
+
+(defun check-c-type-parse (string c-type name)
+ (let* ((char-scanner (make-string-scanner string))
+ (scanner (make-instance 'sod-token-scanner
+ :char-scanner char-scanner
+ :filename "<none>")))
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (define-module ("<temporary>" :truename nil :location scanner)
+ (multiple-value-bind (result winp consumedp)
+ (parse (seq ((ds (parse-c-type scanner))
+ (dc (parse-declarator scanner ds))
+ :eof)
+ dc))
+ (declare (ignore consumedp))
+ (cond ((null c-type)
+ (assert-false winp))
+ (t
+ (assert-true winp)
+ (unless (eq c-type t)
+ (assert-cteqp (car result) c-type))
+ (unless (eq name t)
+ (assert-equal (cdr result) name)))))))))
+
+(def-test-method parse-simple ((test c-types-test) :run nil)
+ (check-c-type-parse "int x" (c-type int) "x"))
+
+(def-test-method parse-hairy-declspec ((test c-types-test) :run nil)
+ (check-c-type-parse "int long unsigned long y"
+ (c-type unsigned-long-long) "y"))
+
+(def-test-method parse-bogus-declspec ((test c-types-test) :run nil)
+ (check-c-type-parse "int long int x" nil nil))
+
+(def-test-method parse-array ((test c-types-test) :run nil)
+ (check-c-type-parse "float v[69][42]" (c-type ([] float "69" "42")) "v"))
+
+(def-test-method parse-array-of-pointers ((test c-types-test) :run nil)
+ (check-c-type-parse "const char *const tab[]"
+ (c-type ([] (* (char :const) :const) ""))
+ "tab"))
+
+(def-test-method parse-hairy-function-pointer ((test c-types-test) :run nil)
+ (check-c-type-parse "void (*signal(int, void (*)(int)))(int)"
+ (c-type (func (* (func void (nil int)))
+ (nil int)
+ (nil (* (func void (nil int))))))
+ "signal"))
;;;----- That's all, folks --------------------------------------------------