X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3109662aca9c06495ac22c5c58b46e1c036aca5c..12949379840101e2d65883f29c5e8f0f6de49e9c:/src/c-types-test.lisp

diff --git a/src/c-types-test.lisp b/src/c-types-test.lisp
index f1e4324..483d122 100644
--- a/src/c-types-test.lisp
+++ b/src/c-types-test.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- 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
@@ -42,11 +42,26 @@
   (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))))
@@ -226,10 +241,60 @@
 				 ("nopenfd" int))))
 		   "ftw"
 		   (format nil "~
-int ftw(const char */*dirpath*/,
-	int (*/*fn*/)(const char *fpath,
-		      const struct stat *sb,
-		      int typeflag),
+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 --------------------------------------------------