Add Boucher's `lalr-scm' as the `(system base lalr)' module.

[bpt/guile.git] / test-suite / lalr / common-test.scm

diff --git a/test-suite/lalr/common-test.scm b/test-suite/lalr/common-test.scm
new file mode 100644 (file)
index 0000000..8563029
--- /dev/null
+++ b/test-suite/lalr/common-test.scm
@@ -0,0 +1,63 @@
+;;; common-test.scm --
+;;;
+
+;; Slightly modified for Guile by Ludovic Courtès <ludo@gnu.org>, 2010.
+
+(use-modules (system base lalr)
+             (ice-9 pretty-print))
+
+(define *error* '())
+
+(define-syntax when
+  (syntax-rules ()
+    ((_ ?expr ?body ...)
+     (if ?expr
+        (let () ?body ...)
+       #f))))
+
+(define-syntax check
+  (syntax-rules (=>)
+    ((_ ?expr => ?expected-result)
+     (check ?expr (=> equal?) ?expected-result))
+
+    ((_ ?expr (=> ?equal) ?expected-result)
+     (let ((result     ?expr)
+          (expected    ?expected-result))
+       (set! *error* '())
+       (when (not (?equal result expected))
+        (display "Failed test: \n")
+        (pretty-print (quote ?expr))(newline)
+        (display "\tresult was: ")
+        (pretty-print result)(newline)
+        (display "\texpected: ")
+        (pretty-print expected)(newline)
+         (exit 1))))))
+
+;;; --------------------------------------------------------------------
+
+(define (display-result v)
+  (if v
+      (begin
+        (display "==> ")
+        (display v)
+        (newline))))
+
+(define eoi-token
+  (make-lexical-token '*eoi* #f #f))
+
+(define (make-lexer tokens)
+  (lambda ()
+    (if (null? tokens)
+       eoi-token
+      (let ((t (car tokens)))
+       (set! tokens (cdr tokens))
+       t))))
+
+(define (error-handler message . args)
+  (set! *error* (cons `(error-handler ,message . ,(if (pair? args)
+                                                     (lexical-token-category (car args))
+                                                   '()))
+                     *error*))
+  (cons message args))
+
+;;; end of file