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
 199 ;;; MOP Testing
 200
 201 (eval-when (:compile-toplevel :load-toplevel :execute)
 202   (when (find-package '#:kmr-mop)
 203     (pushnew :kmrtest-mop cl:*features*)))
 204
 205 #+kmrtest-mop
 206 (progn
 207   (setf (find-class 'credit-rating) nil)
 208   (setf (find-class 'monitored-credit-rating) nil)
 209
 210   (defclass credit-rating ()
 211     ((level :attributes (date-set time-set))
 212      (id :attributes (person-setting)))
 213     (:metaclass attributes-class)
 214     #+lispworks (:optimize-slot-access nil)
 215     )
 216
 217   (defclass monitored-credit-rating (credit-rating)
 218     ((level :attributes (last-checked interval date-set))
 219      (cc :initarg :cc)
 220      (id :attributes (verified)))
 221     (:metaclass attributes-class))
 222
 223   (deftest attrib.mop.1
 224       (let ((cr (make-instance 'credit-rating)))
 225         (slot-attribute cr 'level 'date-set))
 226       nil)
 227
 228   (deftest attrib.mop.2
 229       (let ((cr (make-instance 'credit-rating)))
 230         (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
 231         (slot-attribute cr 'level 'date-set))
 232     "12/15/1990")
 233
 234   (deftest attrib.mop.3
 235       (let ((mcr (make-instance 'monitored-credit-rating)))
 236         (setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
 237         (slot-attribute mcr 'level 'date-set))
 238     "01/05/2002")
 239
 240   )   ;; kmrcl-mop
 241
 242 #+kmrtest-mop
 243 (eval-when (:compile-toplevel :load-toplevel :execute)
 244   (setq cl:*features* (delete :kmrtest-mop cl:*features*)))