Commit | Line | Data |
---|---|---|
048d0b2d MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Test the property set implementation | |
4 | ;;; | |
5 | ;;; (c) 2013 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
048d0b2d MW |
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) | |
048d0b2d | 68 | (setf errors t) |
e43bd955 MW |
69 | (if (find-restart 'continue cond) |
70 | (continue cond) | |
048d0b2d MW |
71 | :decline)))) |
72 | (parse-property-set scanner)) | |
73 | (declare (ignore consumedp)) | |
74 | (when errors (setf winp nil)) | |
75 | (cond ((null pset) | |
76 | (assert-false winp)) | |
77 | (t | |
78 | (assert-true winp) | |
79 | (unless (eq pset t) | |
80 | (assert-pset-equal result pset)))))))) | |
81 | ||
82 | (def-test-method parse-empty ((test pset-test) :run nil) | |
83 | (check-pset-parse "anything" (make-property-set))) | |
84 | ||
85 | (def-test-method parse-simple ((test pset-test) :run nil) | |
86 | (check-pset-parse "[ thing = 69 ]" | |
87 | (make-property-set "thing" 69))) | |
88 | ||
89 | (def-test-method parse-wrong ((test pset-test) :run nil) | |
90 | (check-pset-parse "[ broken = (1 + ]" nil)) | |
91 | ||
92 | (def-test-method parse-arith ((test pset-test) :run nil) | |
93 | (check-pset-parse (concatenate 'string "[ " | |
94 | "one = 13*5 - 16*4, " | |
95 | "two = \"spong\", " | |
96 | "three = 'c', " | |
97 | "four = something_different" | |
98 | "]") | |
99 | (make-property-set "one" 1 | |
100 | "two" "spong" | |
101 | "three" #\c | |
102 | "four" (cons :id | |
103 | "something_different")))) | |
104 | ||
105 | ;;;----- That's all, folks -------------------------------------------------- |