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 gopt.1 (getopt '("argv") nil) ("argv") nil nil)
 190 (deftest gopt.2 (getopt '("argv" "2") nil) ("argv" "2") nil nil)
 191 (deftest gopt.3 (getopt '("argv" "-c") '(("c" :none))) ("argv") (("c")) nil)
 192 (deftest gopt.4 (getopt '("argv" "-c" "val") '(("c" :optional))) ("argv") (("c" . "val")) nil)
 193 (deftest gopt.5 (getopt '("argv" "-c" "val" "v1") '(("c" :optional))) ("argv" "v1") (("c" . "val")) nil)
 194 (deftest gopt.6 (getopt '("--colon" "val" "v1") '(("colon" :optional))) ( "v1") (("colon" . "val")) nil)
 195 (deftest gopt.7 (getopt '("ab" "--colon" "val" "--" "-c") '(("colon" :optional) ("-c" :none))) ("ab" "-c") (("colon" . "val")) nil)
 196 (deftest gopt.8 (getopt '("argv" "-c" "cd") '(("c" :required))) ("argv") (("c" . "cd")) nil)
 197 (deftest gopt.9 (getopt '("argv" "-c") '(("c" :required))) ("argv") nil ("c"))
 198 (deftest gopt.10 (getopt '("argv" "-c=10") '(("c" :required))) ("argv") (("c" . "10")) nil)
 199 (deftest gopt.11 (getopt '("argv" "-c=10") '(("c" :none))) ("argv") nil ("c"))
 200 (deftest gopt.12 (getopt '("--along=10") '(("along" :optional))) nil (("along" . "10")) nil)
 201 (deftest gopt.13 (getopt '("--along=10") '(("along" :none))) nil nil ("along"))
 202
 203 ;;; MOP Testing
 204
 205 (eval-when (:compile-toplevel :load-toplevel :execute)
 206   (when (find-package '#:kmr-mop)
 207     (pushnew :kmrtest-mop cl:*features*)))
 208
 209 #+kmrtest-mop
 210 (progn
 211   (setf (find-class 'credit-rating) nil)
 212   (setf (find-class 'monitored-credit-rating) nil)
 213
 214   (defclass credit-rating ()
 215     ((level :attributes (date-set time-set))
 216      (id :attributes (person-setting)))
 217     (:metaclass attributes-class)
 218     #+lispworks (:optimize-slot-access nil)
 219     )
 220
 221   (defclass monitored-credit-rating (credit-rating)
 222     ((level :attributes (last-checked interval date-set))
 223      (cc :initarg :cc)
 224      (id :attributes (verified)))
 225     (:metaclass attributes-class))
 226
 227   (deftest attrib.mop.1
 228       (let ((cr (make-instance 'credit-rating)))
 229         (slot-attribute cr 'level 'date-set))
 230       nil)
 231
 232   (deftest attrib.mop.2
 233       (let ((cr (make-instance 'credit-rating)))
 234         (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
 235         (slot-attribute cr 'level 'date-set))
 236     "12/15/1990")
 237
 238   (deftest attrib.mop.3
 239       (let ((mcr (make-instance 'monitored-credit-rating)))
 240         (setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
 241         (slot-attribute mcr 'level 'date-set))
 242     "01/05/2002")
 243
 244   )   ;; kmrcl-mop
 245
 246 #+kmrtest-mop
 247 (eval-when (:compile-toplevel :load-toplevel :execute)
 248   (setq cl:*features* (delete :kmrtest-mop cl:*features*)))