src/: Make pretty-printing better at handling tight margins.

[sod] / src / c-types-test.lisp

diff --git a/src/c-types-test.lisp b/src/c-types-test.lisp
index 16e41ce6be6f6264ceafd774f9789d32fe910ab6..483d1222b3eed88abf00668a916c2d434c9e048f 100644 (file)
--- 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
@@ -58,6 +58,7 @@ (defun expand-tabs (string)
 
 (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 (expand-tabs print) (expand-tabs string)
@@ -240,49 +241,60 @@ (def-test-method commentify-non-recursive ((test c-types-test) :run nil)
                                 ("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.
 
-(def-test-method parse-c-type ((test c-types-test) :run nil)
-  (flet ((check (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))))))))))
-
-    (check "int x" (c-type int) "x")
-    (check "int long unsigned long y" (c-type unsigned-long-long) "y")
-    (check "int long int x" nil nil)
-    (check "float v[69][42]" (c-type ([] float "69" "42")) "v")
-    (check "const char *const tab[]"
-          (c-type ([] (* (char :const) :const) ""))
-          "tab")
-    (check "void (*signal(int, void (*)(int)))(int)"
-          (c-type (func (* (func void (nil int)))
-                        (nil int)
-                        (nil (* (func void (nil int))))))
-          "signal")))
+(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 --------------------------------------------------