chiark - git - mdw - sod/blob - src/pset-test.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Test the property set implementation
   4 ;;;
   5 ;;; (c) 2013 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod-test)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Here we go.
  30
  31 (defclass pset-test (test-case) ())
  32 (add-test *sod-test-suite* (get-suite pset-test))
  33
  34 ;;;--------------------------------------------------------------------------
  35 ;;; Utilities.
  36
  37 (defun pset-equal-p (pset-a pset-b)
  38   (do ((i 0 (1+ i))
  39        (p (or pset-a (make-property-set)) q)
  40        (q (or pset-b (make-property-set)) p))
  41       ((>= i 2) t)
  42     (with-pset-iterator (next p)
  43       (loop (let ((prop (next)))
  44               (when (null prop) (return))
  45               (let ((other (pset-get q (p-key prop))))
  46                 (unless (and other
  47                              (equal (p-name prop) (p-name other))
  48                              (eq (p-type prop) (p-type other))
  49                              (equal (p-value prop) (p-value other)))
  50                   (return-from pset-equal-p nil))))))))
  51
  52 (defun assert-pset-equal (pset-a pset-b)
  53   (unless (pset-equal-p pset-a pset-b)
  54     (failure "Assert equal property sets: ~A ~_and ~A" pset-a pset-b)))
  55
  56 ;;;--------------------------------------------------------------------------
  57 ;;; Parser tests.
  58
  59 (defun check-pset-parse (string pset)
  60   (let* ((char-scanner (make-string-scanner string))
  61          (scanner (make-instance 'sod-token-scanner
  62                                  :char-scanner char-scanner
  63                                  :filename "<none>"))
  64          (errors nil))
  65     (with-parser-context (token-scanner-context :scanner scanner)
  66       (multiple-value-bind (result winp consumedp)
  67           (handler-bind ((error (lambda (cond)
  68                                   (declare (ignore cond))
  69                                   (setf errors t)
  70                                   (if (find-restart 'continue)
  71                                       (invoke-restart 'continue)
  72                                       :decline))))
  73             (parse-property-set scanner))
  74         (declare (ignore consumedp))
  75         (when errors (setf winp nil))
  76         (cond ((null pset)
  77                (assert-false winp))
  78               (t
  79                (assert-true winp)
  80                (unless (eq pset t)
  81                  (assert-pset-equal result pset))))))))
  82
  83 (def-test-method parse-empty ((test pset-test) :run nil)
  84   (check-pset-parse "anything" (make-property-set)))
  85
  86 (def-test-method parse-simple ((test pset-test) :run nil)
  87   (check-pset-parse "[ thing = 69 ]"
  88                     (make-property-set "thing" 69)))
  89
  90 (def-test-method parse-wrong ((test pset-test) :run nil)
  91   (check-pset-parse "[ broken = (1 + ]" nil))
  92
  93 (def-test-method parse-arith ((test pset-test) :run nil)
  94   (check-pset-parse (concatenate 'string "[ "
  95                                  "one = 13*5 - 16*4, "
  96                                  "two = \"spong\", "
  97                                  "three = 'c', "
  98                                  "four = something_different"
  99                                  "]")
 100                     (make-property-set "one" 1
 101                                        "two" "spong"
 102                                        "three" #\c
 103                                        "four" (cons :id
 104                                                     "something_different"))))
 105
 106 ;;;----- That's all, folks --------------------------------------------------