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

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

diff --git a/test-suite/lalr/test-glr-associativity.scm b/test-suite/lalr/test-glr-associativity.scm
new file mode 100644 (file)
index 0000000..6a5a5e2
--- /dev/null
+++ b/test-suite/lalr/test-glr-associativity.scm
@@ -0,0 +1,102 @@
+;;; test-glr-associativity.scm
+;;
+;;With the GLR parser both  the terminal precedence and the non-terminal
+;;associativity  are  not  respected;  rather they  generate  two  child
+;;processes.
+;;
+
+(load "common-test.scm")
+
+(define parser
+  (lalr-parser
+   (driver: glr)
+   (expect: 0)
+
+   (N LPAREN RPAREN
+       (left: + -)
+       (right: * /)
+       (nonassoc: uminus))
+
+   (output     (expr)                  : $1)
+   (expr       (expr + expr)           : (list $1 '+ $3)
+               (expr - expr)           : (list $1 '- $3)
+               (expr * expr)           : (list $1 '* $3)
+               (expr / expr)           : (list $1 '/ $3)
+               (- expr (prec: uminus)) : (list '- $2)
+               (N)                   : $1
+               (LPAREN expr RPAREN)    : $2)))
+
+(define (doit . tokens)
+  (parser (make-lexer tokens) error-handler))
+
+;;; --------------------------------------------------------------------
+
+;;Remember that the result of the GLR  driver is a list of parses, not a
+;;single parse.
+
+(check
+    (doit (make-lexical-token 'N #f 1))
+  => '(1))
+
+(check
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '+ #f '+)
+         (make-lexical-token 'N #f 2))
+  => '((1 + 2)))
+
+(check
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '* #f '*)
+         (make-lexical-token 'N #f 2))
+  => '((1 * 2)))
+
+(check
+    (doit (make-lexical-token '- #f '-)
+         (make-lexical-token 'N #f 1))
+  => '((- 1)))
+
+(check
+    (doit (make-lexical-token '- #f '-)
+         (make-lexical-token '- #f '-)
+         (make-lexical-token 'N #f 1))
+  => '((- (- 1))))
+
+(check
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '+ #f '+)
+         (make-lexical-token '- #f '-)
+         (make-lexical-token 'N #f 2))
+  => '((1 + (- 2))))
+
+;;; --------------------------------------------------------------------
+
+(check
+    ;;left-associativity
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '+ #f '+)
+         (make-lexical-token 'N #f 2)
+         (make-lexical-token '+ #f '+)
+         (make-lexical-token 'N #f 3))
+  => '(((1 + 2) + 3)))
+
+(check
+    ;;right-associativity
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '* #f '*)
+         (make-lexical-token 'N #f 2)
+         (make-lexical-token '* #f '*)
+         (make-lexical-token 'N #f 3))
+  => '(((1 * 2) * 3)
+       (1 * (2 * 3))))
+
+(check
+    ;;precedence
+    (doit (make-lexical-token 'N #f 1)
+         (make-lexical-token '+ #f '+)
+         (make-lexical-token 'N #f 2)
+         (make-lexical-token '* #f '*)
+         (make-lexical-token 'N #f 3))
+  => '(((1 + 2) * 3)
+       (1 + (2 * 3))))
+
+;;; end of file