Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 14e219a748
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 62 lines (51 sloc) 2.269 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
(in-package :parser-combinators-tests)

(defsuite* (expression-test :in parser-combinators-tests))

;;; parser for basic +-*/ arithmetic with subexpressions and negation

(def-cached-parser unary-minus?
  (mdo (char? #\-) (result (curry #'list '-))))

(defun expr-arith? ()
  (expression? (nat*)
               `((,(unary-minus?) :unary)
                 (,(factor-op?) :left)
                 (,(expr-op?) :left))
               (char? #\()
               (char? #\))))

(defun expr-arith* ()
  (expression* (nat*)
               `((,(unary-minus?) :unary)
                 (,(factor-op?) :left)
                 (,(expr-op?) :left))
               (char? #\()
               (char? #\))))

(deftest test-expr1 ()
  (is (equal '(* 1 2)
             (tree-of (current-result (parse-string (expr-arith?) "1*2")))))
  (is (equal '(* 1 2)
             (tree-of (current-result (parse-string (expr-arith*) "1*2")))))
  (is (equal '(+ 1 (* 2 3))
             (tree-of (current-result (parse-string (expr-arith?) "1+2*3")))))
  (is (equal '(+ 1 (* 2 3))
             (tree-of (current-result (parse-string (expr-arith*) "1+2*3"))))))

(deftest test-expr2 ()
  (is (equal '(+ 1 (* 2 (- 3)))
             (tree-of (current-result (parse-string (expr-arith?) "1+2*-3")))))
  (is (equal '(+ 1 (* 2 (- 3)))
             (tree-of (current-result (parse-string (expr-arith*) "1+2*-3"))))))

(deftest test-expr3 ()
  (is (equal '(* (+ 1 2) 3)
             (tree-of (current-result (parse-string (expr-arith?) "(1+2)*3")))))
  (is (equal '(* (+ 1 2) 3)
             (tree-of (current-result (parse-string (expr-arith*) "(1+2)*3")))))
  (is (equal '(* 1 (+ 2 3))
             (tree-of (current-result (parse-string (expr-arith?) "1*(2+3)")))))
  (is (equal '(* 1 (+ 2 3))
             (tree-of (current-result (parse-string (expr-arith*) "1*(2+3)"))))))


(deftest test-random-expr-arith ()
  (iter (repeat 100)
        (let ((arith-string (make-random-arith-string 100)))
          (is (handler-case
                  (= (eval (infix:string->prefix arith-string))
                     (eval (collapse-ops (tree-of (current-result (parse-string (expr-arith*) arith-string))))))
                (division-by-zero ()
                  (print 'division-by-zero)
                  t))))))
Something went wrong with that request. Please try again.