src/final.lisp (test-module): Make REASON be a keyword argument.

[sod] / src / final.lisp

diff --git a/src/final.lisp b/src/final.lisp
index e7a3eb4..96d82df 100644 (file)
--- a/src/final.lisp
+++ b/src/final.lisp
@@ -39,16 +39,23 @@
 (defvar *debugout-pathname* #p"debugout.c")
 
 (export 'test-module)
 (defvar *debugout-pathname* #p"debugout.c")
 
 (export 'test-module)

-(defun test-module (path reason)
-  "Reset the translator's state, read a module from PATH and output it with
-   REASON, returning the result as a string."
-  (clear-the-decks)
-  (setf *module-map* (make-hash-table :test #'equal))
-  (with-open-file (out *debugout-pathname*
-                  :direction :output
-                  :if-exists :supersede
-                  :if-does-not-exist :create)
-    (output-module (read-module path) reason out)))
+(defun test-module (path &key reason)
+  "Read a module from PATH, to exercise the machinery.
+
+   If REASON is non-nil, then output the module to `*debugout-pathname*' with
+   that REASON.
+
+   Return a two-element list (NERROR NWARNING) of the number of errors and
+   warnings encountered while processing the module."
+  (multiple-value-bind (module nerror nwarning)
+      (count-and-report-errors () (read-module path))
+    (when reason
+      (with-open-file (out *debugout-pathname*
+                      :direction :output
+                      :if-exists :supersede
+                      :if-does-not-exist :create)
+       (output-module module reason out)))
+    (list nerror nwarning)))

 
 (export 'test-parse-c-type)
 (defun test-parse-c-type (string)
 
 (export 'test-parse-c-type)
 (defun test-parse-c-type (string)


@@ -133,11 +140,15 @@
    That's the theory anyway.  Call this function before you dump an image and
    see what happens."
 
    That's the theory anyway.  Call this function before you dump an image and
    see what happens."
 

-  (clear-the-decks)

   (dolist (reason '(:h :c))
     (with-output-to-string (bitbucket)
       (output-module *builtin-module* reason bitbucket)))
 
   (clear-the-decks))
 
   (dolist (reason '(:h :c))
     (with-output-to-string (bitbucket)
       (output-module *builtin-module* reason bitbucket)))
 
   (clear-the-decks))
 

+;;;--------------------------------------------------------------------------
+;;; Make sure things work after loading the system.
+
+(clear-the-decks)
+

 ;;;----- That's all, folks --------------------------------------------------
 ;;;----- That's all, folks --------------------------------------------------