tests/test.lisp

   1 ;;;; -*- encoding:utf-8 -*-
   2
   3 ;;; Copyright 2005-2006 Henrik Hjelte
   4 ;;; Copyright 2007-2012 Vladimir Sedach
   5
   6 ;;; SPDX-License-Identifier: BSD-3-Clause
   7
   8 ;;; Redistribution and use in source and binary forms, with or
   9 ;;; without modification, are permitted provided that the following
  10 ;;; conditions are met:
  11
  12 ;;; 1. Redistributions of source code must retain the above copyright
  13 ;;; notice, this list of conditions and the following disclaimer.
  14
  15 ;;; 2. Redistributions in binary form must reproduce the above
  16 ;;; copyright notice, this list of conditions and the following
  17 ;;; disclaimer in the documentation and/or other materials provided
  18 ;;; with the distribution.
  19
  20 ;;; 3. Neither the name of the copyright holder nor the names of its
  21 ;;; contributors may be used to endorse or promote products derived
  22 ;;; from this software without specific prior written permission.
  23
  24 ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  25 ;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  26 ;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  27 ;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  28 ;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
  29 ;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  30 ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  31 ;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  32 ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  33 ;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  34 ;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  35 ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  36 ;;; POSSIBILITY OF SUCH DAMAGE.
  37
  38 (in-package #:parenscript.tests)
  39
  40 (defun normalize-js-output (str)
  41   (cl-ppcre:regex-replace-all "\\s+" str " "))
  42
  43 (defmacro test-ps-js (testname parenscript javascript
  44                       &key (js-target-version *js-target-version*))
  45   `(fiveam:test ,testname ()
  46      (fiveam:is
  47       (string= (normalize-js-output ,javascript)
  48                (normalize-js-output
  49                 (let ((*js-target-version* ,js-target-version))
  50                   (ps-doc* ',parenscript)))))))
  51
  52 (defun js-repr (x)
  53   (cond ((or (consp x) (simple-vector-p x))
  54          (cl-js:js-array
  55           (make-array (length x)
  56                       :initial-contents (map 'vector #'js-repr x)
  57                       :adjustable t)))
  58         ((null x) :null)
  59         (t x)))
  60
  61 (defmacro %test-js-eval (testname parenscript test-statement
  62                          js-target-version)
  63   `(fiveam:test ,testname ()
  64      (cl-js:with-js-env ()
  65        (let* ((*js-target-version* ,js-target-version)
  66               (js-result (cl-js:run-js (ps-doc* ',parenscript))))
  67          ,test-statement))))
  68
  69 (defmacro test-js-eval (testname parenscript expected
  70                         &key (js-target-version *js-target-version*))
  71   `(%test-js-eval ,testname ,parenscript
  72      (fiveam:is (equalp js-result (js-repr ,expected)))
  73      ,js-target-version))
  74
  75 (defmacro test-js-eval-epsilon (testname parenscript expected
  76                                 &key (js-target-version *js-target-version*))
  77   `(%test-js-eval ,testname ,parenscript
  78      (fiveam:is (< (abs (- js-result ,expected)) 0.0001))
  79      ,js-target-version))
  80
  81 (fiveam:def-suite parenscript-tests)
  82 (fiveam:def-suite output-tests         :in parenscript-tests)
  83 (fiveam:def-suite package-system-tests :in parenscript-tests)
  84 (fiveam:def-suite eval-tests           :in parenscript-tests)
  85
  86 (defun run-tests ()
  87   (let ((*js-string-delimiter* #\'))
  88     (fiveam:run! 'parenscript-tests)))