Put define-class tests into a single suite file

Combine the programs and error messages in
tests/parser-test-files/good-files/define-class.coal and
tests/parser-test-files/bad-files/define-class.* into define-class.txt

A structured input format is documented in tests/parser-test-files/README.md. It supports:

- reexecution of single cases
- selective test disabling
- optional error message checking
- test numbering

And provides a place to put additional test metadata.

The tests now compile their inputs, in addition to parsing.

Makefile

@@ -7,7 +7,7 @@ QUICKLISP=$(SBCL) --load $(QUICKLISP_HOME)/setup.lisp \
 	--eval '(push (truename ".") asdf:*central-registry*)' \
 	--eval "(push (truename \"../\") ql:*local-project-directories*)"
 
-.PHONY: test test-safe
+.PHONY: test test-release test-safe
 test:
 	sbcl --noinform \
 		--non-interactive \
@@ -19,6 +19,13 @@ test-safe:
 		 --eval "(sb-ext:restrict-compiler-policy 'safety 3)" \
 		 --eval "(asdf:test-system :coalton)"
 
+# Run all tests in release mode
+
+test-release:
+	COALTON_ENV=release sbcl --noinform \
+		--non-interactive \
+		--eval "(asdf:test-system :coalton)"
+
 .PHONY: docs
 docs:
 	sbcl --noinform \

source-error/src/error.lisp

@@ -470,10 +470,10 @@ Returns (VALUES LINE-NUM LINE-START-INDEX)"
         :with line-start-index := 0
         :for char := (read-char stream nil nil)
         :for char-index :from 0
-        :when (null char)
-          :do (error "Index ~D out of bounds for stream ~A" char-index stream)
         :when (= index char-index)
           :return (values line-num line-start-index)
+        :when (null char)
+          :do (error "Index ~D out of bounds for stream ~A" char-index stream)
         :when (char= char #\Newline)
           :do (incf line-num)
               (setf line-start-index (1+ char-index))))

src/typechecker/define-type.lisp

@@ -336,7 +336,7 @@
                                       (partial-type-env-lookup-var
                                        env
                                        (parser:keyword-src-name var)
-                                       (source:location var)))
+                                       var))
                                     (parser:type-definition-vars type)))
 
              :for repr := (parser:type-definition-repr type)

tests/loader.lisp

@@ -1,41 +1,19 @@
 ;;;; This package contains the function LOAD-TEST-FILE for loading
 ;;;; parser tests from specially formatted files.
 ;;;;
-;;;; The format is:
+;;;; - The format is documented in tests/test-files/README.md
+;;;; - Tests are defined in tests/test-files/*.txt
+;;;; - These tests are loaded and run by tests/coalton-tests.lisp
+;;;; - COALTON-TESTS:RUN-TEST-FILE and COALTON-TESTS:RUN-TEST are
+;;;;   defined in tests/utilities.lisp
 ;;;;
-;;;;     ======
-;;;;     <header>
-;;;;     ======
-;;;;     <program>
-;;;;     ------
-;;;;     <error message>
-;;;;       or
-;;;;     <empty string, to assert that the program must compile without error>
-;;;;     ======
-;;;;     <header 2>
-;;;;     ...
+;;;; To execute a single suite:
 ;;;;
-;;;; The first sequence of one or more consecutive numeric characters
-;;;; in the test header will be interpreted as a test number, for
-;;;; reexecution of single tests.
+;;;;   (coalton-tests:run-test-file #<pathname>)
 ;;;;
-;;;; There are examples in tests/parser-test-files/*.txt
+;;;; To run a single numbered test without condition handlers:
 ;;;;
-;;;; Use
-;;;;
-;;;;     (load-test-file #<pathname>)
-;;;;
-;;;; to load tests,
-;;;;
-;;;;     (run-test-file #<pathname>)
-;;;;
-;;;; to run tests, and
-;;;;
-;;;;     (run-test #<pathname> N)
-;;;;
-;;;; to run a single numbered test without condition handlers.
-;;;;
-;;;; RUN-TEST-FILE and RUN-TEST are defined in tests/utilities.lisp
+;;;;   (coalton-tests:run-test #<pathname> N)
 
 (defpackage #:coalton-tests/loader
   (:documentation "Load tests from a delimited file.")
@@ -68,7 +46,7 @@
     state))
 
 (defun collect-line (state line)
-  "Collect a line into a given section"
+  "Collect a line in a given section."
   (with-next-state state
     (case (loader-state state)
       (:header (push line (loader-header state)))
@@ -78,6 +56,7 @@
     state))
 
 (defun combine-lines (lines)
+  "Reassemble collected lines into a single string."
   (string-trim '(#\Space #\Newline)
                (format nil "~{~A~%~}" (reverse lines))))
 
@@ -91,15 +70,26 @@
                            (subseq string 0 end)
                            string))))))
 
+(defun read-flags (string)
+  "Read the first parenthesis-delimited form appearing in STRING, or nil."
+  (let ((open (position #\( string))
+        (close (position #\) string)))
+    (when (and open close (< open close))
+      (with-input-from-string (stream (subseq string open (1+ close)))
+        (read stream)))))
+
 (defun get-case (state)
+  "Assemble a complete test case based on collected header and section values."
   (let ((header (combine-lines (loader-header state))))
     (list (loader-start state)
           (first-integer header)
+          (read-flags header)
           header
           (combine-lines (loader-program state))
           (combine-lines (loader-error state)))))
 
 (defun collect-case (state)
+  "Assemble a test case, collect it, and reset to empty state."
   (with-next-state state
     (push (get-case state) (loader-cases state))
     (setf (loader-header state) nil
@@ -108,15 +98,18 @@
     state))
 
 (defun start-case (state)
+  "Perform bookkeeping to begin collecting a test case."
   (with-next-state state
     (setf (loader-start state) (loader-line state))
     state))
 
 (defun line-start-p (line char)
+  "Return T if LINE begins with CHAR."
   (and (plusp (length line))
        (char= (aref line 0) char)))
 
 (defun process-line (state line)
+  "Step the case reader state machine by consuming a single line of input."
   (with-next-state state
     (incf (loader-line state))
     (cond ((null line)
@@ -137,7 +130,7 @@
            (collect-line state line)))))
 
 (defun load-test-file (pathname)
-  "Load PATHNAME, a file containing multiple tests."
+  "Load a set of test cases from PATHNAME."
   (with-open-file (stream pathname :direction ':input :element-type 'character)
     (loop :for state := (make-loader)
             :then (process-line state (read-line stream nil nil))

tests/parser-test-files/README.md

@@ -0,0 +1,84 @@
+# Test Case Input Format
+
+The files in this directory contain test cases in a structured text
+format.
+
+A test consists of a header section, a program section, and an
+optional error section, separated by rows of '=' and '-'
+characters.
+
+Section separators contain any non-zero number of ='s or -'s starting
+at a newline.
+
+The header may contain a test number (the first integer to appear
+anywhere in the header).
+
+The header may also contain a set of flags, expressed as a readable
+list of Lisp keywords.
+
+Supported flags are:
+
+- :disable Disable a test case
+
+## Examples
+
+### Example 1
+
+The structure of a test.
+
+```
+============================================================
+{NUMBER} HEADER (:FLAG :FLAG2)
+============================================================
+
+PROGRAM BODY
+
+------------------------------------------------------------
+
+ERROR MESSAGE
+```
+
+### Example 2
+
+A test that checks that a program parses and compiles.
+
+```
+================================================================================
+Simple Test Case
+================================================================================
+
+(package my-test-package
+  (import coalton-prelude))
+
+(declare fib (Integer -> Integer))
+(define (fib n)
+  "Compute the nth Fibonacci number"
+  (match n
+    (0 0)
+    (1 1)
+    (_ (+ (fib (1- n))
+          (fib (- n 2))))))
+```
+
+### Example 3
+
+A numbered, disabled test that checks that an invalid return
+statement is detected.
+
+```
+================================================================================
+101 return, trailing junk       (:disable)
+================================================================================
+
+(package test-package)
+
+(define x (return y z))
+
+--------------------------------------------------------------------------------
+
+error: Malformed return expression
+  --> test:3:20
+   |
+ 3 |  (define x (return y z))
+   |                      ^ unexpected trailing form
+```