tests.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          kmrcl-tests.lisp
   6 ;;;; Purpose:       kmrcl tests file
   7 ;;;; Author:        Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2003
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:cl)
  17 (defpackage #:kmrcl-tests
  18   (:use #:kmrcl #:cl #:rtest))
  19 (in-package #:kmrcl-tests)
  20
  21 (rem-all-tests)
  22
  23
  24 (deftest str.0 (substitute-chars-strings "" nil) "")
  25 (deftest str.1 (substitute-chars-strings "abcd" nil) "abcd")
  26 (deftest str.2 (substitute-chars-strings "abcd" nil) "abcd")
  27 (deftest str.3 (substitute-chars-strings "abcd" '((#\j . "ef"))) "abcd")
  28 (deftest str.4 (substitute-chars-strings "abcd" '((#\a . "ef"))) "efbcd")
  29 (deftest str.5
  30     (substitute-chars-strings "abcd" '((#\a . "ef") (#\j . "ghi")))
  31   "efbcd")
  32 (deftest str.6
  33     (substitute-chars-strings "abcd" '((#\a . "ef") (#\d . "ghi")))
  34   "efbcghi")
  35
  36 (deftest str.7 (escape-xml-string "") "")
  37 (deftest str.8 (escape-xml-string "abcd") "abcd")
  38 (deftest str.9 (escape-xml-string "ab&cd") "ab&amp;cd")
  39 (deftest str.10 (escape-xml-string "ab&cd<") "ab&amp;cd&lt;")
  40 (deftest str.12 (string-trim-last-character "") "")
  41 (deftest str.13 (string-trim-last-character "a") "")
  42 (deftest str.14 (string-trim-last-character "ab") "a")
  43 (deftest str.15 (nstring-trim-last-character "") "")
  44 (deftest str.16 (nstring-trim-last-character "a") "")
  45 (deftest str.17 (nstring-trim-last-character "ab") "a")
  46
  47 (deftest str.18 (delimited-string-to-list "ab|cd|ef" #\|)
  48                                           ("ab" "cd" "ef"))
  49 (deftest str.19 (delimited-string-to-list "ab|cd|ef" #\| t)
  50                                           ("ab" "cd" "ef"))
  51 (deftest str.20 (delimited-string-to-list "") (""))
  52 (deftest str.21 (delimited-string-to-list "" #\space t) (""))
  53 (deftest str.22 (delimited-string-to-list "ab") ("ab"))
  54 (deftest str.23 (delimited-string-to-list "ab" #\space t) ("ab"))
  55 (deftest str.24 (delimited-string-to-list "ab|" #\|) ("ab" ""))
  56 (deftest str.25 (delimited-string-to-list "ab|" #\| t) ("ab"))
  57
  58 (deftest sdstl.1 (string-delimited-string-to-list "ab|cd|ef" "|a")
  59   ("ab|cd|ef"))
  60 (deftest sdstl.2 (string-delimited-string-to-list "ab|cd|ef" "|")
  61   ("ab" "cd" "ef"))
  62 (deftest sdstl.3 (string-delimited-string-to-list "ab|cd|ef" "cd")
  63   ("ab|" "|ef"))
  64 (deftest sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab")
  65   ("" "|cd|ef"))
  66
  67 (deftest apsl.1 (append-sublists '((a b) (c d))) (a b c d))
  68 (deftest apsl.2 (append-sublists nil) nil)
  69 (deftest apsl.3 (append-sublists '((a b))) (a b))
  70 (deftest apsl.4 (append-sublists '((a))) (a))
  71 (deftest apsl.5 (append-sublists '((a) (b) (c d (e f g)))) (a b c d (e f g)))
  72
  73 (deftest pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil))
  74   "")
  75
  76 (deftest pss.1
  77     (with-output-to-string (s) (print-separated-strings s "|" '("ab")) )
  78   "ab")
  79
  80 (deftest pss.2
  81     (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd")))
  82     "ab|cd")
  83
  84 (deftest pss.3
  85     (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd") nil))
  86     "ab|cd")
  87
  88 (deftest pss.4
  89     (with-output-to-string (s)
  90       (print-separated-strings s "|" '("ab" "cd") nil nil))
  91     "ab|cd")
  92
  93 (deftest pss.5
  94     (with-output-to-string (s)
  95       (print-separated-strings s "|" '("ab" "cd") nil '("ef") nil))
  96     "ab|cd|ef")
  97
  98 (deftest css.0 (concat-separated-strings "|" nil) "")
  99 (deftest css.1 (concat-separated-strings "|" nil nil) "")
 100 (deftest css.2 (concat-separated-strings "|" '("ab")) "ab")
 101 (deftest css.3 (concat-separated-strings "|" '("ab" "cd")) "ab|cd")
 102 (deftest css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd")
 103 (deftest css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef")
 104
 105 (deftest f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x)))
 106                      '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81))
 107 (deftest f.2 (filter #'(lambda (x) (when (oddp x) (* x x)))
 108                      '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9))
 109 (deftest an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f))
 110
 111
 112 (deftest pxml.1
 113   (xml-tag-contents "tag1" "<tag>Test</tag>")
 114   nil nil nil)
 115
 116 (deftest pxml.2
 117   (xml-tag-contents "tag" "<tag>Test</tag>")
 118   "Test" 15 nil)
 119
 120 (deftest pxml.3
 121   (xml-tag-contents "tag" "<tag  >Test</tag>")
 122   "Test" 17 nil)
 123
 124 (deftest pxml.4
 125     (xml-tag-contents "tag" "<tag a=\"b\"></tag>")
 126   "" 17 ("a=\"b\""))
 127
 128 (deftest pxml.5
 129     (xml-tag-contents "tag" "<tag a=\"b\" >Test</tag>")
 130   "Test" 22 ("a=\"b\""))
 131
 132 (deftest pxml.6
 133     (xml-tag-contents "tag" "<tag a=\"b\"  c=\"ab\">Test</tag>")
 134   "Test" 29 ("a=\"b\"" "c=\"ab\""))
 135
 136 (deftest pxml.7
 137     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test</taga>")
 138   nil nil nil)
 139
 140 (deftest pxml.8
 141     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test<tag>ab</tag></taga>")
 142   "ab" 37 nil)
 143
 144 (deftest pxml.9
 145     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test<tag>ab</ag></taga>")
 146   nil nil nil)
 147
 148 (deftest fss.1 (fast-string-search "" "" 0 0 0) 0)
 149 (deftest fss.2 (fast-string-search "" "abc" 0 0 2) 0)
 150 (deftest fss.3 (fast-string-search "abc" "" 3 0 0) nil)
 151 (deftest fss.4 (fast-string-search "abc" "abcde" 3 0 4) 0)
 152 (deftest fss.5 (fast-string-search "abc" "012abcde" 3 0 7) 3)
 153 (deftest fss.6 (fast-string-search "abc" "012abcde" 3 0 7) 3)
 154 (deftest fss.7 (fast-string-search "abc" "012abcde" 3 3 7) 3)
 155 (deftest fss.8 (fast-string-search "abc" "012abcde" 3 4 7) nil)
 156 (deftest fss.9 (fast-string-search "abcde" "012abcde" 5 3 8) 3)
 157 (deftest fss.9b (cl:search "abcde" "012abcde" :start2 3 :end2 8) 3)
 158 (deftest fss.10 (fast-string-search "abcde" "012abcde" 5 3 7) nil)
 159 (deftest fss.10b (cl:search "abcde" "012abcde" :start2 3 :end2 7) nil)
 160
 161 (deftest stlsd.1 (string-to-list-skip-delimiter "") ())
 162 (deftest stlsd.2 (string-to-list-skip-delimiter "abc") ("abc"))
 163 (deftest stlsd.3 (string-to-list-skip-delimiter "ab c") ("ab" "c"))
 164 (deftest stlsd.4 (string-to-list-skip-delimiter "ab  c") ("ab" "c"))
 165 (deftest stlsd.5 (string-to-list-skip-delimiter "ab   c") ("ab" "c"))
 166 (deftest stlsd.6 (string-to-list-skip-delimiter "ab   c ") ("ab" "c"))
 167 (deftest stlsd.7 (string-to-list-skip-delimiter "  ab   c  ") ("ab" "c"))
 168 (deftest stlsd.8 (string-to-list-skip-delimiter "ab,,c" #\,) ("ab" "c"))
 169 (deftest stlsd.9 (string-to-list-skip-delimiter "ab,,c,," #\,) ("ab" "c"))
 170 (deftest stlsd.10 (string-to-list-skip-delimiter " ab") ("ab"))
 171
 172 (deftest csc.1 (count-string-char "" #\a) 0)
 173 (deftest csc.2 (count-string-char "abc" #\d) 0)
 174 (deftest csc.3 (count-string-char "abc" #\b) 1)
 175 (deftest csc.4 (count-string-char "abcb" #\b) 2)
 176
 177 (deftest duqs.1 (decode-uri-query-string "") "")
 178 (deftest duqs.2 (decode-uri-query-string "abc") "abc")
 179 (deftest duqs.3 (decode-uri-query-string "abc+") "abc ")
 180 (deftest duqs.4 (decode-uri-query-string "abc+d") "abc d")
 181 (deftest duqs.5 (decode-uri-query-string "abc%20d") "abc d")
 182
 183 (deftest sse.1 (string-strip-ending "" nil) "")
 184 (deftest sse.2 (string-strip-ending "abc" nil) "abc")
 185 (deftest sse.3 (string-strip-ending "abc" "ab") "abc")
 186 (deftest sse.4 (string-strip-ending "abc" '("ab")) "abc")
 187 (deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
 188
 189 (deftest mua.1 (match-unique-abbreviation "abc" nil) nil)
 190 (deftest mua.2 (match-unique-abbreviation "abc" '("ab")) nil)
 191 (deftest mua.3 (match-unique-abbreviation "ab" '("ab")) 0)
 192 (deftest mua.4 (match-unique-abbreviation "a" '("ab")) 0)
 193 (deftest mua.5 (match-unique-abbreviation "b" '("ab")) nil)
 194 (deftest mua.6 (match-unique-abbreviation "ab" '("ab" "abc")) nil)
 195 (deftest mua.7 (match-unique-abbreviation "ac" '("ab" "ac")) 1)
 196 (deftest mua.8 (match-unique-abbreviation "ac" '("ab" "acb")) 1)
 197
 198 (deftest gopt.1 (getopt '("argv") nil) ("argv") nil nil)
 199 (deftest gopt.2 (getopt '("argv" "2") nil) ("argv" "2") nil nil)
 200 (deftest gopt.3 (getopt '("argv" "-c") '(("c" :none))) ("argv") (("c")) nil)
 201 (deftest gopt.4 (getopt '("argv" "-c" "val") '(("c" :optional))) ("argv") (("c" . "val")) nil)
 202 (deftest gopt.5 (getopt '("argv" "-c" "val" "v1") '(("c" :optional))) ("argv" "v1") (("c" . "val")) nil)
 203 (deftest gopt.6 (getopt '("--colon" "val" "v1") '(("colon" :optional))) ( "v1") (("colon" . "val")) nil)
 204 (deftest gopt.7 (getopt '("ab" "--colon" "val" "--" "-c") '(("colon" :optional) ("-c" :none))) ("ab" "-c") (("colon" . "val")) nil)
 205 (deftest gopt.8 (getopt '("argv" "-c" "cd") '(("c" :required))) ("argv") (("c" . "cd")) nil)
 206 (deftest gopt.9 (getopt '("argv" "-c") '(("c" :required))) ("argv") nil ("c"))
 207 (deftest gopt.10 (getopt '("argv" "-c=10") '(("c" :required))) ("argv") (("c" . "10")) nil)
 208 (deftest gopt.11 (getopt '("argv" "-c=10") '(("c" :none))) ("argv") nil ("c"))
 209 (deftest gopt.12 (getopt '("--along=10") '(("along" :optional))) nil (("along" . "10")) nil)
 210 (deftest gopt.13 (getopt '("--along=10") '(("along" :none))) nil nil ("along"))
 211 (deftest gopt.14 (getopt '("--a=10") '(("along" :optional))) nil (("along" . "10")) nil)
 212 (deftest gopt.15 (getopt '("--a=10") '(("along" :optional) ("aboot" :optional))) nil nil ("a"))
 213
 214
 215 ;;; MOP Testing
 216
 217 (eval-when (:compile-toplevel :load-toplevel :execute)
 218   (when (find-package '#:kmr-mop)
 219     (pushnew :kmrtest-mop cl:*features*)))
 220
 221 #+kmrtest-mop
 222 (progn
 223   (setf (find-class 'monitored-credit-rating) nil)
 224   (setf (find-class 'credit-rating) nil)
 225
 226   (defclass credit-rating ()
 227     ((level :attributes (date-set time-set))
 228      (id :attributes (person-setting)))
 229     (:metaclass attributes-class)
 230     #+lispworks (:optimize-slot-access nil)
 231     )
 232
 233   (defclass monitored-credit-rating (credit-rating)
 234     ((level :attributes (last-checked interval date-set))
 235      (cc :initarg :cc)
 236      (id :attributes (verified)))
 237     (:metaclass attributes-class))
 238
 239   (deftest attrib.mop.1
 240       (let ((cr (make-instance 'credit-rating)))
 241         (slot-attribute cr 'level 'date-set))
 242       nil)
 243
 244   (deftest attrib.mop.2
 245       (let ((cr (make-instance 'credit-rating)))
 246         (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
 247         (slot-attribute cr 'level 'date-set))
 248     "12/15/1990")
 249
 250   (deftest attrib.mop.3
 251       (let ((mcr (make-instance 'monitored-credit-rating)))
 252         (setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
 253         (slot-attribute mcr 'level 'date-set))
 254     "01/05/2002")
 255
 256   )   ;; kmrcl-mop
 257
 258 #+kmrtest-mop
 259 (eval-when (:compile-toplevel :load-toplevel :execute)
 260   (setq cl:*features* (delete :kmrtest-mop cl:*features*)))