; Copyright 2005-2007 Kevin Reid, under the terms of the MIT X license
; found at http://www.opensource.org/licenses/mit-license.html ................

(defpackage :e.lisp-test.sugar
  (:use :cl :e.lisp-test :e.elib))
(cl:in-package :e.lisp-test.sugar)


(deftest escape-bind.no
  (escape-bind (foo)
      (*)
    (value)
      (list value))
  1)

(deftest escape-bind.yes
  (escape-bind (foo)
      (efuncall foo "out")
    (value)
      (list value))
  ("out"))

(deftest escape.no
  (escape (foo)
    (*))
  1)

(deftest escape.yes
  (escape (foo)
    (e. foo |run| "out"))
  "out")


(deftest mapping-bind.trivial
  (mapping-bind +empty-const-map+
                ()
    "ok")
  "ok")

(deftest mapping-bind.notype
  (mapcar #'e-print (multiple-value-list (ignore-errors
    (mapping-bind nil
                  ()
      "nok"))))
  ; XXX we really need better e-print syntax for cons cells
  ("null" "problem: no such method: org.cubik.cle.prim.null#size/0"))

(deftest mapping-bind.various
  (let ((x 0))
    (mapping-bind (e. +the-make-const-map+ |fromPairs|
                    #(#("a" "alpha") #(#\c "gamma")))
                  ((a "a")
                   (b :b (incf x))
                   (c #\c "oops")
                   (d "d" b))
      (list a b c d)))
  ("alpha" 1 "gamma" 1))

(defmacro with-vat-1 (&body b)
  `(block nil
     (with-vat (:label ,(format nil "with-vat-1 form: ~S" b))
       (return (progn ,@b)))))

(deftest mapping-bind.missing
  (with-vat-1
    (mapcar #'e-print (multiple-value-list (ignore-errors
      (mapping-bind (e. +the-make-const-map+ |fromPairs|
                      #(#(1 2)))
                    ((a 3))
        a)))))
  ("null" "problem: needs a mapping for 3, got [1 => 2]"))

(deftest mapping-bind.too-many
  (with-vat-1
    (mapcar #'e-print (multiple-value-list (ignore-errors
      (mapping-bind (e. +the-make-const-map+ |fromPairs|
                      #(#(1 2)))
                    ()
        "nok")))))
  ("null" "problem: unexpected map entries [1 => 2]"))